Porting/pod_rules.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 our (%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 # --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
  33 require './Porting/pod_lib.pl';
  34 require './Porting/manifest_lib.pl';
  35 sub 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
  64 if ($Verbose) {
  65     print "I will be building $_\n" foreach sort keys %Build;
  66 }
  67
  68 my $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.
  72 my $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
  83 sub 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
  91 sub 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
 100 sub 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
 106 sub 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
 115 sub 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
 127 sub 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
 137 sub 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
 153 sub 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
 169 sub 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
 179 sub 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
 193 sub 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{(
 209 pod/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 "
 216 pod/$_: 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
 226 process($_, $Build{$_}, main->can("do_$_"), $Test && ++$test, $Verbose)
 227     foreach sort keys %Build;
 228
 229 # ex: set ts=8 sts=4 sw=4 et: