Commit | Line | Data |
---|---|---|
b78c1104 NC |
1 | #!/usr/bin/perl -w |
2 | ||
3 | use strict; | |
4 | use vars qw(%Build %Targets $Verbose $Test); | |
5 | use Text::Tabs; | |
6 | use Text::Wrap; | |
7 | use Getopt::Long; | |
b78c1104 | 8 | |
ff23b6f8 KW |
9 | if (ord("A") == 193) { |
10 | print "1..0 # EBCDIC sort order is different\n"; | |
11 | exit; | |
12 | } | |
13 | ||
0aef0fe5 | 14 | # Generate the sections of files listed in %Targets from pod/perl.pod |
b78c1104 NC |
15 | # Mostly these are rules in Makefiles |
16 | # | |
17 | # --verbose gives slightly more output | |
18 | # --build-all tries to build everything | |
19 | # --build-foo updates foo as follows | |
20 | # --showfiles shows the files to be changed | |
0aef0fe5 | 21 | # --test exit if perl.pod, MANIFEST are consistent, and regenerated |
b78c1104 NC |
22 | # files are up to date, die otherwise. |
23 | ||
24 | %Targets = ( | |
25 | manifest => 'MANIFEST', | |
b78c1104 NC |
26 | vms => 'vms/descrip_mms.template', |
27 | nmake => 'win32/Makefile', | |
28 | dmake => 'win32/makefile.mk', | |
1599518e | 29 | gmake => 'win32/GNUmakefile', |
b78c1104 NC |
30 | podmak => 'win32/pod.mak', |
31 | unix => 'Makefile.SH', | |
32 | # plan9 => 'plan9/mkfile', | |
33 | ); | |
34 | ||
35 | require 'Porting/pod_lib.pl'; | |
36 | sub my_die; | |
37 | ||
38 | # process command-line switches | |
39 | { | |
40 | my @files = keys %Targets; | |
41 | my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files); | |
42 | my $showfiles; | |
43 | my %build_these; | |
44 | die "$0: Usage: $0 [--verbose] [--showfiles] [$filesopts]\n" | |
45 | unless GetOptions (verbose => \$Verbose, | |
46 | showfiles => \$showfiles, | |
47 | tap => \$Test, | |
48 | map {+"build-$_", \$build_these{$_}} @files, 'all') | |
49 | && !@ARGV; | |
50 | if ($build_these{all}) { | |
51 | %Build = %Targets; | |
52 | } else { | |
53 | while (my ($file, $want) = each %build_these) { | |
54 | $Build{$file} = $Targets{$file} if $want; | |
55 | } | |
56 | # Default to --build-all if no targets given. | |
57 | %Build = %Targets if !%Build; | |
58 | } | |
59 | if ($showfiles) { | |
60 | print join(" ", sort { lc $a cmp lc $b } values %Build), "\n"; | |
61 | exit(0); | |
62 | } | |
63 | } | |
64 | ||
65 | if ($Verbose) { | |
23645649 | 66 | print "I will be building $_\n" foreach sort keys %Build; |
b78c1104 NC |
67 | } |
68 | ||
d4c6b7ae | 69 | my $test = 1; |
9e241592 NC |
70 | # For testing, generated files must be present and we're rebuilding nothing. |
71 | # For normal rebuilding, generated files may not be present, and we mute | |
72 | # warnings about inconsistencies in any file we're about to rebuild. | |
d4c6b7ae NC |
73 | my $state = $Test |
74 | ? get_pod_metadata(0, sub { | |
75 | printf "1..%d\n", 1 + scalar keys %Build; | |
76 | if (@_) { | |
23645649 | 77 | print "not ok $test # got Pod metadata\n"; |
d4c6b7ae NC |
78 | die @_; |
79 | } | |
23645649 | 80 | print "ok $test # got Pod metadata\n"; |
d4c6b7ae NC |
81 | }) |
82 | : get_pod_metadata(1, sub { warn @_ if @_ }, values %Build); | |
b78c1104 | 83 | |
b78c1104 NC |
84 | sub generate_manifest { |
85 | # Annoyingly, unexpand doesn't consider it good form to replace a single | |
86 | # space before a tab with a tab | |
87 | # Annoyingly (2) it returns read only values. | |
88 | my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_); | |
89 | map {s/ \t/\t\t/g; $_} @temp; | |
90 | } | |
91 | ||
92 | sub generate_manifest_pod { | |
93 | generate_manifest map {["pod/$_.pod", $state->{pods}{$_}]} | |
94 | sort grep { | |
95 | !$state->{copies}{"$_.pod"} | |
96 | && !$state->{generated}{"$_.pod"} | |
97 | && !-e "$_.pod" | |
98 | } keys %{$state->{pods}}; | |
99 | } | |
100 | ||
101 | sub generate_manifest_readme { | |
102 | generate_manifest sort {$a->[0] cmp $b->[0]} | |
103 | ["README.vms", "Notes about installing the VMS port"], | |
104 | map {["README.$_", $state->{readmes}{$_}]} keys %{$state->{readmes}}; | |
105 | } | |
106 | ||
107 | sub generate_nmake_1 { | |
108 | # XXX Fix this with File::Spec | |
109 | (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_} | |
110 | sort keys %{$state->{readmes}}), | |
111 | (map {"\tcopy ..\\pod\\$state->{copies}{$_} ..\\pod\\$_\n"} | |
112 | sort keys %{$state->{copies}}); | |
113 | } | |
114 | ||
115 | # This doesn't have a trailing newline | |
116 | sub generate_nmake_2 { | |
117 | # Spot the special case | |
118 | local $Text::Wrap::columns = 76; | |
119 | my $line = wrap ("\t ", "\t ", | |
120 | join " ", sort(keys %{$state->{copies}}, | |
121 | keys %{$state->{generated}}, | |
122 | map {"perl$_.pod"} keys %{$state->{readmes}})); | |
123 | $line =~ s/$/ \\/mg; | |
124 | $line =~ s/ \\$//; | |
125 | $line; | |
126 | } | |
127 | ||
128 | sub generate_pod_mak { | |
129 | my $variable = shift; | |
130 | my @lines; | |
131 | my $line = "\U$variable = " . join "\t\\\n\t", | |
132 | map {"$_.$variable"} sort grep { $_ !~ m{/} } keys %{$state->{pods}}; | |
133 | # Special case | |
134 | $line =~ s/.*perltoc.html.*\n//m; | |
135 | $line; | |
136 | } | |
137 | ||
b78c1104 NC |
138 | sub do_manifest { |
139 | my ($name, $prev) = @_; | |
140 | my @manifest = | |
0aef0fe5 | 141 | grep {! m!^pod/[^. \t]+\.pod.*!} |
b78c1104 NC |
142 | grep {! m!^README\.(\S+)! || $state->{ignore}{$1}} split "\n", $prev; |
143 | join "\n", ( | |
144 | # Dictionary order - fold and handle non-word chars as nothing | |
145 | map { $_->[0] } | |
146 | sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] } | |
147 | map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] } | |
148 | @manifest, | |
149 | &generate_manifest_pod(), | |
150 | &generate_manifest_readme()), ''; | |
151 | } | |
152 | ||
153 | sub do_nmake { | |
154 | my ($name, $makefile) = @_; | |
8f55fd21 NC |
155 | my $re = qr/^\tcopy \.\.\\README[^\n]*\n/sm; |
156 | $makefile = verify_contiguous($name, $makefile, $re, 'README copies'); | |
b78c1104 NC |
157 | # Now remove the other copies that follow |
158 | 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm; | |
159 | $makefile =~ s/\0+/join ("", &generate_nmake_1)/se; | |
160 | ||
161 | $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)} | |
162 | {"$1\n" . &generate_nmake_2."\n\t$2"}se; | |
163 | $makefile; | |
164 | } | |
165 | ||
166 | # shut up used only once warning | |
167 | *do_dmake = *do_dmake = \&do_nmake; | |
1599518e | 168 | *do_gmake = *do_gmake = \&do_nmake; |
b78c1104 | 169 | |
b78c1104 NC |
170 | sub do_podmak { |
171 | my ($name, $body) = @_; | |
172 | foreach my $variable (qw(pod man html tex)) { | |
173 | my_die "could not find $variable in $name" | |
174 | unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*} | |
175 | {"\n" . generate_pod_mak ($variable)}se; | |
176 | } | |
177 | $body; | |
178 | } | |
179 | ||
180 | sub do_vms { | |
181 | my ($name, $makefile) = @_; | |
182 | ||
183 | # Looking for the macro defining the current perldelta: | |
184 | #PERLDELTA_CURRENT = [.pod]perl5139delta.pod | |
185 | ||
8f55fd21 NC |
186 | my $re = qr{\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n}smx; |
187 | $makefile | |
188 | = verify_contiguous($name, $makefile, $re, 'current perldelta macro'); | |
b78c1104 NC |
189 | $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se; |
190 | ||
191 | $makefile; | |
192 | } | |
193 | ||
194 | sub do_unix { | |
195 | my ($name, $makefile_SH) = @_; | |
196 | ||
197 | $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*} | |
198 | {join ' ', $1, map "pod/$_", | |
199 | sort(keys %{$state->{copies}}, | |
200 | grep {!/perltoc/} keys %{$state->{generated}}) | |
201 | }mge; | |
202 | ||
203 | # pod/perl511delta.pod: pod/perldelta.pod | |
204 | # cd pod && $(LNS) perldelta.pod perl511delta.pod | |
205 | ||
9fa1f09f NC |
206 | # although it seems that HP-UX make gets confused, always tried to |
207 | # regenerate the symlink, and then the ln -s fails, as the target exists. | |
208 | ||
8f55fd21 | 209 | my $re = qr{( |
b78c1104 | 210 | pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod |
9fa1f09f | 211 | \$\(RMS\) pod/perl[a-z0-9_]+\.pod |
b78c1104 | 212 | \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod |
8f55fd21 NC |
213 | )+}sm; |
214 | $makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules'); | |
b78c1104 NC |
215 | |
216 | my @copy_rules = map " | |
217 | pod/$_: pod/$state->{copies}{$_} | |
9fa1f09f | 218 | \$(RMS) pod/$_ |
b78c1104 NC |
219 | \$(LNS) $state->{copies}{$_} pod/$_ |
220 | ", keys %{$state->{copies}}; | |
221 | ||
222 | $makefile_SH =~ s/\0+/join '', @copy_rules/se; | |
223 | $makefile_SH; | |
224 | } | |
225 | ||
a2b7b21f | 226 | # Do stuff |
23645649 NC |
227 | process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose) |
228 | foreach sort keys %Build; | |
a2b7b21f | 229 | |
b78c1104 | 230 | # ex: set ts=8 sts=4 sw=4 et: |