| 5 |
|
use Text::Tabs; |
| 6 |
|
use Text::Wrap; |
| 7 |
|
use Getopt::Long; |
| 8 |
– |
use Carp; |
| 8 |
|
|
| 9 |
+ |
if (ord("A") == 193) { |
| 10 |
+ |
print "1..0 # EBCDIC sort order is different\n"; |
| 11 |
+ |
exit; |
| 12 |
+ |
} |
| 13 |
+ |
|
| 14 |
|
# Generate the sections of files listed in %Targets from pod/perl.pod |
| 15 |
|
# Mostly these are rules in Makefiles |
| 16 |
|
# |
| 26 |
|
vms => 'vms/descrip_mms.template', |
| 27 |
|
nmake => 'win32/Makefile', |
| 28 |
|
dmake => 'win32/makefile.mk', |
| 29 |
+ |
gmake => 'win32/GNUmakefile', |
| 30 |
|
podmak => 'win32/pod.mak', |
| 31 |
|
unix => 'Makefile.SH', |
| 32 |
|
# plan9 => 'plan9/mkfile', |
| 33 |
|
); |
| 34 |
|
|
| 35 |
< |
require 'Porting/pod_lib.pl'; |
| 35 |
> |
require './Porting/pod_lib.pl'; |
| 36 |
> |
require './Porting/manifest_lib.pl'; |
| 37 |
|
sub my_die; |
| 38 |
|
|
| 39 |
|
# process command-line switches |
| 64 |
|
} |
| 65 |
|
|
| 66 |
|
if ($Verbose) { |
| 67 |
< |
print "I will be building $_\n" foreach keys %Build; |
| 67 |
> |
print "I will be building $_\n" foreach sort keys %Build; |
| 68 |
|
} |
| 69 |
|
|
| 70 |
|
my $test = 1; |
| 75 |
|
? get_pod_metadata(0, sub { |
| 76 |
|
printf "1..%d\n", 1 + scalar keys %Build; |
| 77 |
|
if (@_) { |
| 78 |
< |
print "not ok $test\n"; |
| 78 |
> |
print "not ok $test # got Pod metadata\n"; |
| 79 |
|
die @_; |
| 80 |
|
} |
| 81 |
< |
print "ok $test\n"; |
| 81 |
> |
print "ok $test # got Pod metadata\n"; |
| 82 |
|
}) |
| 83 |
|
: get_pod_metadata(1, sub { warn @_ if @_ }, values %Build); |
| 84 |
|
|
| 136 |
|
$line; |
| 137 |
|
} |
| 138 |
|
|
| 133 |
– |
sub verify_contiguous { |
| 134 |
– |
my ($name, $content, $what) = @_; |
| 135 |
– |
my $sections = () = $content =~ m/\0+/g; |
| 136 |
– |
croak("$0: $name contains no $what") if $sections < 1; |
| 137 |
– |
croak("$0: $name contains discontiguous $what") if $sections > 1; |
| 138 |
– |
} |
| 139 |
– |
|
| 139 |
|
sub do_manifest { |
| 140 |
|
my ($name, $prev) = @_; |
| 141 |
|
my @manifest = |
| 142 |
|
grep {! m!^pod/[^. \t]+\.pod.*!} |
| 143 |
|
grep {! m!^README\.(\S+)! || $state->{ignore}{$1}} split "\n", $prev; |
| 144 |
< |
join "\n", ( |
| 145 |
< |
# Dictionary order - fold and handle non-word chars as nothing |
| 146 |
< |
map { $_->[0] } |
| 147 |
< |
sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] } |
| 148 |
< |
map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] } |
| 149 |
< |
@manifest, |
| 150 |
< |
&generate_manifest_pod(), |
| 151 |
< |
&generate_manifest_readme()), ''; |
| 144 |
> |
# NOTE - the sort code here is shared with Porting/manisort currently. |
| 145 |
> |
# If you change one, change the other. Or refactor them. :-) |
| 146 |
> |
join "\n", sort_manifest( |
| 147 |
> |
@manifest, |
| 148 |
> |
&generate_manifest_pod(), |
| 149 |
> |
&generate_manifest_readme() |
| 150 |
> |
), |
| 151 |
> |
'', # elegant way to add a newline to the end |
| 152 |
> |
; |
| 153 |
|
} |
| 154 |
|
|
| 155 |
|
sub do_nmake { |
| 156 |
|
my ($name, $makefile) = @_; |
| 157 |
< |
$makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm; |
| 158 |
< |
verify_contiguous($name, $makefile, 'README copies'); |
| 157 |
> |
my $re = qr/^\tcopy \.\.\\README[^\n]*\n/sm; |
| 158 |
> |
$makefile = verify_contiguous($name, $makefile, $re, 'README copies'); |
| 159 |
|
# Now remove the other copies that follow |
| 160 |
|
1 while $makefile =~ s/\0\tcopy .*\n/\0/gm; |
| 161 |
|
$makefile =~ s/\0+/join ("", &generate_nmake_1)/se; |
| 167 |
|
|
| 168 |
|
# shut up used only once warning |
| 169 |
|
*do_dmake = *do_dmake = \&do_nmake; |
| 170 |
+ |
*do_gmake = *do_gmake = \&do_nmake; |
| 171 |
|
|
| 172 |
|
sub do_podmak { |
| 173 |
|
my ($name, $body) = @_; |
| 185 |
|
# Looking for the macro defining the current perldelta: |
| 186 |
|
#PERLDELTA_CURRENT = [.pod]perl5139delta.pod |
| 187 |
|
|
| 188 |
< |
$makefile =~ s{\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n} |
| 189 |
< |
{\0}sx; |
| 190 |
< |
verify_contiguous($name, $makefile, 'current perldelta macro'); |
| 188 |
> |
my $re = qr{\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n}smx; |
| 189 |
> |
$makefile |
| 190 |
> |
= verify_contiguous($name, $makefile, $re, 'current perldelta macro'); |
| 191 |
|
$makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se; |
| 192 |
|
|
| 193 |
|
$makefile; |
| 208 |
|
# although it seems that HP-UX make gets confused, always tried to |
| 209 |
|
# regenerate the symlink, and then the ln -s fails, as the target exists. |
| 210 |
|
|
| 211 |
< |
$makefile_SH =~ s!( |
| 211 |
> |
my $re = qr{( |
| 212 |
|
pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod |
| 213 |
|
\$\(RMS\) pod/perl[a-z0-9_]+\.pod |
| 214 |
|
\$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod |
| 215 |
< |
)+!\0!gm; |
| 215 |
> |
)+}sm; |
| 216 |
> |
$makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules'); |
| 217 |
|
|
| 216 |
– |
verify_contiguous($name, $makefile_SH, 'copy rules'); |
| 217 |
– |
|
| 218 |
|
my @copy_rules = map " |
| 219 |
|
pod/$_: pod/$state->{copies}{$_} |
| 220 |
|
\$(RMS) pod/$_ |
| 226 |
|
} |
| 227 |
|
|
| 228 |
|
# Do stuff |
| 229 |
< |
while (my ($target, $name) = each %Build) { |
| 230 |
< |
print "Now processing $name\n" if $Verbose; |
| 229 |
> |
process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose) |
| 230 |
> |
foreach sort keys %Build; |
| 231 |
|
|
| 232 |
– |
my $orig = slurp_or_die($name); |
| 233 |
– |
my_die "$name contains NUL bytes" if $orig =~ /\0/; |
| 234 |
– |
|
| 235 |
– |
my $new = do { |
| 236 |
– |
no strict 'refs'; |
| 237 |
– |
&{"do_$target"}($target, $orig); |
| 238 |
– |
}; |
| 239 |
– |
|
| 240 |
– |
if ($Test) { |
| 241 |
– |
printf "%s %d # $name is up to date\n", |
| 242 |
– |
$new eq $orig ? 'ok' : 'not ok', |
| 243 |
– |
++$test; |
| 244 |
– |
next; |
| 245 |
– |
} elsif ($new eq $orig) { |
| 246 |
– |
print "Was not modified\n" |
| 247 |
– |
if $Verbose; |
| 248 |
– |
next; |
| 249 |
– |
} |
| 250 |
– |
|
| 251 |
– |
my $mode = (stat $name)[2] // my_die "Can't stat $name: $!"; |
| 252 |
– |
rename $name, "$name.old" or my_die "Can't rename $name to $name.old: $!"; |
| 253 |
– |
|
| 254 |
– |
write_or_die($name, $new); |
| 255 |
– |
chmod $mode & 0777, $name or my_die "can't chmod $mode $name: $!"; |
| 256 |
– |
} |
| 257 |
– |
|
| 258 |
– |
# Local variables: |
| 259 |
– |
# cperl-indent-level: 4 |
| 260 |
– |
# indent-tabs-mode: nil |
| 261 |
– |
# End: |
| 262 |
– |
# |
| 232 |
|
# ex: set ts=8 sts=4 sw=4 et: |
