Commit | Line | Data |
---|---|---|
bcfe7366 NC |
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 | ||
3d7c117d | 7 | require './Porting/pod_lib.pl'; |
bcfe7366 NC |
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"; | |
c23ac59e TC |
64 | # in a built tree, $olddeltaname is a symlink to perldelta.pod, make sure |
65 | # we don't write through it | |
66 | unlink($olddeltaname); | |
bcfe7366 NC |
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 | ||
0aef0fe5 | 88 | $filename = 'pod/perl.pod'; |
bcfe7366 NC |
89 | my $pod_master = slurp_or_die($filename); |
90 | ||
0aef0fe5 NC |
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" . | |
bcfe7366 | 93 | "$1$2$3$4$5"}me |
f9001595 | 94 | or warn "Couldn't find perldelta line (for perl5$was_major${was_minor}delta) in $filename"; |
bcfe7366 NC |
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 | ||
bcfe7366 | 106 | # ex: set ts=8 sts=4 sw=4 et: |