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