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