xref: /openbsd-src/gnu/usr.bin/perl/Porting/pod_rules.pl (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1#!/usr/bin/perl -w
2
3use strict;
4use vars qw(%Build %Targets $Verbose $Test);
5use Text::Tabs;
6use Text::Wrap;
7use Getopt::Long;
8
9# Generate the sections of files listed in %Targets from pod/perl.pod
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
16# --test exit if perl.pod, MANIFEST are consistent, and regenerated
17#   files are up to date, die otherwise.
18
19%Targets = (
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',
27           );
28
29require 'Porting/pod_lib.pl';
30sub 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
59if ($Verbose) {
60    print "I will be building $_\n" foreach sort keys %Build;
61}
62
63my $test = 1;
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.
67my $state = $Test
68    ? get_pod_metadata(0, sub {
69                           printf "1..%d\n", 1 + scalar keys %Build;
70                           if (@_) {
71                               print "not ok $test # got Pod metadata\n";
72                               die @_;
73                           }
74                           print "ok $test # got Pod metadata\n";
75                       })
76    : get_pod_metadata(1, sub { warn @_ if @_ }, values %Build);
77
78sub 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
86sub 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
95sub 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
101sub 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
110sub 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
122sub 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
132sub do_manifest {
133    my ($name, $prev) = @_;
134    my @manifest =
135        grep {! m!^pod/[^. \t]+\.pod.*!}
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
147sub do_nmake {
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;
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
163sub 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
173sub do_vms {
174    my ($name, $makefile) = @_;
175
176    # Looking for the macro defining the current perldelta:
177    #PERLDELTA_CURRENT = [.pod]perl5139delta.pod
178
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');
182    $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se;
183
184    $makefile;
185}
186
187sub 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
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
202    my $re = qr{(
203pod/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
206)+}sm;
207    $makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules');
208
209    my @copy_rules = map "
210pod/$_: pod/$state->{copies}{$_}
211	\$(RMS) pod/$_
212	\$(LNS) $state->{copies}{$_} pod/$_
213", keys %{$state->{copies}};
214
215    $makefile_SH =~ s/\0+/join '', @copy_rules/se;
216    $makefile_SH;
217}
218
219# Do stuff
220process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose)
221    foreach sort keys %Build;
222
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:
229