offset, partition: Fix .extents with non-zero offset
[nbdkit/ericb.git] / podwrapper.pl.in
blob5f8d6d4735d20b4c33a4206af94631252f4d3fc4
1 #!/usr/bin/env perl
2 # podwrapper.pl
3 # @configure_input@
4 # Copyright (C) 2010-2018 Red Hat Inc.
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions are
8 # met:
10 # * Redistributions of source code must retain the above copyright
11 # notice, this list of conditions and the following disclaimer.
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.
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.
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.
34 use warnings;
35 use strict;
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;
45 # https://www.redhat.com/archives/libguestfs/2013-May/thread.html#00088
46 eval { $Text::Wrap::huge = "overflow" };
48 =head1 NAME
50 podwrapper.pl - generate documentation from POD input files
52 =head1 SYNOPSIS
54 EXTRA_DIST = foo.pod
56 if HAVE_POD
58 man_MANS = foo.1
59 CLEANFILES += $(man_MANS)
61 foo.1: foo.pod
62 $(PODWRAPPER) --section 1 --man $@ \
63 --html $(top_builddir)/html/$@.html \
66 endif HAVE_POD
68 =head1 DESCRIPTION
70 podwrapper.pl is a Perl script that generates various output formats
71 from POD input files that nbdkit uses for most documentation.
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).
76 In C<Makefile.am> files, use a variation of the boilerplate shown in
77 the L</SYNOPSIS> section above.
79 For information about the POD format, see L<perlpod(1)>.
81 =head1 OPTIONS
83 =over 4
85 =cut
87 my $help;
89 =item B<--help>
91 Display brief help.
93 =cut
95 my $html;
97 =item B<--html output.html>
99 Write a web page to C<output.html>. If this option is not
100 given, then no web page output is produced.
102 =cut
104 my @inserts;
106 =item B<--insert filename:__PATTERN__>
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.
112 The contents of C<filename> are treated as POD.
113 Compare and contrast with I<--verbatim>.
115 Although it is conventional to use C<__...__> (double underscores) for
116 patterns, in fact you can use any string as the pattern.
118 =cut
120 my $man;
122 =item B<--man output.n>
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.
127 =cut
129 my $name;
131 =item B<--name name>
133 Set the name of the man page. If not set, defaults to the basename
134 of the input file.
136 =cut
138 my $section;
140 =item B<--section N>
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>.
146 =cut
148 my $text;
150 =item B<--text output.txt>
152 Write a text file to C<output.txt>. If this option is not
153 given, then no text output is produced.
155 =cut
157 my @verbatims;
159 =item B<--verbatim filename:__PATTERN__>
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.
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>.
169 Although it is conventional to use C<__...__> (double underscores) for
170 patterns, in fact you can use any string as the pattern.
172 =cut
174 # Clean up the program name.
175 my $progname = $0;
176 $progname =~ s{.*/}{};
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;
190 die "$progname: missing argument: podwrapper input.pod\n" unless @ARGV == 1;
191 my $input = $ARGV[0];
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;
197 # Default for $name and $section.
198 $name = basename ($input, ".pod") unless defined $name;
199 $section = 1 unless defined $section;
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@";
207 die "$progname: ./configure substitutions were not performed"
208 unless $abs_top_srcdir && $abs_top_builddir &&
209 $package_name && $package_version;
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/;
219 if (!$date) {
220 my ($day, $month, $year) = (localtime)[3,4,5];
221 $date = sprintf ("%04d-%02d-%02d", $year+1900, $month+1, $day);
224 # Create a release string.
225 my $release = "$package_name-$package_version";
227 #print "input=$input\n";
228 #print "name=$name\n";
229 #print "section=$section\n";
230 #print "date=$date\n";
232 # Read the input.
233 my $content = read_whole_file ($input);
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;
246 # Turn external links to this man page into simple cross-section links.
247 $content =~ s,\QL<$name($section)/\E,L</,g;
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;
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;
264 $content =~ s/^=(.*)/\n=encoding utf8\n\n=$1/m;
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;
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)/
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/\.$/;
299 # Add standard LICENSE section at the end.
300 $content .=
303 =head1 LICENSE
305 Redistribution and use in source and binary forms, with or without
306 modification, are permitted provided that the following conditions are
307 met:
309 =over 4
311 =item *
313 Redistributions of source code must retain the above copyright
314 notice, this list of conditions and the following disclaimer.
316 =item *
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.
322 =item *
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.
328 =back
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.
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?:/;
354 # Output man page.
355 SUBMAN: {
356 package Podwrapper::Man;
358 use vars qw(@ISA $VERSION);
359 @ISA = qw(Pod::Man);
360 $VERSION = $package_version;
362 # Override the L<> method.
363 sub cmd_l
365 my ($self, $attrs, $text) = @_;
366 return $text;
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
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"
391 #print "$progname: wrote $man\n";
394 # Output HTML.
395 SUBHTML: {
396 # Subclass Pod::Simple::XHTML. See the documentation.
397 package Podwrapper::XHTML;
399 use vars qw(@ISA $VERSION);
400 @ISA = qw(Pod::Simple::XHTML);
401 $VERSION = $package_version;
403 sub is_an_nbdkit_page
405 local $_ = shift;
407 return 1 if /^nbdkit/;
408 return 0;
411 sub resolve_man_page_link
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";
423 $r .= "#" . $self->idify ($anchor, 1) if defined $anchor;
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 }
433 if ($html) {
434 mkdir "$abs_top_builddir/html";
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);
447 # Hack for Perl 5.16.
448 $output =~ s{/>pod.css<}{/>\n<};
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"
457 #print "$progname: wrote $html\n";
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"
476 #print "$progname: wrote $text\n";
479 sub read_whole_file
481 my $input = shift;
482 local $/ = undef;
484 open FILE, "<:encoding(UTF-8)", $input or die "$progname: $input: $!";
485 $_ = <FILE>;
486 close FILE;
490 sub read_verbatim_file
492 my $input = shift;
493 my $r = "";
495 open FILE, "<:encoding(UTF-8)", $input or die "$progname: $input: $!";
496 while (<FILE>) {
497 $r .= " $_";
499 close FILE;
503 =head1 SEE ALSO
505 L<perlpod(1)>,
506 L<Pod::Simple(3pm)>.
508 =head1 AUTHOR
510 Richard W.M. Jones.
512 =head1 COPYRIGHT
514 Copyright (C) 2012-2018 Red Hat Inc.