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