Commit | Line | Data |
---|---|---|
b78c1104 NC |
1 | #!/usr/bin/perl -w |
2 | ||
3 | use strict; | |
3d3a0a8a | 4 | our (%Build, %Targets, $Verbose, $Test); |
b78c1104 NC |
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 | ||
3d7c117d MB |
35 | require './Porting/pod_lib.pl'; |
36 | require './Porting/manifest_lib.pl'; | |
b78c1104 NC |
37 | sub my_die; |
38 | ||
39 | # process command-line switches | |
40 | { | |
41 | my @files = keys %Targets; | |
42 | my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files); | |
43 | my $showfiles; | |
44 | my %build_these; | |
45 | die "$0: Usage: $0 [--verbose] [--showfiles] [$filesopts]\n" | |
46 | unless GetOptions (verbose => \$Verbose, | |
47 | showfiles => \$showfiles, | |
48 | tap => \$Test, | |
49 | map {+"build-$_", \$build_these{$_}} @files, 'all') | |
50 | && !@ARGV; | |
51 | if ($build_these{all}) { | |
52 | %Build = %Targets; | |
53 | } else { | |
54 | while (my ($file, $want) = each %build_these) { | |
55 | $Build{$file} = $Targets{$file} if $want; | |
56 | } | |
57 | # Default to --build-all if no targets given. | |
58 | %Build = %Targets if !%Build; | |
59 | } | |
60 | if ($showfiles) { | |
61 | print join(" ", sort { lc $a cmp lc $b } values %Build), "\n"; | |
62 | exit(0); | |
63 | } | |
64 | } | |
65 | ||
66 | if ($Verbose) { | |
23645649 | 67 | print "I will be building $_\n" foreach sort keys %Build; |
b78c1104 NC |
68 | } |
69 | ||
d4c6b7ae | 70 | my $test = 1; |
9e241592 NC |
71 | # For testing, generated files must be present and we're rebuilding nothing. |
72 | # For normal rebuilding, generated files may not be present, and we mute | |
73 | # warnings about inconsistencies in any file we're about to rebuild. | |
d4c6b7ae NC |
74 | my $state = $Test |
75 | ? get_pod_metadata(0, sub { | |
76 | printf "1..%d\n", 1 + scalar keys %Build; | |
77 | if (@_) { | |
23645649 | 78 | print "not ok $test # got Pod metadata\n"; |
d4c6b7ae NC |
79 | die @_; |
80 | } | |
23645649 | 81 | print "ok $test # got Pod metadata\n"; |
d4c6b7ae NC |
82 | }) |
83 | : get_pod_metadata(1, sub { warn @_ if @_ }, values %Build); | |
b78c1104 | 84 | |
b78c1104 NC |
85 | sub generate_manifest { |
86 | # Annoyingly, unexpand doesn't consider it good form to replace a single | |
87 | # space before a tab with a tab | |
88 | # Annoyingly (2) it returns read only values. | |
89 | my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_); | |
90 | map {s/ \t/\t\t/g; $_} @temp; | |
91 | } | |
92 | ||
93 | sub generate_manifest_pod { | |
94 | generate_manifest map {["pod/$_.pod", $state->{pods}{$_}]} | |
95 | sort grep { | |
96 | !$state->{copies}{"$_.pod"} | |
97 | && !$state->{generated}{"$_.pod"} | |
98 | && !-e "$_.pod" | |
99 | } keys %{$state->{pods}}; | |
100 | } | |
101 | ||
102 | sub generate_manifest_readme { | |
103 | generate_manifest sort {$a->[0] cmp $b->[0]} | |
104 | ["README.vms", "Notes about installing the VMS port"], | |
105 | map {["README.$_", $state->{readmes}{$_}]} keys %{$state->{readmes}}; | |
106 | } | |
107 | ||
108 | sub generate_nmake_1 { | |
109 | # XXX Fix this with File::Spec | |
110 | (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_} | |
111 | sort keys %{$state->{readmes}}), | |
112 | (map {"\tcopy ..\\pod\\$state->{copies}{$_} ..\\pod\\$_\n"} | |
113 | sort keys %{$state->{copies}}); | |
114 | } | |
115 | ||
116 | # This doesn't have a trailing newline | |
117 | sub generate_nmake_2 { | |
118 | # Spot the special case | |
119 | local $Text::Wrap::columns = 76; | |
120 | my $line = wrap ("\t ", "\t ", | |
121 | join " ", sort(keys %{$state->{copies}}, | |
122 | keys %{$state->{generated}}, | |
123 | map {"perl$_.pod"} keys %{$state->{readmes}})); | |
124 | $line =~ s/$/ \\/mg; | |
125 | $line =~ s/ \\$//; | |
126 | $line; | |
127 | } | |
128 | ||
129 | sub generate_pod_mak { | |
130 | my $variable = shift; | |
131 | my @lines; | |
132 | my $line = "\U$variable = " . join "\t\\\n\t", | |
133 | map {"$_.$variable"} sort grep { $_ !~ m{/} } keys %{$state->{pods}}; | |
134 | # Special case | |
135 | $line =~ s/.*perltoc.html.*\n//m; | |
136 | $line; | |
137 | } | |
138 | ||
b78c1104 NC |
139 | sub do_manifest { |
140 | my ($name, $prev) = @_; | |
141 | my @manifest = | |
0aef0fe5 | 142 | grep {! m!^pod/[^. \t]+\.pod.*!} |
b78c1104 | 143 | grep {! m!^README\.(\S+)! || $state->{ignore}{$1}} split "\n", $prev; |
3dfcef7e YO |
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 | ; | |
b78c1104 NC |
153 | } |
154 | ||
155 | sub do_nmake { | |
156 | my ($name, $makefile) = @_; | |
8f55fd21 NC |
157 | my $re = qr/^\tcopy \.\.\\README[^\n]*\n/sm; |
158 | $makefile = verify_contiguous($name, $makefile, $re, 'README copies'); | |
b78c1104 NC |
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; | |
162 | ||
163 | $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)} | |
164 | {"$1\n" . &generate_nmake_2."\n\t$2"}se; | |
165 | $makefile; | |
166 | } | |
167 | ||
168 | # shut up used only once warning | |
169 | *do_dmake = *do_dmake = \&do_nmake; | |
1599518e | 170 | *do_gmake = *do_gmake = \&do_nmake; |
b78c1104 | 171 | |
b78c1104 NC |
172 | sub do_podmak { |
173 | my ($name, $body) = @_; | |
174 | foreach my $variable (qw(pod man html tex)) { | |
175 | my_die "could not find $variable in $name" | |
176 | unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*} | |
177 | {"\n" . generate_pod_mak ($variable)}se; | |
178 | } | |
179 | $body; | |
180 | } | |
181 | ||
182 | sub do_vms { | |
183 | my ($name, $makefile) = @_; | |
184 | ||
185 | # Looking for the macro defining the current perldelta: | |
186 | #PERLDELTA_CURRENT = [.pod]perl5139delta.pod | |
187 | ||
8f55fd21 NC |
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'); | |
b78c1104 NC |
191 | $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se; |
192 | ||
193 | $makefile; | |
194 | } | |
195 | ||
196 | sub do_unix { | |
197 | my ($name, $makefile_SH) = @_; | |
198 | ||
199 | $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*} | |
200 | {join ' ', $1, map "pod/$_", | |
201 | sort(keys %{$state->{copies}}, | |
202 | grep {!/perltoc/} keys %{$state->{generated}}) | |
203 | }mge; | |
204 | ||
205 | # pod/perl511delta.pod: pod/perldelta.pod | |
206 | # cd pod && $(LNS) perldelta.pod perl511delta.pod | |
207 | ||
9fa1f09f NC |
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 | ||
8f55fd21 | 211 | my $re = qr{( |
b78c1104 | 212 | pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod |
9fa1f09f | 213 | \$\(RMS\) pod/perl[a-z0-9_]+\.pod |
b78c1104 | 214 | \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod |
8f55fd21 NC |
215 | )+}sm; |
216 | $makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules'); | |
b78c1104 NC |
217 | |
218 | my @copy_rules = map " | |
219 | pod/$_: pod/$state->{copies}{$_} | |
9fa1f09f | 220 | \$(RMS) pod/$_ |
b78c1104 NC |
221 | \$(LNS) $state->{copies}{$_} pod/$_ |
222 | ", keys %{$state->{copies}}; | |
223 | ||
224 | $makefile_SH =~ s/\0+/join '', @copy_rules/se; | |
225 | $makefile_SH; | |
226 | } | |
227 | ||
a2b7b21f | 228 | # Do stuff |
23645649 NC |
229 | process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose) |
230 | foreach sort keys %Build; | |
a2b7b21f | 231 | |
b78c1104 | 232 | # ex: set ts=8 sts=4 sw=4 et: |