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 "Found section number $1\n" if $options{debug};
  88                 $podinfo{section} = $1;
  89             }
  90             last if m|^=head1| && defined $podinfo{lastsect} eq "NAME";
  91             if (m|^head1=\s*(.*)|) {
  92                 $podinfo{lastsect} = $1;
  93                 $podinfo{lastsect} =~ s/\s+$//;
  94                 $podinfo{lastsecttext} = "";
  95             }
  96             next if (m|^=| || m|^\s*$|);
  97             $podinfo{lastsecttext} .= " " if $podinfo{lastsecttext};
  98             $podinfo{lastsecttext} .= $_;
  99         }
 100         close $pod_fh;
 101         $podinfo{lastsecttext} =~ s| - .*$||;
 102         print STDERR "DEBUG: Done reading $podpath\n" if $options{debug};
 103
 104         my @podfiles =
 105             grep { $_ ne $podname }
 106             map { s|\s+||g; $_ }
 107             split(m|,|, $podinfo{lastsecttext});
 108
 109         my $updir = updir();
 110         my $name = uc $podname;
 111         my $suffix = { man  => ".$podinfo{section}",
 112                        html => ".html" } -> {$options{type}};
 113         my $generate = { man  => "pod2man --name=$name --section=$podinfo{section} --center=OpenSSL --release=$config{version} \"$podpath\"",
 114                          html => "pod2html \"--podroot=$options{sourcedir}\" --htmldir=$updir --podpath=apps:crypto:ssl \"--infile=$podpath\" \"--title=$podname\""
 115                          } -> {$options{type}};
 116         my $output_dir = catdir($options{destdir}, "man$podinfo{section}");
 117         my $output_file = $podname . $suffix;
 118         my $output_path = catfile($output_dir, $output_file);
 119
 120         if (! $options{remove}) {
 121             my @output;
 122             print STDERR "DEBUG: Processing, using \"$generate\"\n"
 123                 if $options{debug};
 124             unless ($options{"dry-run"}) {
 125                 @output = `$generate`;
 126                 map { s|href="http://man\.he\.net/man|href="../man|g; } @output
 127                     if $options{type} eq "html";
 128             }
 129             print STDERR "DEBUG: Done processing\n" if $options{debug};
 130
 131             if (! -d $output_dir) {
 132                 print STDERR "DEBUG: Creating directory $output_dir\n" if $options{debug};
 133                 unless ($options{"dry-run"}) {
 134                     mkpath $output_dir
 135                         or die "Trying to create directory $output_dir: $!\n";
 136                 }
 137             }
 138             print STDERR "DEBUG: Writing $output_path\n" if $options{debug};
 139             unless ($options{"dry-run"}) {
 140                 open my $output_fh, '>', $output_path
 141                     or die "Trying to write to $output_path: $!\n";
 142                 foreach (@output) {
 143                     print $output_fh $_;
 144                 }
 145                 close $output_fh;
 146             }
 147             print STDERR "DEBUG: Done writing $output_path\n" if $options{debug};
 148         } else {
 149             print STDERR "DEBUG: Removing $output_path\n" if $options{debug};
 150             unless ($options{"dry-run"}) {
 151                 while (unlink $output_path) {}
 152             }
 153         }
 154         print "$output_path\n";
 155
 156         foreach (@podfiles) {
 157             my $link_file = $_ . $suffix;
 158             my $link_path = catfile($output_dir, $link_file);
 159             if (! $options{remove}) {
 160                 if ($symlink_exists) {
 161                     print STDERR "DEBUG: Linking $link_path -> $output_file\n"
 162                         if $options{debug};
 163                     unless ($options{"dry-run"}) {
 164                         symlink $output_file, $link_path;
 165                     }
 166                 } else {
 167                     print STDERR "DEBUG: Copying $output_path to link_path\n"
 168                         if $options{debug};
 169                     unless ($options{"dry-run"}) {
 170                         copy $output_path, $link_path;
 171                     }
 172                 }
 173             } else {
 174                 print STDERR "DEBUG: Removing $link_path\n" if $options{debug};
 175                 unless ($options{"dry-run"}) {
 176                     while (unlink $link_path) {}
 177                 }
 178             }
 179             print "$link_path -> $output_path\n";
 180         }
 181     }
 182 }
 183
 184 __END__
 185
 186 =pod
 187
 188 =head1 NAME
 189
 190 process_docs.pl - A script to process OpenSSL docs
 191
 192 =head1 SYNOPSIS
 193
 194 B<process_docs.pl>
 195 [B<--sourcedir>=I<dir>]
 196 B<--destdir>=I<dir>
 197 B<--type>=B<man>|B<html>
 198 [B<--remove>]
 199 [B<--dry-run>|B<-n>]
 200 [B<--debug>|B<-D>]
 201
 202 =head1 DESCRIPTION
 203
 204 This script looks for .pod files in the subdirectories 'apps', 'crypto'
 205 and 'ssl' under the given source directory.
 206
 207 The OpenSSL configuration data file F<configdata.pm> I<must> reside in
 208 the current directory, I<or> perl must have the directory it resides in
 209 in its inclusion array.  For the latter variant, a call like this would
 210 work:
 211
 212  perl -I../foo util/process_docs.pl {options ...}
 213
 214 =head1 OPTIONS
 215
 216 =over 4
 217
 218 =item B<--sourcedir>=I<dir>
 219
 220 Top directory where the source files are found.
 221
 222 =item B<--destdir>=I<dir>
 223
 224 Top directory where the resulting files should end up
 225
 226 =item B<--type>=B<man>|B<html>
 227
 228 Type of output to produce.  Currently supported are man pages and HTML files.
 229
 230 =item B<--remove>
 231
 232 Instead of writing the files, remove them.
 233
 234 =item B<--dry-run>|B<-n>
 235
 236 Do not perform any file writing, directory creation or file removal.
 237
 238 =item B<--debug>|B<-D>
 239
 240 Print extra debugging output.
 241
 242 =back
 243
 244 =head1 COPYRIGHT
 245
 246 Copyright 2013-2016 The OpenSSL Project Authors. All Rights Reserved.
 247
 248 Licensed under the OpenSSL license (the "License").  You may not use
 249 this file except in compliance with the License.  You can obtain a copy
 250 in the file LICENSE in the source distribution or at
 251 https://www.openssl.org/source/license.html
 252
 253 =cut