util/process_docs.pl: Add more debugging output
[openssl.git] / 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