Porting/pod_rules.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw(%Build %Targets $Verbose $Test);
   5 use Text::Tabs;
   6 use Text::Wrap;
   7 use 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
  29 require 'Porting/pod_lib.pl';
  30 sub 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
  59 if ($Verbose) {
  60     print "I will be building $_\n" foreach sort keys %Build;
  61 }
  62
  63 my $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.
  67 my $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
  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;
  84 }
  85
  86 sub 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
  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}};
  99 }
 100
 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}});
 107 }
 108
 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}}));
 117     $line =~ s/$/ \\/mg;
 118     $line =~ s/ \\$//;
 119     $line;
 120 }
 121
 122 sub 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
 132 sub 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
 147 sub 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
 163 sub 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
 173 sub 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
 187 sub 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{(
 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
 206 )+}sm;
 207     $makefile_SH = verify_contiguous($name, $makefile_SH, $re, 'copy rules');
 208
 209     my @copy_rules = map "
 210 pod/$_: 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
 220 process($_, $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: