| 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 | write_or_die($olddeltaname, $olddelta); |
| 65 | git_add_new($olddeltaname); |
| 66 | |
| 67 | $filename = 'Porting/perldelta_template.pod'; |
| 68 | my $newdelta = slurp_or_die($filename); |
| 69 | |
| 70 | foreach([rXXX => $was_major], |
| 71 | [sXXX => $old_major], |
| 72 | [tXXX => $new_major], |
| 73 | [aXXX => $was_minor], |
| 74 | [bXXX => $old_minor], |
| 75 | [cXXX => $new_minor], |
| 76 | ['5XXX' => 5 . $old_major . $old_minor]) { |
| 77 | my ($token, $value) = @$_; |
| 78 | $newdelta =~ s/$token/$value/g |
| 79 | or die "Can't find '$token' in $filename"; |
| 80 | } |
| 81 | |
| 82 | write_or_die('pod/perldelta.pod', $newdelta); |
| 83 | git_add_modified('pod/perldelta.pod'); |
| 84 | |
| 85 | $filename = 'pod/perl.pod'; |
| 86 | my $pod_master = slurp_or_die($filename); |
| 87 | |
| 88 | $pod_master =~ s{^(\s*perl5)($was_major$was_minor)(delta\s+Perl changes in version )(5\.\d+\.\d+)(.*)} |
| 89 | {$1 . $old_major . $old_minor .$3 . "5.$old_major.$old_minor" . $5 . "\n" . |
| 90 | "$1$2$3$4$5"}me |
| 91 | or die "Can't find perldelta line in $filename"; |
| 92 | |
| 93 | write_or_die($filename, $pod_master); |
| 94 | git_add_modified($filename); |
| 95 | |
| 96 | my $command = "$^X Porting/pod_rules.pl"; |
| 97 | system $command |
| 98 | and die "Could not run '$command', \$? = $?"; |
| 99 | git_add_modified(map {chomp $_; $_} `$^X Porting/pod_rules.pl --showfiles`); |
| 100 | |
| 101 | notify_success(); |
| 102 | |
| 103 | # Local variables: |
| 104 | # cperl-indent-level: 4 |
| 105 | # indent-tabs-mode: nil |
| 106 | # End: |
| 107 | # |
| 108 | # ex: set ts=8 sts=4 sw=4 et: |