Porting/acknowledgements.pl

   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 = 77;
  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 fourth 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 }