podwrapper.pl.in

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