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