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