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