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