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 F<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 F<filename>.  You can give this option multiple
 110 times.
 111
 112 The contents of F<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 F<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 F<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 F<filename>.  You can give this option multiple
 163 times.
 164
 165 The contents of F<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 -O/dev/null -s --format=%ci`;
 217     $date = $1 if /^(\d+-\d+-\d+)\s/;
 218 }
 219 if (!$date) {
 220     my ($day, $month, $year) = (gmtime($ENV{SOURCE_DATE_EPOCH} || time))[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     # Note this also allows links to related projects because they all
 404     # appear together under the http://libguestfs.org website.
 405     sub is_a_local_page
 406     {
 407         local $_ = shift;
 408
 409         return 1 if /^Sys::Guestfs/;
 410         return 0 if /^virt-install/;
 411         return 1 if /^virt-/;
 412         return 1 if /^libguestf/;
 413         return 1 if /^guestf/;
 414         return 1 if /^guestmount/;
 415         return 1 if /^guestunmount/;
 416         return 1 if /^hivex/;
 417         return 1 if /^supermin/;
 418         return 1 if /^libnbd/;
 419         return 1 if /^nbd/;
 420         return 0;
 421     }
 422
 423     sub resolve_man_page_link
 424     {
 425         my $self = shift;
 426         my $name = $_[0];   # eg. "nbdkit(1)", can be undef
 427         my $anchor = $_[1]; # eg. "SYNOPSIS", can be undef
 428         my $r = "";
 429         if (defined $name) {
 430             return $self->SUPER::resolve_man_page_link (@_)
 431                 unless is_a_local_page ($name);
 432             $name =~ s/\((.*)\)$/.$1/;
 433             $r .= "$name.html";
 434         }
 435         $r .= "#" . $self->idify ($anchor, 1) if defined $anchor;
 436         $r;
 437     }
 438
 439     # For some reason Pod::Simple::XHTML usually cannot find a
 440     # title for the page.  This defaults the HTML <title> field
 441     # to the same as the man page name.
 442     sub default_title { $name }
 443 }
 444
 445 if ($html) {
 446     mkdir "$abs_top_builddir/html";
 447
 448     my $parser = Podwrapper::XHTML->new;
 449     my $output;
 450     $parser->no_errata_section (1);
 451     $parser->complain_stderr (1);
 452     $parser->output_string (\$output);
 453     # Added in Pod::Simple 3.16, 2011-03-14.
 454     eval { $parser->html_charset ("UTF-8") };
 455     $parser->html_css ("pod.css");
 456     $parser->index (1);
 457     $parser->parse_string_document ($content);
 458
 459     # Hack for Perl 5.16.
 460     $output =~ s{/>pod.css<}{/>\n<};
 461
 462     open OUT, ">$html" or die "$progname: $html: $!";
 463     print OUT $output or die "$progname: $html: $!";
 464     close OUT or die "$progname: $html: $!";
 465     if ($parser->any_errata_seen) {
 466         unlink $html;
 467         die "$input: errors or warnings in this POD file, see messages above\n"
 468     }
 469     #print "$progname: wrote $html\n";
 470 }
 471
 472 # Output text.
 473 if ($text) {
 474     my $parser = Pod::Simple::Text->new;
 475     my $output;
 476     $parser->no_errata_section (1);
 477     $parser->complain_stderr (1);
 478     $parser->output_string (\$output);
 479     $parser->parse_string_document ($content);
 480     open OUT, ">$text" or die "$progname: $text: $!";
 481     binmode OUT, ":utf8";
 482     print OUT $output or die "$progname: $text: $!";
 483     close OUT or die "$progname: $text: $!";
 484     if ($parser->any_errata_seen) {
 485         unlink $text;
 486         die "$input: errors or warnings in this POD file, see messages above\n"
 487     }
 488     #print "$progname: wrote $text\n";
 489 }
 490
 491 sub read_whole_file
 492 {
 493     my $input = shift;
 494     local $/ = undef;
 495
 496     open FILE, "<:encoding(UTF-8)", $input or die "$progname: $input: $!";
 497     $_ = <FILE>;
 498     close FILE;
 499     $_;
 500 }
 501
 502 sub read_verbatim_file
 503 {
 504     my $input = shift;
 505     my $r = "";
 506
 507     open FILE, "<:encoding(UTF-8)", $input or die "$progname: $input: $!";
 508     while (<FILE>) {
 509         $r .= " $_";
 510     }
 511     close FILE;
 512     $r;
 513 }
 514
 515 =head1 SEE ALSO
 516
 517 L<perlpod(1)>,
 518 L<Pod::Simple(3pm)>.
 519
 520 =head1 AUTHOR
 521
 522 Richard W.M. Jones.
 523
 524 =head1 COPYRIGHT
 525
 526 Copyright (C) 2012-2018 Red Hat Inc.