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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
#!/usr/bin/perl -w
use strict;
use vars qw(%Build %Targets $Verbose $Test);
use Text::Tabs;
use Text::Wrap;
use Getopt::Long;
# Generate the sections of files listed in %Targets from pod/perl.pod
# Mostly these are rules in Makefiles
#
# --verbose gives slightly more output
# --build-all tries to build everything
# --build-foo updates foo as follows
# --showfiles shows the files to be changed
# --test exit if perl.pod, MANIFEST are consistent, and regenerated
# files are up to date, die otherwise.
%Targets = (
manifest => 'MANIFEST',
vms => 'vms/descrip_mms.template',
nmake => 'win32/Makefile',
dmake => 'win32/makefile.mk',
podmak => 'win32/pod.mak',
unix => 'Makefile.SH',
# plan9 => 'plan9/mkfile',
);
require 'Porting/pod_lib.pl';
sub my_die;
# process command-line switches
{
my @files = keys %Targets;
my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
my $showfiles;
my %build_these;
die "$0: Usage: $0 [--verbose] [--showfiles] [$filesopts]\n"
unless GetOptions (verbose => \$Verbose,
showfiles => \$showfiles,
tap => \$Test,
map {+"build-$_", \$build_these{$_}} @files, 'all')
&& !@ARGV;
if ($build_these{all}) {
%Build = %Targets;
} else {
while (my ($file, $want) = each %build_these) {
$Build{$file} = $Targets{$file} if $want;
}
# Default to --build-all if no targets given.
%Build = %Targets if !%Build;
}
if ($showfiles) {
print join(" ", sort { lc $a cmp lc $b } values %Build), "\n";
exit(0);
}
}
if ($Verbose) {
print "I will be building $_\n" foreach sort keys %Build;
}
my $test = 1;
# For testing, generated files must be present and we're rebuilding nothing.
# For normal rebuilding, generated files may not be present, and we mute
# warnings about inconsistencies in any file we're about to rebuild.
my $state = $Test
? get_pod_metadata(0, sub {
printf "1..%d\n", 1 + scalar keys %Build;
if (@_) {
print "not ok $test # got Pod metadata\n";
die @_;
}
print "ok $test # got Pod metadata\n";
})
: get_pod_metadata(1, sub { warn @_ if @_ }, values %Build);
sub generate_manifest {
# Annoyingly, unexpand doesn't consider it good form to replace a single
# space before a tab with a tab
# Annoyingly (2) it returns read only values.
my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_);
map {s/ \t/\t\t/g; $_} @temp;
}
sub generate_manifest_pod {
generate_manifest map {["pod/$_.pod", $state->{pods}{$_}]}
sort grep {
!$state->{copies}{"$_.pod"}
&& !$state->{generated}{"$_.pod"}
&& !-e "$_.pod"
} keys %{$state->{pods}};
}
sub generate_manifest_readme {
generate_manifest sort {$a->[0] cmp $b->[0]}
["README.vms", "Notes about installing the VMS port"],
map {["README.$_", $state->{readmes}{$_}]} keys %{$state->{readmes}};
}
sub generate_nmake_1 {
# XXX Fix this with File::Spec
(map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
sort keys %{$state->{readmes}}),
(map {"\tcopy ..\\pod\\$state->{copies}{$_} ..\\pod\\$_\n"}
sort keys %{$state->{copies}});
}
# This doesn't have a trailing newline
sub generate_nmake_2 {
# Spot the special case
local $Text::Wrap::columns = 76;
my $line = wrap ("\t ", "\t ",
join " ", sort(keys %{$state->{copies}},
keys %{$state->{generated}},
map {"perl$_.pod"} keys %{$state->{readmes}}));
$line =~ s/$/ \\/mg;
$line =~ s/ \\$//;
$line;
}
sub generate_pod_mak {
my $variable = shift;
my @lines;
my $line = "\U$variable = " . join "\t\\\n\t",
map {"$_.$variable"} sort grep { $_ !~ m{/} } keys %{$state->{pods}};
# Special case
$line =~ s/.*perltoc.html.*\n//m;
$line;
}
sub do_manifest {
my ($name, $prev) = @_;
my @manifest =
grep {! m!^pod/[^. \t]+\.pod.*!}
grep {! m!^README\.(\S+)! || $state->{ignore}{$1}} split "\n", $prev;
join "\n", (
# Dictionary order - fold and handle non-word chars as nothing
map { $_->[0] }
sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
@manifest,
&generate_manifest_pod(),
&generate_manifest_readme()), '';
}
sub do_nmake {
my ($name, $makefile) = @_;
my $re = qr/^\tcopy \.\.\\README[^\n]*\n/sm;
$makefile = verify_contiguous($name, $makefile, $re, 'README copies');
# Now remove the other copies that follow
1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
$makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
$makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
{"$1\n" . &generate_nmake_2."\n\t$2"}se;
$makefile;
}
# shut up used only once warning
*do_dmake = *do_dmake = \&do_nmake;
sub do_podmak {
my ($name, $body) = @_;
foreach my $variable (qw(pod man html tex)) {
my_die "could not find $variable in $name"
unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
{"\n" . generate_pod_mak ($variable)}se;
}
$body;
}
sub do_vms {
my ($name, $makefile) = @_;
# Looking for the macro defining the current perldelta:
#PERLDELTA_CURRENT = [.pod]perl5139delta.pod
my $re = qr{\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n}smx;
$makefile
= verify_contiguous($name, $makefile, $re, 'current perldelta macro');
$makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se;
$makefile;
}
sub do_unix {
my ($name, $makefile_SH) = @_;
$makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
{join ' ', $1, map "pod/$_",
sort(keys %{$state->{copies}},
grep {!/perltoc/} keys %{$state->{generated}})
}mge;
# pod/perl511delta.pod: pod/perldelta.pod
# cd pod && $(LNS) perldelta.pod perl511delta.pod
# although it seems that HP-UX make gets confused, always tried to
# regenerate the symlink, and then the ln -s fails, as the target exists.
my $re = qr{(
pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
\$\(RMS\) pod/perl[a-z0-9_]+\.pod
\$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
)+}sm;
$makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules');
my @copy_rules = map "
pod/$_: pod/$state->{copies}{$_}
\$(RMS) pod/$_
\$(LNS) $state->{copies}{$_} pod/$_
", keys %{$state->{copies}};
$makefile_SH =~ s/\0+/join '', @copy_rules/se;
$makefile_SH;
}
# Do stuff
process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose)
foreach sort keys %Build;
# Local variables:
# cperl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# ex: set ts=8 sts=4 sw=4 et:
|
