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 | |
f703fc96 | 10 | |
548e9a3a LB |
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; | |
caefdcb6 | 28 | $Text::Wrap::columns = 77; |
548e9a3a LB |
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 | ||
636564c5 | 41 | my ( $changes, $files, $code_changes, $code_files ) = changes_files(); |
548e9a3a LB |
42 | my $formatted_changes = commify( round($changes) ); |
43 | my $formatted_files = commify( round($files) ); | |
636564c5 GS |
44 | my $formatted_code_changes = commify( round($code_changes) ); |
45 | my $formatted_code_files = commify( round($code_files) ); | |
548e9a3a LB |
46 | |
47 | my $authors = authors(); | |
48 | my $nauthors = $authors =~ tr/,/,/; | |
49 | $nauthors++; | |
50 | ||
51 | my $text | |
52 | = "Perl $next_version represents approximately $development_time of development | |
53 | since Perl $previous_version and contains approximately $formatted_changes | |
54 | lines of changes across $formatted_files files from $nauthors authors. | |
55 | ||
636564c5 GS |
56 | Excluding auto-generated files, documentation and release tools, there |
57 | were approximately $formatted_code_changes lines of changes to | |
58 | $formatted_code_files .pm, .t, .c and .h files. | |
59 | ||
143b7de3 | 60 | Perl continues to flourish into its fourth decade thanks to a vibrant |
9fe5af70 | 61 | community of users and developers. The following people are known to |
548e9a3a LB |
62 | have contributed the improvements that became Perl $next_version: |
63 | ||
64 | $authors | |
65 | The list above is almost certainly incomplete as it is automatically | |
66 | generated from version control history. In particular, it does not | |
67 | include the names of the (very much appreciated) contributors who | |
68 | reported issues to the Perl bug tracker. | |
69 | ||
70 | Many of the changes included in this version originated in the CPAN | |
71 | modules included in Perl's core. We're grateful to the entire CPAN | |
72 | community for helping Perl to flourish. | |
73 | ||
74 | For a more complete list of all of Perl's historical contributors, | |
9fe5af70 | 75 | please see the F<AUTHORS> file in the Perl source distribution."; |
548e9a3a LB |
76 | |
77 | my $wrapped = fill( '', '', $text ); | |
78 | print "$wrapped\n"; | |
79 | ||
80 | # return the previous Perl version, eg 5.15.0 | |
81 | sub previous_version { | |
82 | my $version = version->new($since); | |
83 | $version =~ s/^v//; | |
84 | return $version; | |
85 | } | |
86 | ||
87 | # returns the upcoming release Perl version, eg 5.15.1 | |
88 | sub next_version { | |
89 | my $version = version->new($since); | |
90 | ( $version->{version}->[-1] )++; | |
91 | return version->new( join( '.', @{ $version->{version} } ) ); | |
92 | } | |
93 | ||
94 | # returns the development time since the previous version in weeks | |
95 | # or months | |
96 | sub development_time { | |
5f8b560c DR |
97 | my $first_timestamp = qx(git log -1 --pretty=format:%ct --summary $since); |
98 | my $last_timestamp = qx(git log -1 --pretty=format:%ct --summary $until); | |
548e9a3a LB |
99 | |
100 | die "Missing first timestamp" unless $first_timestamp; | |
5f8b560c | 101 | die "Missing last timestamp" unless $last_timestamp; |
548e9a3a | 102 | |
5f8b560c DR |
103 | my $seconds = localtime($last_timestamp) - localtime($first_timestamp); |
104 | my $weeks = _round( $seconds / ONE_WEEK ); | |
105 | my $months = _round( $seconds / ONE_MONTH ); | |
548e9a3a LB |
106 | |
107 | my $development_time; | |
108 | if ( $months < 2 ) { | |
8ece16d7 | 109 | return "$weeks @{[$weeks == 1 ? q(week) : q(weeks)]}"; |
548e9a3a LB |
110 | } else { |
111 | return "$months months"; | |
112 | } | |
113 | } | |
114 | ||
5f8b560c DR |
115 | sub _round { |
116 | my $val = shift; | |
117 | ||
118 | my $int = int $val; | |
119 | my $remainder = $val - $int; | |
120 | ||
121 | return $remainder >= 0.5 ? $int + 1 : $int; | |
122 | } | |
123 | ||
548e9a3a LB |
124 | # returns the number of changed lines and files since the previous |
125 | # version | |
126 | sub changes_files { | |
127 | my $output = qx(git diff --shortstat $since_until); | |
c8721345 SH |
128 | my $q = ($^O =~ /^(?:MSWin32|NetWare|VMS)$/io) ? '"' : "'"; |
129 | my @filenames = qx(git diff --numstat $since_until | $^X -anle ${q}next if m{^dist/Module-CoreList} or not /\\.(?:pm|c|h|t)\\z/; print \$F[2]$q); | |
2e4654b2 RS |
130 | chomp @filenames; |
131 | my $output_code_changed = qx# git diff --shortstat $since_until -- @filenames #; | |
636564c5 GS |
132 | |
133 | return ( _changes_from_cmd ( $output ), | |
134 | _changes_from_cmd ( $output_code_changed ) ); | |
135 | } | |
136 | ||
137 | sub _changes_from_cmd { | |
138 | my $output = shift || die "No git diff command output"; | |
548e9a3a LB |
139 | |
140 | # 585 files changed, 156329 insertions(+), 53586 deletions(-) | |
141 | my ( $files, $insertions, $deletions ) | |
142 | = $output | |
143 | =~ /(\d+) files changed, (\d+) insertions\(\+\), (\d+) deletions\(-\)/; | |
144 | my $changes = $insertions + $deletions; | |
145 | return ( $changes, $files ); | |
146 | } | |
147 | ||
148 | # rounds an integer to two significant figures | |
149 | sub round { | |
150 | my $int = shift; | |
151 | my $length = length($int); | |
152 | my $divisor = 10**( $length - 2 ); | |
153 | return ceil( $int / $divisor ) * $divisor; | |
154 | } | |
155 | ||
156 | # adds commas to a number at thousands, millions | |
157 | sub commify { | |
158 | local $_ = shift; | |
159 | 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; | |
160 | return $_; | |
161 | } | |
162 | ||
163 | # returns a list of the authors | |
164 | sub authors { | |
165 | return | |
166 | qx(git log --pretty=fuller $since_until | $^X Porting/checkAUTHORS.pl --who -); | |
167 | } |