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