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