Commit | Line | Data |
---|---|---|
548e9a3a LB |
1 | #!perl |
2 | ||
3 | =head1 NAME | |
4 | ||
5 | Porting/acknowledgements.pl - Generate perldelta acknowledgements text | |
6 | ||
7 | =head1 SYNOPSIS | |
8 | ||
9 | perl Porting/acknowledgements.pl v5.15.0..HEAD | |
10 | ||
11 | =head1 DESCRIPTION | |
12 | ||
13 | This generates the text which goes in the Acknowledgements section in | |
14 | a perldelta. You pass in the previous version and it guesses the next | |
15 | version, fetches information from the repository and outputs the | |
16 | text. | |
17 | ||
18 | =cut | |
19 | ||
20 | use strict; | |
21 | use warnings; | |
22 | use autodie; | |
23 | use POSIX qw(ceil); | |
24 | use Text::Wrap; | |
25 | use Time::Piece; | |
26 | use Time::Seconds; | |
27 | use version; | |
28 | $Text::Wrap::columns = 80; | |
29 | ||
30 | my $since_until = shift; | |
31 | ||
32 | my ( $since, $until ) = split '\.\.', $since_until; | |
33 | ||
34 | die "Usage: perl Porting/acknowledgements.pl v5.15.0..HEAD" | |
35 | unless $since_until && $since && $until; | |
36 | ||
37 | my $previous_version = previous_version(); | |
38 | my $next_version = next_version(); | |
39 | my $development_time = development_time(); | |
40 | ||
41 | my ( $changes, $files ) = changes_files(); | |
42 | my $formatted_changes = commify( round($changes) ); | |
43 | my $formatted_files = commify( round($files) ); | |
44 | ||
45 | my $authors = authors(); | |
46 | my $nauthors = $authors =~ tr/,/,/; | |
47 | $nauthors++; | |
48 | ||
49 | my $text | |
50 | = "Perl $next_version represents approximately $development_time of development | |
51 | since Perl $previous_version and contains approximately $formatted_changes | |
52 | lines of changes across $formatted_files files from $nauthors authors. | |
53 | ||
9fe5af70 FR |
54 | Perl continues to flourish into its third decade thanks to a vibrant |
55 | community of users and developers. The following people are known to | |
548e9a3a LB |
56 | have contributed the improvements that became Perl $next_version: |
57 | ||
58 | $authors | |
59 | The list above is almost certainly incomplete as it is automatically | |
60 | generated from version control history. In particular, it does not | |
61 | include the names of the (very much appreciated) contributors who | |
62 | reported issues to the Perl bug tracker. | |
63 | ||
64 | Many of the changes included in this version originated in the CPAN | |
65 | modules included in Perl's core. We're grateful to the entire CPAN | |
66 | community for helping Perl to flourish. | |
67 | ||
68 | For a more complete list of all of Perl's historical contributors, | |
9fe5af70 | 69 | please see the F<AUTHORS> file in the Perl source distribution."; |
548e9a3a LB |
70 | |
71 | my $wrapped = fill( '', '', $text ); | |
72 | print "$wrapped\n"; | |
73 | ||
74 | # return the previous Perl version, eg 5.15.0 | |
75 | sub previous_version { | |
76 | my $version = version->new($since); | |
77 | $version =~ s/^v//; | |
78 | return $version; | |
79 | } | |
80 | ||
81 | # returns the upcoming release Perl version, eg 5.15.1 | |
82 | sub next_version { | |
83 | my $version = version->new($since); | |
84 | ( $version->{version}->[-1] )++; | |
85 | return version->new( join( '.', @{ $version->{version} } ) ); | |
86 | } | |
87 | ||
88 | # returns the development time since the previous version in weeks | |
89 | # or months | |
90 | sub development_time { | |
5f8b560c DR |
91 | my $first_timestamp = qx(git log -1 --pretty=format:%ct --summary $since); |
92 | my $last_timestamp = qx(git log -1 --pretty=format:%ct --summary $until); | |
548e9a3a LB |
93 | |
94 | die "Missing first timestamp" unless $first_timestamp; | |
5f8b560c | 95 | die "Missing last timestamp" unless $last_timestamp; |
548e9a3a | 96 | |
5f8b560c DR |
97 | my $seconds = localtime($last_timestamp) - localtime($first_timestamp); |
98 | my $weeks = _round( $seconds / ONE_WEEK ); | |
99 | my $months = _round( $seconds / ONE_MONTH ); | |
548e9a3a LB |
100 | |
101 | my $development_time; | |
102 | if ( $months < 2 ) { | |
8ece16d7 | 103 | return "$weeks @{[$weeks == 1 ? q(week) : q(weeks)]}"; |
548e9a3a LB |
104 | } else { |
105 | return "$months months"; | |
106 | } | |
107 | } | |
108 | ||
5f8b560c DR |
109 | sub _round { |
110 | my $val = shift; | |
111 | ||
112 | my $int = int $val; | |
113 | my $remainder = $val - $int; | |
114 | ||
115 | return $remainder >= 0.5 ? $int + 1 : $int; | |
116 | } | |
117 | ||
548e9a3a LB |
118 | # returns the number of changed lines and files since the previous |
119 | # version | |
120 | sub changes_files { | |
121 | my $output = qx(git diff --shortstat $since_until); | |
122 | ||
123 | # 585 files changed, 156329 insertions(+), 53586 deletions(-) | |
124 | my ( $files, $insertions, $deletions ) | |
125 | = $output | |
126 | =~ /(\d+) files changed, (\d+) insertions\(\+\), (\d+) deletions\(-\)/; | |
127 | my $changes = $insertions + $deletions; | |
128 | return ( $changes, $files ); | |
129 | } | |
130 | ||
131 | # rounds an integer to two significant figures | |
132 | sub round { | |
133 | my $int = shift; | |
134 | my $length = length($int); | |
135 | my $divisor = 10**( $length - 2 ); | |
136 | return ceil( $int / $divisor ) * $divisor; | |
137 | } | |
138 | ||
139 | # adds commas to a number at thousands, millions | |
140 | sub commify { | |
141 | local $_ = shift; | |
142 | 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; | |
143 | return $_; | |
144 | } | |
145 | ||
146 | # returns a list of the authors | |
147 | sub authors { | |
148 | return | |
149 | qx(git log --pretty=fuller $since_until | $^X Porting/checkAUTHORS.pl --who -); | |
150 | } |