1#!perl 2 3=head1 NAME 4 5Porting/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 13This generates the text which goes in the Acknowledgements section in 14a perldelta. You pass in the previous version and it guesses the next 15version, fetches information from the repository and outputs the 16text. 17 18=cut 19 20use strict; 21use warnings; 22use autodie; 23use POSIX qw(ceil); 24use Text::Wrap; 25use Time::Piece; 26use Time::Seconds; 27use version; 28$Text::Wrap::columns = 77; 29 30my $since_until = shift; 31 32my ( $since, $until ) = split '\.\.', $since_until; 33 34die "Usage: perl Porting/acknowledgements.pl v5.15.0..HEAD" 35 unless $since_until && $since && $until; 36 37my $previous_version = previous_version(); 38my $next_version = next_version(); 39my $development_time = development_time(); 40 41my ( $changes, $files, $code_changes, $code_files ) = changes_files(); 42my $formatted_changes = commify( round($changes) ); 43my $formatted_files = commify( round($files) ); 44my $formatted_code_changes = commify( round($code_changes) ); 45my $formatted_code_files = commify( round($code_files) ); 46 47my $authors = authors(); 48my $nauthors = $authors =~ tr/,/,/; 49$nauthors++; 50 51my $text 52 = "Perl $next_version represents approximately $development_time of development 53since Perl $previous_version and contains approximately $formatted_changes 54lines of changes across $formatted_files files from $nauthors authors. 55 56Excluding auto-generated files, documentation and release tools, there 57were approximately $formatted_code_changes lines of changes to 58$formatted_code_files .pm, .t, .c and .h files. 59 60Perl continues to flourish into its fourth decade thanks to a vibrant 61community of users and developers. The following people are known to 62have contributed the improvements that became Perl $next_version: 63 64$authors 65The list above is almost certainly incomplete as it is automatically 66generated from version control history. In particular, it does not 67include the names of the (very much appreciated) contributors who 68reported issues to the Perl bug tracker. 69 70Many of the changes included in this version originated in the CPAN 71modules included in Perl's core. We're grateful to the entire CPAN 72community for helping Perl to flourish. 73 74For a more complete list of all of Perl's historical contributors, 75please see the F<AUTHORS> file in the Perl source distribution."; 76 77my $wrapped = fill( '', '', $text ); 78print "$wrapped\n"; 79 80# return the previous Perl version, eg 5.15.0 81sub 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 88sub 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 96sub 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 115sub _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 126sub changes_files { 127 my $output = qx(git diff --shortstat $since_until); 128 my $q = ($^O =~ /^(?:MSWin32|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 137sub _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 149sub 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 157sub commify { 158 local $_ = shift; 159 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; 160 return $_; 161} 162 163# returns a list of the authors 164sub authors { 165 return 166 qx($^X Porting/updateAUTHORS.pl --who $since_until); 167} 168