| 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, $code_changes, $code_files ) = changes_files(); |
| 42 | my $formatted_changes = commify( round($changes) ); |
| 43 | my $formatted_files = commify( round($files) ); |
| 44 | my $formatted_code_changes = commify( round($code_changes) ); |
| 45 | my $formatted_code_files = commify( round($code_files) ); |
| 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 | |
| 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 | |
| 60 | Perl continues to flourish into its third decade thanks to a vibrant |
| 61 | community of users and developers. The following people are known to |
| 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, |
| 75 | please see the F<AUTHORS> file in the Perl source distribution."; |
| 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 { |
| 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); |
| 99 | |
| 100 | die "Missing first timestamp" unless $first_timestamp; |
| 101 | die "Missing last timestamp" unless $last_timestamp; |
| 102 | |
| 103 | my $seconds = localtime($last_timestamp) - localtime($first_timestamp); |
| 104 | my $weeks = _round( $seconds / ONE_WEEK ); |
| 105 | my $months = _round( $seconds / ONE_MONTH ); |
| 106 | |
| 107 | my $development_time; |
| 108 | if ( $months < 2 ) { |
| 109 | return "$weeks @{[$weeks == 1 ? q(week) : q(weeks)]}"; |
| 110 | } else { |
| 111 | return "$months months"; |
| 112 | } |
| 113 | } |
| 114 | |
| 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 | |
| 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); |
| 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); |
| 130 | chomp @filenames; |
| 131 | my $output_code_changed = qx# git diff --shortstat $since_until -- @filenames #; |
| 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"; |
| 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 | } |