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 | ||
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 | |
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, | |
69 | please see the F<AUTHORS> file in the Perl source distribution. | |
70 | "; | |
71 | ||
72 | my $wrapped = fill( '', '', $text ); | |
73 | print "$wrapped\n"; | |
74 | ||
75 | # return the previous Perl version, eg 5.15.0 | |
76 | sub previous_version { | |
77 | my $version = version->new($since); | |
78 | $version =~ s/^v//; | |
79 | return $version; | |
80 | } | |
81 | ||
82 | # returns the upcoming release Perl version, eg 5.15.1 | |
83 | sub next_version { | |
84 | my $version = version->new($since); | |
85 | ( $version->{version}->[-1] )++; | |
86 | return version->new( join( '.', @{ $version->{version} } ) ); | |
87 | } | |
88 | ||
89 | # returns the development time since the previous version in weeks | |
90 | # or months | |
91 | sub development_time { | |
92 | my $dates = qx(git log --pretty=format:%ct --summary $since_until); | |
93 | my $first_timestamp; | |
94 | foreach my $line ( split $/, $dates ) { | |
95 | next unless $line; | |
96 | next unless $line =~ /^\d+$/; | |
97 | $first_timestamp = $line; | |
98 | } | |
99 | ||
100 | die "Missing first timestamp" unless $first_timestamp; | |
101 | ||
102 | my $now = localtime; | |
103 | my $then = localtime($first_timestamp); | |
104 | my $seconds = $now - $then; | |
105 | my $weeks = ceil( $seconds / ONE_WEEK ); | |
106 | my $months = ceil( $seconds / ONE_MONTH ); | |
107 | ||
108 | my $development_time; | |
109 | if ( $months < 2 ) { | |
110 | return "$weeks weeks"; | |
111 | } else { | |
112 | return "$months months"; | |
113 | } | |
114 | } | |
115 | ||
116 | # returns the number of changed lines and files since the previous | |
117 | # version | |
118 | sub changes_files { | |
119 | my $output = qx(git diff --shortstat $since_until); | |
120 | ||
121 | # 585 files changed, 156329 insertions(+), 53586 deletions(-) | |
122 | my ( $files, $insertions, $deletions ) | |
123 | = $output | |
124 | =~ /(\d+) files changed, (\d+) insertions\(\+\), (\d+) deletions\(-\)/; | |
125 | my $changes = $insertions + $deletions; | |
126 | return ( $changes, $files ); | |
127 | } | |
128 | ||
129 | # rounds an integer to two significant figures | |
130 | sub round { | |
131 | my $int = shift; | |
132 | my $length = length($int); | |
133 | my $divisor = 10**( $length - 2 ); | |
134 | return ceil( $int / $divisor ) * $divisor; | |
135 | } | |
136 | ||
137 | # adds commas to a number at thousands, millions | |
138 | sub commify { | |
139 | local $_ = shift; | |
140 | 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; | |
141 | return $_; | |
142 | } | |
143 | ||
144 | # returns a list of the authors | |
145 | sub authors { | |
146 | return | |
147 | qx(git log --pretty=fuller $since_until | $^X Porting/checkAUTHORS.pl --who -); | |
148 | } |