podwrapper.pl.in

   1 #!/usr/bin/env perl
   2 # podwrapper.pl
   3 # @configure_input@
   4 # Copyright (C) 2010-2018 Red Hat Inc.
   5 # All rights reserved.
   6 #
   7 # Redistribution and use in source and binary forms, with or without
   8 # modification, are permitted provided that the following conditions are
   9 # met:
  10 #
  11 # * Redistributions of source code must retain the above copyright
  12 # notice, this list of conditions and the following disclaimer.
  13 #
  14 # * Redistributions in binary form must reproduce the above copyright
  15 # notice, this list of conditions and the following disclaimer in the
  16 # documentation and/or other materials provided with the distribution.
  17 #
  18 # * Neither the name of Red Hat nor the names of its contributors may be
  19 # used to endorse or promote products derived from this software without
  20 # specific prior written permission.
  21 #
  22 # THIS SOFTWARE IS PROVIDED BY RED HAT AND CONTRIBUTORS ''AS IS'' AND
  23 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  24 # THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  25 # PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RED HAT OR
  26 # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  27 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  28 # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
  29 # USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  30 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  31 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
  32 # OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  33 # SUCH DAMAGE.
  34
  35 use warnings;
  36 use strict;
  37
  38 use Pod::Usage;
  39 use Getopt::Long;
  40 use Pod::Man;
  41 use Pod::Simple;
  42 use Pod::Simple::Text;
  43 use Pod::Simple::XHTML;
  44 use File::Basename;
  45
  46 # https://www.redhat.com/archives/libguestfs/2013-May/thread.html#00088
  47 eval { $Text::Wrap::huge = "overflow" };
  48
  49 =head1 NAME
  50
  51 podwrapper.pl - generate documentation from POD input files
  52
  53 =head1 SYNOPSIS
  54
  55  EXTRA_DIST = foo.pod
  56
  57  if HAVE_POD
  58
  59  man_MANS = foo.1
  60  CLEANFILES += $(man_MANS)
  61
  62  foo.1: foo.pod
  63          $(PODWRAPPER) --section 1 --man $@ \
  64            --html $(top_builddir)/html/$@.html \
  65            $<
  66
  67  endif HAVE_POD
  68
  69 =head1 DESCRIPTION
  70
  71 podwrapper.pl is a Perl script that generates various output formats
  72 from POD input files that nbdkit uses for most documentation.
  73
  74 You must specify one input file, and one or more output formats.  The
  75 output options are I<--man>, I<--html> and I<--text> (see below).
  76
  77 In C<Makefile.am> files, use a variation of the boilerplate shown in
  78 the L</SYNOPSIS> section above.
  79
  80 For information about the POD format, see L<perlpod(1)>.
  81
  82 =head1 OPTIONS
  83
  84 =over 4
  85
  86 =cut
  87
  88 my $help;
  89
  90 =item B<--help>
  91
  92 Display brief help.
  93
  94 =cut
  95
  96 my $html;
  97
  98 =item B<--html output.html>
  99
 100 Write a web page to C<output.html>.  If this option is not
 101 given, then no web page output is produced.
 102
 103 =cut
 104
 105 my @inserts;
 106
 107 =item B<--insert filename:__PATTERN__>
 108
 109 In the input file, replace the literal text C<__PATTERN__> with the
 110 replacement file C<filename>.  You can give this option multiple
 111 times.
 112
 113 The contents of C<filename> are treated as POD.
 114 Compare and contrast with I<--verbatim>.
 115
 116 Although it is conventional to use C<__...__> (double underscores) for
 117 patterns, in fact you can use any string as the pattern.
 118
 119 =cut
 120
 121 my $man;
 122
 123 =item B<--man output.n>
 124
 125 Write a man page to C<output.n> (C<n> is the manual section number).
 126 If this option is not given, then no man page output is produced.
 127
 128 =cut
 129
 130 my $name;
 131
 132 =item B<--name name>
 133
 134 Set the name of the man page.  If not set, defaults to the basename
 135 of the input file.
 136
 137 =cut
 138
 139 my $section;
 140
 141 =item B<--section N>
 142
 143 Set the section of the man page (a number such as C<1> for
 144 command line utilities or C<3> for C API documentation).  If
 145 not set, defaults to C<1>.
 146
 147 =cut
 148
 149 my $text;
 150
 151 =item B<--text output.txt>
 152
 153 Write a text file to C<output.txt>.  If this option is not
 154 given, then no text output is produced.
 155
 156 =cut
 157
 158 my @verbatims;
 159
 160 =item B<--verbatim filename:__PATTERN__>
 161
 162 In the input file, replace the literal text C<__PATTERN__> with the
 163 replacement file C<filename>.  You can give this option multiple
 164 times.
 165
 166 The contents of C<filename> are inserted as verbatim text, and
 167 are I<not> interpreted as POD.
 168 Compare and contrast with I<--insert>.
 169
 170 Although it is conventional to use C<__...__> (double underscores) for
 171 patterns, in fact you can use any string as the pattern.
 172
 173 =cut
 174
 175 # Clean up the program name.
 176 my $progname = $0;
 177 $progname =~ s{.*/}{};
 178
 179 # Parse options.
 180 GetOptions ("help|?" => \$help,
 181             "html=s" => \$html,
 182             "insert=s" => \@inserts,
 183             "man=s" => \$man,
 184             "name=s" => \$name,
 185             "section=s" => \$section,
 186             "text=s" => \$text,
 187             "verbatim=s" => \@verbatims,
 188     ) or pod2usage (2);
 189 pod2usage (1) if $help;
 190
 191 die "$progname: missing argument: podwrapper input.pod\n" unless @ARGV == 1;
 192 my $input = $ARGV[0];
 193
 194 # There should be at least one output.
 195 die "$progname: $input: no output format specified.  Use --man and/or --html and/or --text.\n"
 196     unless defined $man || defined $html || defined $text;
 197
 198 # Default for $name and $section.
 199 $name = basename ($input, ".pod") unless defined $name;
 200 $section = 1 unless defined $section;
 201
 202 # Note that these @...@ are substituted by ./configure.
 203 my $abs_top_srcdir = "@abs_top_srcdir@";
 204 my $abs_top_builddir = "@abs_top_builddir@";
 205 my $package_name = "@PACKAGE_NAME@";
 206 my $package_version = "@PACKAGE_VERSION@";
 207
 208 die "$progname: ./configure substitutions were not performed"
 209     unless $abs_top_srcdir && $abs_top_builddir &&
 210     $package_name && $package_version;
 211
 212 # Create a stable date (thanks Hilko Bengen).
 213 my $date;
 214 my $filename = "$abs_top_srcdir/.git";
 215 if (!$date && -d $filename) {
 216     local $ENV{GIT_DIR} = $filename;
 217     $_ = `git show -s --format=%ci`;
 218     $date = $1 if /^(\d+-\d+-\d+)\s/;
 219 }
 220 if (!$date) {
 221     my ($day, $month, $year) = (localtime)[3,4,5];
 222     $date = sprintf ("%04d-%02d-%02d", $year+1900, $month+1, $day);
 223 }
 224
 225 # Create a release string.
 226 my $release = "$package_name-$package_version";
 227
 228 #print "input=$input\n";
 229 #print "name=$name\n";
 230 #print "section=$section\n";
 231 #print "date=$date\n";
 232
 233 # Read the input.
 234 my $content = read_whole_file ($input);
 235
 236 # Perform @inserts.
 237 foreach (@inserts) {
 238     my @a = split /:/, $_, 2;
 239     die "$progname: $input: no colon in parameter of --insert\n" unless @a >= 2;
 240     my $replacement = read_whole_file ($a[0]);
 241     my $oldcontent = $content;
 242     $content =~ s/$a[1]/$replacement/ge;
 243     die "$progname: $input: could not find pattern '$a[1]' in input file\n"
 244         if $content eq $oldcontent;
 245 }
 246
 247 # Turn external links to this man page into simple cross-section links.
 248 $content =~ s,\QL<$name($section)/\E,L</,g;
 249
 250 # Perform @verbatims.
 251 foreach (@verbatims) {
 252     my @a = split /:/, $_, 2;
 253     die "$progname: $input: no colon in parameter of --verbatim\n" unless @a >= 2;
 254     my $replacement = read_verbatim_file ($a[0]);
 255     my $oldcontent = $content;
 256     $content =~ s/$a[1]/$replacement/ge;
 257     die "$progname: $input: could not find pattern '$a[1]' in input file\n"
 258         if $content eq $oldcontent;
 259 }
 260
 261 # There should be no =encoding line present in the content (we will add one).
 262 die "$progname: $input: =encoding must not be present in input\n"
 263     if $content =~ /^=encoding/m;
 264
 265 $content =~ s/^=(.*)/\n=encoding utf8\n\n=$1/m;
 266
 267 # Verify sections present / not present.
 268 die "$progname: $input: missing NAME section\n"
 269     if $content !~ /^=head1 NAME/m;
 270 die "$progname: $input: missing DESCRIPTION section\n"
 271     if $content !~ /^=head1 DESCRIPTION/m;
 272 die "$progname: $input: missing AUTHOR or AUTHORS section\n"
 273     unless $content =~ /^=head1 AUTHOR/m;
 274 die "$progname: $input: missing SEE ALSO section\n"
 275     unless $content =~ /^=head1 SEE ALSO/m;
 276 die "$progname: $input: missing COPYRIGHT section\n"
 277     unless $content =~ /^=head1 COPYRIGHT/m;
 278 die "$progname: $input: BUGS is now added automatically, do not add it to the POD file\n"
 279     if $content =~ /^=head1 (REPORTING )?BUGS/m;
 280 die "$progname: $input: LICENSE is now added automatically, do not add it to the POD file\n"
 281     if $content =~ /^=head1 LICENSE/m;
 282
 283 # Check NAME section conformity.
 284 my @lines = split /\n/, $content;
 285 my @name;
 286 foreach (@lines) {
 287     push @name, $_ if /^=head1 NAME/../^=head1 (?!NAME)/
 288 }
 289 shift @name;                    # remove =head1 and empty line
 290 shift @name;                    # from beginning and end
 291 pop @name;
 292 pop @name;
 293 die "$progname: $input: empty NAME section\n"
 294     unless @name >= 1;
 295 die "$progname: $input: NAME doesn't start with nbdkit\n"
 296     unless $name[0] =~ m/^nbdkit/;
 297 die "$progname: $input: NAME does not conform with Linux man pages standard\n"
 298     if $name[0] !~ m/- [a-z]/ || $name[@name-1] =~ m/\.$/;
 299
 300 # Add standard LICENSE section at the end.
 301 $content .=
 302 "
 303
 304 =head1 LICENSE
 305
 306 Redistribution and use in source and binary forms, with or without
 307 modification, are permitted provided that the following conditions are
 308 met:
 309
 310 =over 4
 311
 312 =item *
 313
 314 Redistributions of source code must retain the above copyright
 315 notice, this list of conditions and the following disclaimer.
 316
 317 =item *
 318
 319 Redistributions in binary form must reproduce the above copyright
 320 notice, this list of conditions and the following disclaimer in the
 321 documentation and/or other materials provided with the distribution.
 322
 323 =item *
 324
 325 Neither the name of Red Hat nor the names of its contributors may be
 326 used to endorse or promote products derived from this software without
 327 specific prior written permission.
 328
 329 =back
 330
 331 THIS SOFTWARE IS PROVIDED BY RED HAT AND CONTRIBUTORS ''AS IS'' AND
 332 ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 333 THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 334 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RED HAT OR
 335 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 336 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 337 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
 338 USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 339 ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 340 OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
 341 OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 342 SUCH DAMAGE.
 343 ";
 344
 345 # Check no over-long lines in the input.  (As a special exception this
 346 # is permitted in verbatim sections or if the line contains a URL).
 347 @lines = split /\n/, $content;
 348 foreach (@lines) {
 349     die "$progname: $input: line too long:\n$_\n"
 350         if length $_ > 76 &&
 351         substr ($_, 0, 1) ne ' ' &&
 352         ! m/https?:/;
 353 }
 354
 355 # Output man page.
 356 SUBMAN: {
 357     package Podwrapper::Man;
 358
 359     use vars qw(@ISA $VERSION);
 360     @ISA = qw(Pod::Man);
 361     $VERSION = $package_version;
 362
 363     # Override the L<> method.
 364     sub cmd_l
 365     {
 366         my ($self, $attrs, $text) = @_;
 367         return $text;
 368     }
 369 }
 370
 371 if ($man) {
 372     my $parser = Podwrapper::Man->new (
 373         name => $name,
 374         release => $release, section => $section,
 375         center => "NBDKIT",
 376         date => $date,
 377         stderr => 1, utf8 => 1
 378     );
 379     my $output;
 380     $parser->no_errata_section (1);
 381     $parser->complain_stderr (1);
 382     $parser->output_string (\$output);
 383     $parser->parse_string_document ($content)
 384         or die "$progname: could not parse input document";
 385     open OUT, ">$man" or die "$progname: $man: $!";
 386     print OUT $output or die "$progname: $man: $!";
 387     close OUT or die "$progname: $man: $!";
 388     if ($parser->any_errata_seen) {
 389         unlink $man;
 390         die "$input: errors or warnings in this POD file, see messages above\n"
 391     }
 392     #print "$progname: wrote $man\n";
 393 }
 394
 395 # Output HTML.
 396 SUBHTML: {
 397     # Subclass Pod::Simple::XHTML.  See the documentation.
 398     package Podwrapper::XHTML;
 399
 400     use vars qw(@ISA $VERSION);
 401     @ISA = qw(Pod::Simple::XHTML);
 402     $VERSION = $package_version;
 403
 404     sub is_an_nbdkit_page
 405     {
 406         local $_ = shift;
 407
 408         return 1 if /^nbdkit/;
 409         return 0;
 410     }
 411
 412     sub resolve_man_page_link
 413     {
 414         my $self = shift;
 415         my $name = $_[0];   # eg. "nbdkit(1)", can be undef
 416         my $anchor = $_[1]; # eg. "SYNOPSIS", can be undef
 417         my $r = "";
 418         if (defined $name) {
 419             return $self->SUPER::resolve_man_page_link (@_)
 420                 unless is_an_nbdkit_page ($name);
 421             $name =~ s/\((.*)\)$/.$1/;
 422             $r .= "$name.html";
 423         }
 424         $r .= "#" . $self->idify ($anchor, 1) if defined $anchor;
 425         $r;
 426     }
 427
 428     # For some reason Pod::Simple::XHTML usually cannot find a
 429     # title for the page.  This defaults the HTML <title> field
 430     # to the same as the man page name.
 431     sub default_title { $name }
 432 }
 433
 434 if ($html) {
 435     mkdir "$abs_top_builddir/html";
 436
 437     my $parser = Podwrapper::XHTML->new;
 438     my $output;
 439     $parser->no_errata_section (1);
 440     $parser->complain_stderr (1);
 441     $parser->output_string (\$output);
 442     # Added in Pod::Simple 3.16, 2011-03-14.
 443     eval { $parser->html_charset ("UTF-8") };
 444     $parser->html_css ("pod.css");
 445     $parser->index (1);
 446     $parser->parse_string_document ($content);
 447
 448     # Hack for Perl 5.16.
 449     $output =~ s{/>pod.css<}{/>\n<};
 450
 451     open OUT, ">$html" or die "$progname: $html: $!";
 452     print OUT $output or die "$progname: $html: $!";
 453     close OUT or die "$progname: $html: $!";
 454     if ($parser->any_errata_seen) {
 455         unlink $html;
 456         die "$input: errors or warnings in this POD file, see messages above\n"
 457     }
 458     #print "$progname: wrote $html\n";
 459 }
 460
 461 # Output text.
 462 if ($text) {
 463     my $parser = Pod::Simple::Text->new;
 464     my $output;
 465     $parser->no_errata_section (1);
 466     $parser->complain_stderr (1);
 467     $parser->output_string (\$output);
 468     $parser->parse_string_document ($content);
 469     open OUT, ">$text" or die "$progname: $text: $!";
 470     binmode OUT, ":utf8";
 471     print OUT $output or die "$progname: $text: $!";
 472     close OUT or die "$progname: $text: $!";
 473     if ($parser->any_errata_seen) {
 474         unlink $text;
 475         die "$input: errors or warnings in this POD file, see messages above\n"
 476     }
 477     #print "$progname: wrote $text\n";
 478 }
 479
 480 sub read_whole_file
 481 {
 482     my $input = shift;
 483     local $/ = undef;
 484
 485     open FILE, "<:encoding(UTF-8)", $input or die "$progname: $input: $!";
 486     $_ = <FILE>;
 487     close FILE;
 488     $_;
 489 }
 490
 491 sub read_verbatim_file
 492 {
 493     my $input = shift;
 494     my $r = "";
 495
 496     open FILE, "<:encoding(UTF-8)", $input or die "$progname: $input: $!";
 497     while (<FILE>) {
 498         $r .= " $_";
 499     }
 500     close FILE;
 501     $r;
 502 }
 503
 504 =head1 SEE ALSO
 505
 506 L<perlpod(1)>,
 507 L<Pod::Simple(3pm)>.
 508
 509 =head1 AUTHOR
 510
 511 Richard W.M. Jones.
 512
 513 =head1 COPYRIGHT
 514
 515 Copyright (C) 2012-2018 Red Hat Inc.