Porting/new-perldelta.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 # This needs to be able to run from a clean checkout, hence assume only system
   5 # perl, which may be too old to have autodie
   6
   7 require './Porting/pod_lib.pl';
   8
   9 my $state = get_pod_metadata(1);
  10 my (undef, $old_major, $old_minor) = @{$state->{delta_version}};
  11 # For now, hard code it for the simple ones...
  12 my $new_major = $old_major;
  13 my $new_minor = $old_minor + 1;
  14 # These two are just for "If you are upgrading from earlier releases..." in
  15 # the perldelta template.
  16 my $was_major = $old_major;
  17 my $was_minor = $old_minor - 1;
  18 # I may have missed some corner cases here:
  19 if ($was_minor < 0) {
  20     $was_minor = 0;
  21     --$was_major;
  22 }
  23 my $newdelta_filename = "perl5$new_major${new_minor}delta.pod";
  24
  25 {
  26     # For now, just tell the user what to add, as it's safer.
  27     my %add;
  28
  29     sub git_add_new {
  30         push @{$add{new}}, shift;
  31     }
  32
  33     sub git_add_modified {
  34         push @{$add{modified}}, shift;
  35     }
  36
  37     sub notify_success {
  38         return unless %add;
  39         print "Please run:\n";
  40         foreach (qw(new modified)) {
  41             print "    git add @{$add{$_}}\n" if $add{$_};
  42         }
  43         print "\nBefore committing please check that the build works and make test_porting passes\n";
  44     }
  45 }
  46
  47 my $filename = 'pod/.gitignore';
  48 my $gitignore = slurp_or_die($filename);
  49
  50 $gitignore =~ s{^/$state->{delta_target}$}
  51                {/$newdelta_filename}m
  52     or die "Can't find /$state->{delta_target} in $filename";
  53
  54 write_or_die($filename, $gitignore);
  55 git_add_modified($filename);
  56
  57 my $olddelta = slurp_or_die('pod/perldelta.pod');
  58
  59 $olddelta =~ s{^(perl)(delta - what is new for perl v5.$old_major.$old_minor)$}
  60               {$1 . "5$old_major$old_minor" . $2}me
  61     or die "Can't find expected NAME contents in $olddelta";
  62
  63 my $olddeltaname = "pod/perl5$old_major${old_minor}delta.pod";
  64 # in a built tree, $olddeltaname is a symlink to perldelta.pod, make sure
  65 # we don't write through it
  66 unlink($olddeltaname);
  67 write_or_die($olddeltaname, $olddelta);
  68 git_add_new($olddeltaname);
  69
  70 $filename = 'Porting/perldelta_template.pod';
  71 my $newdelta = slurp_or_die($filename);
  72
  73 foreach([rXXX => $was_major],
  74         [sXXX => $old_major],
  75         [tXXX => $new_major],
  76         [aXXX => $was_minor],
  77         [bXXX => $old_minor],
  78         [cXXX => $new_minor],
  79         ['5XXX' => 5 . $old_major . $old_minor]) {
  80     my ($token, $value) = @$_;
  81     $newdelta =~ s/$token/$value/g
  82         or die "Can't find '$token' in $filename";
  83 }
  84
  85 write_or_die('pod/perldelta.pod', $newdelta);
  86 git_add_modified('pod/perldelta.pod');
  87
  88 $filename = 'pod/perl.pod';
  89 my $pod_master = slurp_or_die($filename);
  90
  91 $pod_master =~ s{^(\s*perl5)($was_major$was_minor)(delta\s+Perl changes in version )(5\.\d+\.\d+)(.*)}
  92     {$1 . $old_major . $old_minor .$3 . "5.$old_major.$old_minor" . $5 . "\n" .
  93          "$1$2$3$4$5"}me
  94     or warn "Couldn't find perldelta line (for perl5$was_major${was_minor}delta) in $filename";
  95
  96 write_or_die($filename, $pod_master);
  97 git_add_modified($filename);
  98
  99 my $command = "$^X Porting/pod_rules.pl";
 100 system $command
 101     and die "Could not run '$command', \$? = $?";
 102 git_add_modified(map {chomp $_; $_} `$^X Porting/pod_rules.pl --showfiles`);
 103
 104 notify_success();
 105
 106 # ex: set ts=8 sts=4 sw=4 et: