new-perldelta.pl revision 1.1 
1#!/usr/bin/perl -w
2use 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
7require 'Porting/pod_lib.pl';
8
9my $state = get_pod_metadata(1);
10my (undef, $old_major, $old_minor) = @{$state->{delta_version}};
11# For now, hard code it for the simple ones...
12my $new_major = $old_major;
13my $new_minor = $old_minor + 1;
14# These two are just for "If you are upgrading from earlier releases..." in
15# the perldelta template.
16my $was_major = $old_major;
17my $was_minor = $old_minor - 1;
18# I may have missed some corner cases here:
19if ($was_minor < 0) {
20    $was_minor = 0;
21    --$was_major;
22}
23my $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
47my $filename = 'pod/.gitignore';
48my $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
54write_or_die($filename, $gitignore);
55git_add_modified($filename);
56
57my $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
63my $olddeltaname = "pod/perl5$old_major${old_minor}delta.pod";
64write_or_die($olddeltaname, $olddelta);
65git_add_new($olddeltaname);
66
67$filename = 'Porting/perldelta_template.pod';
68my $newdelta = slurp_or_die($filename);
69
70foreach([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
82write_or_die('pod/perldelta.pod', $newdelta);
83git_add_modified('pod/perldelta.pod');
84
85$filename = 'pod/perl.pod';
86my $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 (for perl5$was_major${was_minor}delta) in $filename";
92
93write_or_die($filename, $pod_master);
94git_add_modified($filename);
95
96my $command = "$^X Porting/pod_rules.pl";
97system $command
98    and die "Could not run '$command', \$? = $?";
99git_add_modified(map {chomp $_; $_} `$^X Porting/pod_rules.pl --showfiles`);
100
101notify_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:
109