util/process_docs.pl

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