process_docs.pl 9.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271
  1. #! /usr/bin/env perl
  2. # Copyright 2016-2018 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. use strict;
  9. use warnings;
  10. use File::Spec::Functions;
  11. use File::Basename;
  12. use File::Copy;
  13. use File::Path;
  14. use FindBin;
  15. use lib "$FindBin::Bin/perl";
  16. use OpenSSL::Glob;
  17. use Getopt::Long;
  18. use Pod::Usage;
  19. use lib '.';
  20. use configdata;
  21. # We know we are in the 'util' directory and that our perl modules are
  22. # in util/perl
  23. use lib catdir(dirname($0), "perl");
  24. use OpenSSL::Util::Pod;
  25. my %options = ();
  26. GetOptions(\%options,
  27. 'sourcedir=s', # Source directory
  28. 'section=i@', # Subdirectories to look through,
  29. # with associated section numbers
  30. 'destdir=s', # Destination directory
  31. #'in=s@', # Explicit files to process (ignores sourcedir)
  32. 'type=s', # The result type, 'man' or 'html'
  33. 'suffix:s', # Suffix to add to the extension.
  34. # Only used with type=man
  35. 'remove', # To remove files rather than writing them
  36. 'dry-run|n', # Only output file names on STDOUT
  37. 'debug|D+',
  38. );
  39. unless ($options{section}) {
  40. $options{section} = [ 1, 3, 5, 7 ];
  41. }
  42. unless ($options{sourcedir}) {
  43. $options{sourcedir} = catdir($config{sourcedir}, "doc");
  44. }
  45. pod2usage(1) unless ( defined $options{section}
  46. && defined $options{sourcedir}
  47. && defined $options{destdir}
  48. && defined $options{type}
  49. && ($options{type} eq 'man'
  50. || $options{type} eq 'html') );
  51. pod2usage(1) if ( $options{type} eq 'html'
  52. && defined $options{suffix} );
  53. if ($options{debug}) {
  54. print STDERR "DEBUG: options:\n";
  55. print STDERR "DEBUG: --sourcedir = $options{sourcedir}\n"
  56. if defined $options{sourcedir};
  57. print STDERR "DEBUG: --destdir = $options{destdir}\n"
  58. if defined $options{destdir};
  59. print STDERR "DEBUG: --type = $options{type}\n"
  60. if defined $options{type};
  61. print STDERR "DEBUG: --suffix = $options{suffix}\n"
  62. if defined $options{suffix};
  63. foreach (sort @{$options{section}}) {
  64. print STDERR "DEBUG: --section = $_\n";
  65. }
  66. print STDERR "DEBUG: --remove = $options{remove}\n"
  67. if defined $options{remove};
  68. print STDERR "DEBUG: --debug = $options{debug}\n"
  69. if defined $options{debug};
  70. print STDERR "DEBUG: --dry-run = $options{\"dry-run\"}\n"
  71. if defined $options{"dry-run"};
  72. }
  73. my $symlink_exists = eval { symlink("",""); 1 };
  74. foreach my $section (sort @{$options{section}}) {
  75. my $subdir = "man$section";
  76. my $podsourcedir = catfile($options{sourcedir}, $subdir);
  77. my $podglob = catfile($podsourcedir, "*.pod");
  78. foreach my $podfile (glob $podglob) {
  79. my $podname = basename($podfile, ".pod");
  80. my $podpath = catfile($podfile);
  81. my %podinfo = extract_pod_info($podpath,
  82. { debug => $options{debug},
  83. section => $section });
  84. my @podfiles = grep { $_ ne $podname } @{$podinfo{names}};
  85. my $updir = updir();
  86. my $name = uc $podname;
  87. my $suffix = { man => ".$podinfo{section}".($options{suffix} // ""),
  88. html => ".html" } -> {$options{type}};
  89. my $generate = { man => "pod2man --name=$name --section=$podinfo{section} --center=OpenSSL --release=$config{version} \"$podpath\"",
  90. html => "pod2html \"--podroot=$options{sourcedir}\" --htmldir=$updir --podpath=man1:man3:man5:man7 \"--infile=$podpath\" \"--title=$podname\" --quiet"
  91. } -> {$options{type}};
  92. my $output_dir = catdir($options{destdir}, "man$podinfo{section}");
  93. my $output_file = $podname . $suffix;
  94. my $output_path = catfile($output_dir, $output_file);
  95. if (! $options{remove}) {
  96. my @output;
  97. print STDERR "DEBUG: Processing, using \"$generate\"\n"
  98. if $options{debug};
  99. unless ($options{"dry-run"}) {
  100. @output = `$generate`;
  101. map { s|href="http://man\.he\.net/(man\d/[^"]+)(?:\.html)?"|href="../$1.html"|g; } @output
  102. if $options{type} eq "html";
  103. if ($options{type} eq "man") {
  104. # Because some *roff parsers are more strict than others,
  105. # multiple lines in the NAME section must be merged into
  106. # one.
  107. my $in_name = 0;
  108. my $name_line = "";
  109. my @newoutput = ();
  110. foreach (@output) {
  111. if ($in_name) {
  112. if (/^\.SH "/) {
  113. $in_name = 0;
  114. push @newoutput, $name_line."\n";
  115. } else {
  116. chomp (my $x = $_);
  117. $name_line .= " " if $name_line;
  118. $name_line .= $x;
  119. next;
  120. }
  121. }
  122. if (/^\.SH +"NAME" *$/) {
  123. $in_name = 1;
  124. }
  125. push @newoutput, $_;
  126. }
  127. @output = @newoutput;
  128. }
  129. }
  130. print STDERR "DEBUG: Done processing\n" if $options{debug};
  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. 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. __END__
  183. =pod
  184. =head1 NAME
  185. process_docs.pl - A script to process OpenSSL docs
  186. =head1 SYNOPSIS
  187. B<process_docs.pl>
  188. [B<--sourcedir>=I<dir>]
  189. B<--destdir>=I<dir>
  190. B<--type>=B<man>|B<html>
  191. [B<--suffix>=I<suffix>]
  192. [B<--remove>]
  193. [B<--dry-run>|B<-n>]
  194. [B<--debug>|B<-D>]
  195. =head1 DESCRIPTION
  196. This script looks for .pod files in the subdirectories 'apps', 'crypto'
  197. and 'ssl' under the given source directory.
  198. The OpenSSL configuration data file F<configdata.pm> I<must> reside in
  199. the current directory, I<or> perl must have the directory it resides in
  200. in its inclusion array. For the latter variant, a call like this would
  201. work:
  202. perl -I../foo util/process_docs.pl {options ...}
  203. =head1 OPTIONS
  204. =over 4
  205. =item B<--sourcedir>=I<dir>
  206. Top directory where the source files are found.
  207. =item B<--destdir>=I<dir>
  208. Top directory where the resulting files should end up
  209. =item B<--type>=B<man>|B<html>
  210. Type of output to produce. Currently supported are man pages and HTML files.
  211. =item B<--suffix>=I<suffix>
  212. A suffix added to the extension. Only valid with B<--type>=B<man>
  213. =item B<--remove>
  214. Instead of writing the files, remove them.
  215. =item B<--dry-run>|B<-n>
  216. Do not perform any file writing, directory creation or file removal.
  217. =item B<--debug>|B<-D>
  218. Print extra debugging output.
  219. =back
  220. =head1 COPYRIGHT
  221. Copyright 2013-2018 The OpenSSL Project Authors. All Rights Reserved.
  222. Licensed under the OpenSSL license (the "License"). You may not use
  223. this file except in compliance with the License. You can obtain a copy
  224. in the file LICENSE in the source distribution or at
  225. https://www.openssl.org/source/license.html
  226. =cut