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