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