This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Makefile.SH needs to delete the perldelta symlink before creating it.
[perl5.git] / Porting / pod_rules.pl
CommitLineData
b78c1104
NC
1#!/usr/bin/perl -w
2
3use strict;
4use vars qw(%Build %Targets $Verbose $Test);
5use Text::Tabs;
6use Text::Wrap;
7use Getopt::Long;
8use Carp;
9
0aef0fe5 10# Generate the sections of files listed in %Targets from pod/perl.pod
b78c1104
NC
11# Mostly these are rules in Makefiles
12#
13# --verbose gives slightly more output
14# --build-all tries to build everything
15# --build-foo updates foo as follows
16# --showfiles shows the files to be changed
0aef0fe5 17# --test exit if perl.pod, MANIFEST are consistent, and regenerated
b78c1104
NC
18# files are up to date, die otherwise.
19
20%Targets = (
21 manifest => 'MANIFEST',
b78c1104
NC
22 vms => 'vms/descrip_mms.template',
23 nmake => 'win32/Makefile',
24 dmake => 'win32/makefile.mk',
25 podmak => 'win32/pod.mak',
26 unix => 'Makefile.SH',
27 # plan9 => 'plan9/mkfile',
28 );
29
30require 'Porting/pod_lib.pl';
31sub my_die;
32
33# process command-line switches
34{
35 my @files = keys %Targets;
36 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
37 my $showfiles;
38 my %build_these;
39 die "$0: Usage: $0 [--verbose] [--showfiles] [$filesopts]\n"
40 unless GetOptions (verbose => \$Verbose,
41 showfiles => \$showfiles,
42 tap => \$Test,
43 map {+"build-$_", \$build_these{$_}} @files, 'all')
44 && !@ARGV;
45 if ($build_these{all}) {
46 %Build = %Targets;
47 } else {
48 while (my ($file, $want) = each %build_these) {
49 $Build{$file} = $Targets{$file} if $want;
50 }
51 # Default to --build-all if no targets given.
52 %Build = %Targets if !%Build;
53 }
54 if ($showfiles) {
55 print join(" ", sort { lc $a cmp lc $b } values %Build), "\n";
56 exit(0);
57 }
58}
59
60if ($Verbose) {
61 print "I will be building $_\n" foreach keys %Build;
62}
63
d4c6b7ae 64my $test = 1;
9e241592
NC
65# For testing, generated files must be present and we're rebuilding nothing.
66# For normal rebuilding, generated files may not be present, and we mute
67# warnings about inconsistencies in any file we're about to rebuild.
d4c6b7ae
NC
68my $state = $Test
69 ? get_pod_metadata(0, sub {
70 printf "1..%d\n", 1 + scalar keys %Build;
71 if (@_) {
72 print "not ok $test\n";
73 die @_;
74 }
75 print "ok $test\n";
76 })
77 : get_pod_metadata(1, sub { warn @_ if @_ }, values %Build);
b78c1104 78
b78c1104
NC
79sub generate_manifest {
80 # Annoyingly, unexpand doesn't consider it good form to replace a single
81 # space before a tab with a tab
82 # Annoyingly (2) it returns read only values.
83 my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_);
84 map {s/ \t/\t\t/g; $_} @temp;
85}
86
87sub generate_manifest_pod {
88 generate_manifest map {["pod/$_.pod", $state->{pods}{$_}]}
89 sort grep {
90 !$state->{copies}{"$_.pod"}
91 && !$state->{generated}{"$_.pod"}
92 && !-e "$_.pod"
93 } keys %{$state->{pods}};
94}
95
96sub generate_manifest_readme {
97 generate_manifest sort {$a->[0] cmp $b->[0]}
98 ["README.vms", "Notes about installing the VMS port"],
99 map {["README.$_", $state->{readmes}{$_}]} keys %{$state->{readmes}};
100}
101
102sub generate_nmake_1 {
103 # XXX Fix this with File::Spec
104 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
105 sort keys %{$state->{readmes}}),
106 (map {"\tcopy ..\\pod\\$state->{copies}{$_} ..\\pod\\$_\n"}
107 sort keys %{$state->{copies}});
108}
109
110# This doesn't have a trailing newline
111sub generate_nmake_2 {
112 # Spot the special case
113 local $Text::Wrap::columns = 76;
114 my $line = wrap ("\t ", "\t ",
115 join " ", sort(keys %{$state->{copies}},
116 keys %{$state->{generated}},
117 map {"perl$_.pod"} keys %{$state->{readmes}}));
118 $line =~ s/$/ \\/mg;
119 $line =~ s/ \\$//;
120 $line;
121}
122
123sub generate_pod_mak {
124 my $variable = shift;
125 my @lines;
126 my $line = "\U$variable = " . join "\t\\\n\t",
127 map {"$_.$variable"} sort grep { $_ !~ m{/} } keys %{$state->{pods}};
128 # Special case
129 $line =~ s/.*perltoc.html.*\n//m;
130 $line;
131}
132
133sub verify_contiguous {
134 my ($name, $content, $what) = @_;
135 my $sections = () = $content =~ m/\0+/g;
136 croak("$0: $name contains no $what") if $sections < 1;
137 croak("$0: $name contains discontiguous $what") if $sections > 1;
138}
139
140sub do_manifest {
141 my ($name, $prev) = @_;
142 my @manifest =
0aef0fe5 143 grep {! m!^pod/[^. \t]+\.pod.*!}
b78c1104
NC
144 grep {! m!^README\.(\S+)! || $state->{ignore}{$1}} split "\n", $prev;
145 join "\n", (
146 # Dictionary order - fold and handle non-word chars as nothing
147 map { $_->[0] }
148 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
149 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
150 @manifest,
151 &generate_manifest_pod(),
152 &generate_manifest_readme()), '';
153}
154
155sub do_nmake {
156 my ($name, $makefile) = @_;
157 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
158 verify_contiguous($name, $makefile, '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
b78c1104
NC
171sub do_podmak {
172 my ($name, $body) = @_;
173 foreach my $variable (qw(pod man html tex)) {
174 my_die "could not find $variable in $name"
175 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
176 {"\n" . generate_pod_mak ($variable)}se;
177 }
178 $body;
179}
180
181sub do_vms {
182 my ($name, $makefile) = @_;
183
184 # Looking for the macro defining the current perldelta:
185 #PERLDELTA_CURRENT = [.pod]perl5139delta.pod
186
187 $makefile =~ s{\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n}
188 {\0}sx;
189 verify_contiguous($name, $makefile, 'current perldelta macro');
190 $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se;
191
192 $makefile;
193}
194
195sub do_unix {
196 my ($name, $makefile_SH) = @_;
197
198 $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
199 {join ' ', $1, map "pod/$_",
200 sort(keys %{$state->{copies}},
201 grep {!/perltoc/} keys %{$state->{generated}})
202 }mge;
203
204 # pod/perl511delta.pod: pod/perldelta.pod
205 # cd pod && $(LNS) perldelta.pod perl511delta.pod
206
9fa1f09f
NC
207 # although it seems that HP-UX make gets confused, always tried to
208 # regenerate the symlink, and then the ln -s fails, as the target exists.
209
b78c1104
NC
210 $makefile_SH =~ s!(
211pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
9fa1f09f 212 \$\(RMS\) pod/perl[a-z0-9_]+\.pod
b78c1104
NC
213 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
214)+!\0!gm;
215
216 verify_contiguous($name, $makefile_SH, 'copy rules');
217
218 my @copy_rules = map "
219pod/$_: 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
228# Do stuff
45464ee1 229while (my ($target, $name) = each %Build) {
b78c1104
NC
230 print "Now processing $name\n" if $Verbose;
231
3b0c5c72 232 my $orig = slurp_or_die($name);
b78c1104
NC
233 my_die "$name contains NUL bytes" if $orig =~ /\0/;
234
235 my $new = do {
236 no strict 'refs';
237 &{"do_$target"}($target, $orig);
238 };
239
240 if ($Test) {
241 printf "%s %d # $name is up to date\n",
242 $new eq $orig ? 'ok' : 'not ok',
243 ++$test;
244 next;
245 } elsif ($new eq $orig) {
246 print "Was not modified\n"
247 if $Verbose;
248 next;
249 }
250
251 my $mode = (stat $name)[2] // my_die "Can't stat $name: $!";
252 rename $name, "$name.old" or my_die "Can't rename $name to $name.old: $!";
253
3b0c5c72 254 write_or_die($name, $new);
b78c1104
NC
255 chmod $mode & 0777, $name or my_die "can't chmod $mode $name: $!";
256}
257
258# Local variables:
259# cperl-indent-level: 4
260# indent-tabs-mode: nil
261# End:
262#
263# ex: set ts=8 sts=4 sw=4 et: