(perl #131836) avoid a use-after-free after parsing a "sub" keyword
[perl.git] / Porting / pod_rules.pl
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;
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 #
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
21 # --test exit if perl.pod, MANIFEST are consistent, and regenerated
22 #   files are up to date, die otherwise.
23
24 %Targets = (
25             manifest => 'MANIFEST',
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';
36 require './Porting/manifest_lib.pl';
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) {
67     print "I will be building $_\n" foreach sort keys %Build;
68 }
69
70 my $test = 1;
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.
74 my $state = $Test
75     ? get_pod_metadata(0, sub {
76                            printf "1..%d\n", 1 + scalar keys %Build;
77                            if (@_) {
78                                print "not ok $test # got Pod metadata\n";
79                                die @_;
80                            }
81                            print "ok $test # got Pod metadata\n";
82                        })
83     : get_pod_metadata(1, sub { warn @_ if @_ }, values %Build);
84
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
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     # 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     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;
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;
170 *do_gmake = *do_gmake = \&do_nmake;
171
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
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;
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
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     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 )+}sm;
216     $makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules');
217
218     my @copy_rules = map "
219 pod/$_: pod/$state->{copies}{$_}
220         \$(RMS) pod/$_
221         \$(LNS) $state->{copies}{$_} pod/$_
222 ", keys %{$state->{copies}};
223
224     $makefile_SH =~ s/\0+/join '', @copy_rules/se;
225     $makefile_SH;
226 }
227
228 # Do stuff
229 process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose)
230     foreach sort keys %Build;
231
232 # ex: set ts=8 sts=4 sw=4 et: