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