4 use vars qw(%Build %Targets $Verbose $Test);
9 # Generate the sections of files listed in %Targets from pod/perl.pod
10 # Mostly these are rules in Makefiles
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
16 # --test exit if perl.pod, MANIFEST are consistent, and regenerated
17 # files are up to date, die otherwise.
20 manifest => 'MANIFEST',
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',
29 require 'Porting/pod_lib.pl';
32 # process command-line switches
34 my @files = keys %Targets;
35 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
38 die "$0: Usage: $0 [--verbose] [--showfiles] [$filesopts]\n"
39 unless GetOptions (verbose => \$Verbose,
40 showfiles => \$showfiles,
42 map {+"build-$_", \$build_these{$_}} @files, 'all')
44 if ($build_these{all}) {
47 while (my ($file, $want) = each %build_these) {
48 $Build{$file} = $Targets{$file} if $want;
50 # Default to --build-all if no targets given.
51 %Build = %Targets if !%Build;
54 print join(" ", sort { lc $a cmp lc $b } values %Build), "\n";
60 print "I will be building $_\n" foreach sort keys %Build;
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.
68 ? get_pod_metadata(0, sub {
69 printf "1..%d\n", 1 + scalar keys %Build;
71 print "not ok $test # got Pod metadata\n";
74 print "ok $test # got Pod metadata\n";
76 : get_pod_metadata(1, sub { warn @_ if @_ }, values %Build);
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;
86 sub generate_manifest_pod {
87 generate_manifest map {["pod/$_.pod", $state->{pods}{$_}]}
89 !$state->{copies}{"$_.pod"}
90 && !$state->{generated}{"$_.pod"}
92 } keys %{$state->{pods}};
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}};
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}});
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}}));
122 sub generate_pod_mak {
123 my $variable = shift;
125 my $line = "\U$variable = " . join "\t\\\n\t",
126 map {"$_.$variable"} sort grep { $_ !~ m{/} } keys %{$state->{pods}};
128 $line =~ s/.*perltoc.html.*\n//m;
133 my ($name, $prev) = @_;
135 grep {! m!^pod/[^. \t]+\.pod.*!}
136 grep {! m!^README\.(\S+)! || $state->{ignore}{$1}} split "\n", $prev;
138 # Dictionary order - fold and handle non-word chars as nothing
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 ] }
143 &generate_manifest_pod(),
144 &generate_manifest_readme()), '';
148 my ($name, $makefile) = @_;
149 my $re = qr/^\tcopy \.\.\\README[^\n]*\n/sm;
150 $makefile = verify_contiguous($name, $makefile, $re, 'README copies');
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;
155 $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
156 {"$1\n" . &generate_nmake_2."\n\t$2"}se;
160 # shut up used only once warning
161 *do_dmake = *do_dmake = \&do_nmake;
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;
174 my ($name, $makefile) = @_;
176 # Looking for the macro defining the current perldelta:
177 #PERLDELTA_CURRENT = [.pod]perl5139delta.pod
179 my $re = qr{\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n}smx;
181 = verify_contiguous($name, $makefile, $re, 'current perldelta macro');
182 $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se;
188 my ($name, $makefile_SH) = @_;
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}})
196 # pod/perl511delta.pod: pod/perldelta.pod
197 # cd pod && $(LNS) perldelta.pod perl511delta.pod
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.
203 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
204 \$\(RMS\) pod/perl[a-z0-9_]+\.pod
205 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
207 $makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules');
209 my @copy_rules = map "
210 pod/$_: pod/$state->{copies}{$_}
212 \$(LNS) $state->{copies}{$_} pod/$_
213 ", keys %{$state->{copies}};
215 $makefile_SH =~ s/\0+/join '', @copy_rules/se;
220 process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose)
221 foreach sort keys %Build;
224 # cperl-indent-level: 4
225 # indent-tabs-mode: nil
228 # ex: set ts=8 sts=4 sw=4 et: