util/process_docs.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the Apache License 2.0 (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9 use strict;
  10 use warnings;
  11
  12 use File::Spec::Functions;
  13 use File::Basename;
  14 use File::Copy;
  15 use File::Path;
  16 use FindBin;
  17 use lib "$FindBin::Bin/perl";
  18 use OpenSSL::Glob;
  19 use Getopt::Long;
  20 use Pod::Usage;
  21
  22 use lib '.';
  23 use configdata;
  24
  25 # We know we are in the 'util' directory and that our perl modules are
  26 # in util/perl
  27 use lib catdir(dirname($0), "perl");
  28 use OpenSSL::Util::Pod;
  29
  30 my %options = ();
  31 GetOptions(\%options,
  32            'sourcedir=s@',      # Source directories
  33            'section=i@',        # Subdirectories to look through,
  34                                 # with associated section numbers
  35            'destdir=s',         # Destination directory
  36            #'in=s@',             # Explicit files to process (ignores sourcedir)
  37            'type=s',            # The result type, 'man' or 'html'
  38            'suffix:s',          # Suffix to add to the extension.
  39                                 # Only used with type=man
  40            'remove',            # To remove files rather than writing them
  41            'dry-run|n',         # Only output file names on STDOUT
  42            'debug|D+',
  43           );
  44
  45 unless ($options{section}) {
  46     $options{section} = [ 1, 3, 5, 7 ];
  47 }
  48 unless ($options{sourcedir}) {
  49     $options{sourcedir} = [ catdir($config{sourcedir}, "doc"),
  50                             catdir($config{builddir}, "doc") ];
  51 }
  52 pod2usage(1) unless ( defined $options{section}
  53                       && defined $options{sourcedir}
  54                       && defined $options{destdir}
  55                       && defined $options{type}
  56                       && ($options{type} eq 'man'
  57                           || $options{type} eq 'html') );
  58 pod2usage(1) if ( $options{type} eq 'html'
  59                   && defined $options{suffix} );
  60
  61 if ($options{debug}) {
  62     print STDERR "DEBUG: options:\n";
  63     foreach (sort @{$options{sourcedir}}) {
  64         print STDERR "DEBUG:   --sourcedir   = $_\n";
  65     }
  66     print STDERR "DEBUG:   --destdir   = $options{destdir}\n"
  67         if defined $options{destdir};
  68     print STDERR "DEBUG:   --type      = $options{type}\n"
  69         if defined $options{type};
  70     print STDERR "DEBUG:   --suffix    = $options{suffix}\n"
  71         if defined $options{suffix};
  72     foreach (sort @{$options{section}}) {
  73         print STDERR "DEBUG:   --section   = $_\n";
  74     }
  75     print STDERR "DEBUG:   --remove    = $options{remove}\n"
  76         if defined $options{remove};
  77     print STDERR "DEBUG:   --debug     = $options{debug}\n"
  78         if defined $options{debug};
  79     print STDERR "DEBUG:   --dry-run   = $options{\"dry-run\"}\n"
  80         if defined $options{"dry-run"};
  81 }
  82
  83 my $symlink_exists = eval { symlink("",""); 1 };
  84
  85 foreach my $section (sort @{$options{section}}) {
  86     my $subdir = "man$section";
  87     foreach my $sourcedir (@{$options{sourcedir}}) {
  88         my $podsourcedir = catfile($sourcedir, $subdir);
  89         my $podglob = catfile($podsourcedir, "*.pod");
  90
  91         foreach my $podfile (glob $podglob) {
  92             my $podname = basename($podfile, ".pod");
  93             my $podpath = catfile($podfile);
  94             my %podinfo = extract_pod_info($podpath,
  95                                            { debug => $options{debug},
  96                                              section => $section });
  97             my @podfiles = grep { $_ ne $podname } @{$podinfo{names}};
  98
  99             my $updir = updir();
 100             my $name = uc $podname;
 101             my $suffix =
 102                 { man  => ".$podinfo{section}".($options{suffix} // ""),
 103                   html => ".html" } -> {$options{type}};
 104             my $generate =
 105                 { man  => <<"_____",
 106 pod2man --name=$name --section=$podinfo{section}  --center=OpenSSL --release=$config{version}  "$podpath"
 107 _____
 108                   html => <<"_____",
 109 pod2html "--podroot=$sourcedir" --htmldir=$updir --podpath=man1:man3:man5:man7 "--infile=$podpath" "--title=$podname" --quiet
 110 _____
 111                 } -> {$options{type}};
 112             my $output_dir = catdir($options{destdir}, "man$podinfo{section}");
 113             my $output_file = $podname . $suffix;
 114             my $output_path = catfile($output_dir, $output_file);
 115
 116             if (! $options{remove}) {
 117                 my @output;
 118                 print STDERR "DEBUG: Processing, using \"$generate\"\n"
 119                     if $options{debug};
 120                 unless ($options{"dry-run"}) {
 121                     @output = `$generate`;
 122                     map { s|href="http://man\.he\.net/(man\d/[^"]+)(?:\.html)?"|href="../$1.html"|g; } @output
 123                         if $options{type} eq "html";
 124                     if ($options{type} eq "man") {
 125                         # Because some *roff parsers are more strict than
 126                         # others, multiple lines in the NAME section must
 127                         # be merged into one.
 128                         my $in_name = 0;
 129                         my $name_line = "";
 130                         my @newoutput = ();
 131                         foreach (@output) {
 132                             if ($in_name) {
 133                                 if (/^\.SH "/) {
 134                                     $in_name = 0;
 135                                     push @newoutput, $name_line."\n";
 136                                 } else {
 137                                     chomp (my $x = $_);
 138                                     $name_line .= " " if $name_line;
 139                                     $name_line .= $x;
 140                                     next;
 141                                 }
 142                             }
 143                             if (/^\.SH +"NAME" *$/) {
 144                                 $in_name = 1;
 145                             }
 146                             push @newoutput, $_;
 147                         }
 148                         @output = @newoutput;
 149                     }
 150                 }
 151                 print STDERR "DEBUG: Done processing\n" if $options{debug};
 152
 153                 if (! -d $output_dir) {
 154                     print STDERR "DEBUG: Creating directory $output_dir\n"
 155                         if $options{debug};
 156                     unless ($options{"dry-run"}) {
 157                         mkpath $output_dir
 158                             or die "Trying to create directory $output_dir: $!\n";
 159                     }
 160                 }
 161                 print STDERR "DEBUG: Writing $output_path\n" if $options{debug};
 162                 unless ($options{"dry-run"}) {
 163                     open my $output_fh, '>', $output_path
 164                         or die "Trying to write to $output_path: $!\n";
 165                     foreach (@output) {
 166                         print $output_fh $_;
 167                     }
 168                     close $output_fh;
 169                 }
 170                 print STDERR "DEBUG: Done writing $output_path\n" if $options{debug};
 171             } else {
 172                 print STDERR "DEBUG: Removing $output_path\n" if $options{debug};
 173                 unless ($options{"dry-run"}) {
 174                     while (unlink $output_path) {}
 175                 }
 176             }
 177             print "$output_path\n";
 178
 179             foreach (@podfiles) {
 180                 my $link_file = $_ . $suffix;
 181                 my $link_path = catfile($output_dir, $link_file);
 182                 if (! $options{remove}) {
 183                     if ($symlink_exists) {
 184                         print STDERR "DEBUG: Linking $link_path -> $output_file\n"
 185                             if $options{debug};
 186                         unless ($options{"dry-run"}) {
 187                             symlink $output_file, $link_path;
 188                         }
 189                     } else {
 190                         print STDERR "DEBUG: Copying $output_path to link_path\n"
 191                             if $options{debug};
 192                         unless ($options{"dry-run"}) {
 193                             copy $output_path, $link_path;
 194                         }
 195                     }
 196                 } else {
 197                     print STDERR "DEBUG: Removing $link_path\n" if $options{debug};
 198                     unless ($options{"dry-run"}) {
 199                         while (unlink $link_path) {}
 200                     }
 201                 }
 202                 print "$link_path -> $output_path\n";
 203             }
 204         }
 205     }
 206 }
 207
 208 __END__
 209
 210 =pod
 211
 212 =head1 NAME
 213
 214 process_docs.pl - A script to process OpenSSL docs
 215
 216 =head1 SYNOPSIS
 217
 218 B<process_docs.pl>
 219 [B<--sourcedir>=I<dir>]
 220 B<--destdir>=I<dir>
 221 B<--type>=B<man>|B<html>
 222 [B<--suffix>=I<suffix>]
 223 [B<--remove>]
 224 [B<--dry-run>|B<-n>]
 225 [B<--debug>|B<-D>]
 226
 227 =head1 DESCRIPTION
 228
 229 This script looks for .pod files in the subdirectories 'apps', 'crypto'
 230 and 'ssl' under the given source directory.
 231
 232 The OpenSSL configuration data file F<configdata.pm> I<must> reside in
 233 the current directory, I<or> perl must have the directory it resides in
 234 in its inclusion array.  For the latter variant, a call like this would
 235 work:
 236
 237  perl -I../foo util/process_docs.pl {options ...}
 238
 239 =head1 OPTIONS
 240
 241 =over 4
 242
 243 =item B<--sourcedir>=I<dir>
 244
 245 Top directory where the source files are found.
 246
 247 =item B<--destdir>=I<dir>
 248
 249 Top directory where the resulting files should end up
 250
 251 =item B<--type>=B<man>|B<html>
 252
 253 Type of output to produce.  Currently supported are man pages and HTML files.
 254
 255 =item B<--suffix>=I<suffix>
 256
 257 A suffix added to the extension.  Only valid with B<--type>=B<man>
 258
 259 =item B<--remove>
 260
 261 Instead of writing the files, remove them.
 262
 263 =item B<--dry-run>|B<-n>
 264
 265 Do not perform any file writing, directory creation or file removal.
 266
 267 =item B<--debug>|B<-D>
 268
 269 Print extra debugging output.
 270
 271 =back
 272
 273 =head1 COPYRIGHT
 274
 275 Copyright 2013-2018 The OpenSSL Project Authors. All Rights Reserved.
 276
 277 Licensed under the Apache License 2.0 (the "License").  You may not use
 278 this file except in compliance with the License.  You can obtain a copy
 279 in the file LICENSE in the source distribution or at
 280 https://www.openssl.org/source/license.html
 281
 282 =cut