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