| 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 | } |