mirror of
https://github.com/libguestfs/libguestfs.git
synced 2026-03-21 22:53:37 +00:00
72cfaff5c5
Automated using this command: perl -pi.bak -e 's/(20[012][0-9])-20[12][01234]/$1-2025/g' `git ls-files`
716 lines
20 KiB
Perl
Executable File
716 lines
20 KiB
Perl
Executable File
#!/usr/bin/env perl
|
||
# podwrapper.pl
|
||
# Copyright (C) 2010-2025 Red Hat Inc.
|
||
# @configure_input@
|
||
#
|
||
# This program is free software; you can redistribute it and/or modify
|
||
# it under the terms of the GNU General Public License as published by
|
||
# the Free Software Foundation; either version 2 of the License, or
|
||
# (at your option) any later version.
|
||
#
|
||
# This program is distributed in the hope that it will be useful,
|
||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
# GNU General Public License for more details.
|
||
#
|
||
# You should have received a copy of the GNU General Public License
|
||
# along with this program; if not, write to the Free Software
|
||
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
|
||
use warnings;
|
||
use strict;
|
||
|
||
use Pod::Usage;
|
||
use Getopt::Long;
|
||
use Pod::Man;
|
||
use Pod::Simple;
|
||
use Pod::Simple::Text;
|
||
use Pod::Simple::XHTML;
|
||
use File::Basename;
|
||
|
||
# https://www.redhat.com/archives/libguestfs/2013-May/thread.html#00088
|
||
eval { $Text::Wrap::huge = "overflow" };
|
||
|
||
=head1 NAME
|
||
|
||
podwrapper.pl - Generate libguestfs documentation from POD input files
|
||
|
||
=head1 SYNOPSIS
|
||
|
||
man_MANS = virt-foo.1
|
||
|
||
virt-foo.1 $(top_builddir)/website/virt-foo.1.html: stamp-virt-foo.pod
|
||
|
||
stamp-virt-foo.pod: virt-foo.pod
|
||
$(PODWRAPPER) \
|
||
--section 1 \
|
||
--man virt-foo.1 \
|
||
--html $(top_builddir)/website/virt-foo.1.html \
|
||
--license GPLv2+ \
|
||
--warning general \
|
||
$<
|
||
touch $@
|
||
|
||
=head1 DESCRIPTION
|
||
|
||
podwrapper.pl is a Perl script that generates various output formats
|
||
from POD input files that libguestfs uses for most documentation.
|
||
|
||
You must specify one input file, and one or more output formats. The
|
||
output options are I<--man>, I<--html> and I<--text> (see below).
|
||
|
||
In C<Makefile.am> files, use a variation of the boilerplate shown in
|
||
the L</SYNOPSIS> section above.
|
||
|
||
=head1 POD FORMAT
|
||
|
||
For general information about the POD format, see L<perlpod(1)>.
|
||
|
||
podwrapper.pl has a couple of extensions for including files:
|
||
|
||
=over 4
|
||
|
||
=item C<__INCLUDE:F<filename.pod>__>
|
||
|
||
Include another POD file at the current position (this does not work
|
||
recursively).
|
||
|
||
The filename is found by searching first the current directory,
|
||
then each I<--path> directory (if used).
|
||
|
||
=item C<__VERBATIM:F<filename.txt>__>
|
||
|
||
As above but the file is included as verbatim text, meaning it is
|
||
prefixed by one space before being passed to POD processing.
|
||
|
||
=back
|
||
|
||
=head1 OPTIONS
|
||
|
||
=over 4
|
||
|
||
=cut
|
||
|
||
my $help;
|
||
|
||
=item B<--help>
|
||
|
||
Display brief help.
|
||
|
||
=cut
|
||
|
||
my $html;
|
||
|
||
=item B<--html output.html>
|
||
|
||
Write a web page to C<output.html>. If this option is not
|
||
given, then no web page output is produced.
|
||
|
||
=cut
|
||
|
||
my @inserts;
|
||
|
||
=item B<--insert filename:__PATTERN__>
|
||
|
||
In the input file, replace the literal text C<__PATTERN__> with the
|
||
replacement file C<filename>. You can give this option multiple
|
||
times.
|
||
|
||
The contents of C<filename> are treated as POD.
|
||
Compare and contrast with I<--verbatim>.
|
||
|
||
Although it is conventional to use C<__...__> (double underscores) for
|
||
patterns, in fact you can use any string as the pattern.
|
||
|
||
=cut
|
||
|
||
my @licenses;
|
||
|
||
=item B<--license GPLv2+>
|
||
|
||
=item B<--license LGPLv2+>
|
||
|
||
=item B<--license examples>
|
||
|
||
Add the given license to the end of the man page. This parameter
|
||
is required. The parameter may be given multiple times (eg. for
|
||
mixed content).
|
||
|
||
=cut
|
||
|
||
my $man;
|
||
|
||
=item B<--man output.n>
|
||
|
||
Write a man page to C<output.n> (C<n> is the manual section number).
|
||
If this option is not given, then no man page output is produced.
|
||
|
||
=cut
|
||
|
||
my $name;
|
||
|
||
=item B<--name name>
|
||
|
||
Set the name of the man page. If not set, defaults to the basename
|
||
of the input file.
|
||
|
||
=cut
|
||
|
||
my @paths;
|
||
|
||
=item B<--path DIR>
|
||
|
||
Set the path used for searching for included files (see L</POD FORMAT>
|
||
above). The current directory is always searched first so you don’t
|
||
need to add that explicitly. Multiple I<--path> parameters can be
|
||
given, they are searched in order.
|
||
|
||
=cut
|
||
|
||
my $section;
|
||
|
||
=item B<--section N>
|
||
|
||
Set the section of the man page (a number such as C<1> for
|
||
command line utilities or C<3> for C API documentation). If
|
||
not set, defaults to C<1>.
|
||
|
||
=cut
|
||
|
||
my $strict_checks = 1;
|
||
|
||
=item B<--no-strict-checks>
|
||
|
||
Disable strict checks of the man page. This is only used
|
||
when generating the translated man pages in the C<po-docs>
|
||
subdirectory.
|
||
|
||
=cut
|
||
|
||
my $text;
|
||
|
||
=item B<--text output.txt>
|
||
|
||
Write a text file to C<output.txt>. If this option is not
|
||
given, then no text output is produced.
|
||
|
||
=cut
|
||
|
||
my @verbatims;
|
||
|
||
=item B<--verbatim filename:__PATTERN__>
|
||
|
||
In the input file, replace the literal text C<__PATTERN__> with the
|
||
replacement file C<filename>. You can give this option multiple
|
||
times.
|
||
|
||
The contents of C<filename> are inserted as verbatim text, and
|
||
are I<not> interpreted as POD.
|
||
Compare and contrast with I<--insert>.
|
||
|
||
Although it is conventional to use C<__...__> (double underscores) for
|
||
patterns, in fact you can use any string as the pattern.
|
||
|
||
=cut
|
||
|
||
my $warning = "not-set";
|
||
|
||
=item B<--warning general>
|
||
|
||
=item B<--warning ro-option>
|
||
|
||
Add a standard warning section near the top of the manual page,
|
||
warning the user not to use the tool in write mode or concurrently.
|
||
|
||
There are two variations of the warning: The I<--warning ro-option>
|
||
variation should be used with tools such as L<guestfish(1)> which have
|
||
an I<--ro> option. The I<--warning general> variation should be used
|
||
with other tools that open the disk image for writes, with no
|
||
read-only option.
|
||
|
||
=item B<--warning custom>
|
||
|
||
Use I<--warning custom> if there is already a warning section in the
|
||
manual page.
|
||
|
||
=item B<--warning safe>
|
||
|
||
Use I<--warning safe> for tools which are safe, ie. only open disk
|
||
images in read-only mode, or just don't need a warning section.
|
||
|
||
=back
|
||
|
||
=cut
|
||
|
||
# Clean up the program name.
|
||
my $progname = $0;
|
||
$progname =~ s{.*/}{};
|
||
|
||
# Parse options.
|
||
GetOptions ("help|?" => \$help,
|
||
"html=s" => \$html,
|
||
"license=s" => \@licenses,
|
||
"insert=s" => \@inserts,
|
||
"man=s" => \$man,
|
||
"name=s" => \$name,
|
||
"path=s" => \@paths,
|
||
"section=s" => \$section,
|
||
"strict-checks!" => \$strict_checks,
|
||
"text=s" => \$text,
|
||
"verbatim=s" => \@verbatims,
|
||
"warning=s" => \$warning,
|
||
) or pod2usage (2);
|
||
pod2usage (1) if $help;
|
||
|
||
die "$progname: missing argument: podwrapper input.pod\n" unless @ARGV == 1;
|
||
my $input = $ARGV[0];
|
||
|
||
die "$progname: $input: missing argument: --license parameter is required\n"
|
||
if $strict_checks && @licenses == 0;
|
||
|
||
# There should be at least one output.
|
||
die "$progname: $input: no output format specified. Use --man and/or --html and/or --text.\n"
|
||
unless defined $man || defined $html || defined $text;
|
||
|
||
# Default for $name and $section.
|
||
$name = basename ($input, ".pod") unless defined $name;
|
||
$section = 1 unless defined $section;
|
||
|
||
# Is it a user command line tool?
|
||
my $cli_tool = $section == 1 && $name !~ /^guestfs-/;
|
||
|
||
# Warning parameter is mandatory for user tools in section 1.
|
||
if ($strict_checks && $cli_tool) {
|
||
die "$progname: $input: missing argument: --warning parameter is missing or invalid\n"
|
||
unless $warning eq "general" || $warning eq "ro-option" ||
|
||
$warning eq "custom" || $warning eq "safe";
|
||
}
|
||
|
||
# Note that these @...@ are substituted by ./configure.
|
||
my $abs_top_srcdir = "@abs_top_srcdir@";
|
||
my $abs_top_builddir = "@abs_top_builddir@";
|
||
my $package_name = "@PACKAGE_NAME@";
|
||
my $package_version = "@PACKAGE_VERSION@";
|
||
|
||
die "$progname: ./configure substitutions were not performed"
|
||
unless $abs_top_srcdir && $abs_top_builddir &&
|
||
$package_name && $package_version;
|
||
|
||
# Create a stable date (thanks Hilko Bengen).
|
||
my $date = "@RELEASE_DATE@";
|
||
|
||
# Create a release string.
|
||
my $release = "$package_name-$package_version";
|
||
|
||
#print "input=$input\n";
|
||
#print "name=$name\n";
|
||
#print "section=$section\n";
|
||
#print "date=$date\n";
|
||
#print "warning=$warning\n";
|
||
|
||
# Read the input.
|
||
my $content = read_whole_file ($input);
|
||
|
||
# Perform @inserts.
|
||
foreach (@inserts) {
|
||
my @a = split /:/, $_, 2;
|
||
die "$progname: $input: no colon in parameter of --insert\n" unless @a >= 2;
|
||
my $replacement = read_whole_file ($a[0]);
|
||
my $oldcontent = $content;
|
||
$content =~ s/$a[1]/$replacement/ge;
|
||
die "$progname: $input: could not find pattern '$a[1]' in input file\n"
|
||
if $content eq $oldcontent;
|
||
}
|
||
|
||
# Perform INCLUDE directives.
|
||
$content =~ s{__INCLUDE:([-a-z0-9_]+\.pod)__}
|
||
{read_whole_file ("$1", use_path => 1)}ge;
|
||
|
||
# Turn external links to this man page into simple cross-section links.
|
||
$content =~ s,\QL<$name($section)/\E,L</,g;
|
||
|
||
# Perform @verbatims.
|
||
foreach (@verbatims) {
|
||
my @a = split /:/, $_, 2;
|
||
die "$progname: $input: no colon in parameter of --verbatim\n" unless @a >= 2;
|
||
my $replacement = read_verbatim_file ($a[0]);
|
||
my $oldcontent = $content;
|
||
$content =~ s/$a[1]/$replacement/ge;
|
||
die "$progname: $input: could not find pattern '$a[1]' in input file\n"
|
||
if $content eq $oldcontent;
|
||
}
|
||
|
||
# Perform VERBATIM directives.
|
||
$content =~ s{__VERBATIM:([-a-z0-9_]+\.txt)__}
|
||
{read_verbatim_file ("$1", use_path => 1)}ge;
|
||
|
||
# There should be no =encoding line present in the content (we will add one).
|
||
die "$progname: $input: =encoding must not be present in input\n"
|
||
if $content =~ /^=encoding/m;
|
||
|
||
$content =~ s/^=(.*)/\n=encoding utf8\n\n=$1/m;
|
||
|
||
if ($strict_checks) {
|
||
# Verify sections present / not present.
|
||
die "$progname: $input: missing DESCRIPTION section\n"
|
||
if $cli_tool && $content !~ /^=head1 DESCRIPTION/m;
|
||
die "$progname: $input: missing AUTHOR or AUTHORS section\n"
|
||
unless $content =~ /^=head1 AUTHOR/m;
|
||
die "$progname: $input: missing SEE ALSO section\n"
|
||
unless $content =~ /^=head1 SEE ALSO/m;
|
||
die "$progname: $input: missing COPYRIGHT section\n"
|
||
unless $content =~ /^=head1 COPYRIGHT/m;
|
||
die "$progname: $input: BUGS is now added automatically, do not add it to the POD file\n"
|
||
if $content =~ /^=head1 (REPORTING )?BUGS/m;
|
||
die "$progname: $input: LICENSE is now added automatically, do not add it to the POD file\n"
|
||
if $content =~ /^=head1 LICENSE/m;
|
||
die "$progname: $input: GPL/LGPL should be specified using the --license parameter, not included in the POD file\n"
|
||
if $content =~ /^This program is free software/ ||
|
||
$content =~ /^This library is free software/;
|
||
if ($warning eq "general" || $warning eq "ro-option" ||
|
||
$warning eq "safe") {
|
||
die "$progname: $input: WARNING is now added automatically using the --warning parameter\n"
|
||
if $content =~ /^=head1 WARNING/m
|
||
}
|
||
elsif ($warning eq "custom") {
|
||
die "$progname: $input: missing WARNING section\n"
|
||
unless $content =~ /^=head1 WARNING/m;
|
||
}
|
||
}
|
||
|
||
# Add standard LICENSE, BUGS and WARNING sections.
|
||
my $LGPLv2plus =
|
||
"This library is free software; you can redistribute it and/or modify it
|
||
under the terms of the GNU Lesser General Public License as published
|
||
by the Free Software Foundation; either version 2 of the License, or
|
||
(at your option) any later version.
|
||
|
||
This library is distributed in the hope that it will be useful, but
|
||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
Lesser General Public License for more details.
|
||
|
||
You should have received a copy of the GNU Lesser General Public
|
||
License along with this library; if not, write to the Free Software
|
||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||
02110-1301 USA
|
||
";
|
||
|
||
my $GPLv2plus =
|
||
"This program is free software; you can redistribute it and/or modify it
|
||
under the terms of the GNU General Public License as published by the
|
||
Free Software Foundation; either version 2 of the License, or (at your
|
||
option) any later version.
|
||
|
||
This program is distributed in the hope that it will be useful, but
|
||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License along
|
||
with this program; if not, write to the Free Software Foundation, Inc.,
|
||
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||
";
|
||
|
||
my $examples_license =
|
||
"This manual page contains examples which we hope you will use in
|
||
your programs. The examples may be freely copied, modified and
|
||
distributed for any purpose without any restrictions.
|
||
";
|
||
|
||
my $reporting_bugs =
|
||
"=head1 BUGS
|
||
|
||
To get a list of bugs against libguestfs, use this link:
|
||
L<https://bugzilla.redhat.com/buglist.cgi?component=libguestfs&product=Virtualization+Tools>
|
||
|
||
To report a new bug against libguestfs, use this link:
|
||
L<https://bugzilla.redhat.com/enter_bug.cgi?component=libguestfs&product=Virtualization+Tools>
|
||
|
||
When reporting a bug, please supply:
|
||
|
||
\=over 4
|
||
|
||
\=item *
|
||
|
||
The version of libguestfs.
|
||
|
||
\=item *
|
||
|
||
Where you got libguestfs (eg. which Linux distro, compiled from source, etc)
|
||
|
||
\=item *
|
||
|
||
Describe the bug accurately and give a way to reproduce it.
|
||
|
||
\=item *
|
||
|
||
Run L<libguestfs-test-tool(1)> and paste the B<complete, unedited>
|
||
output into the bug report.
|
||
|
||
\=back
|
||
";
|
||
|
||
my $warning_general =
|
||
"Using C<$name>
|
||
on live virtual machines, or concurrently with other
|
||
disk editing tools, can be dangerous, potentially causing disk
|
||
corruption. The virtual machine must be shut down before you use this
|
||
command, and disk images must not be edited concurrently.";
|
||
|
||
my $warning_ro_option =
|
||
"Using C<$name> in write mode
|
||
on live virtual machines, or concurrently with other
|
||
disk editing tools, can be dangerous, potentially causing disk
|
||
corruption. The virtual machine must be shut down before you use this
|
||
command, and disk images must not be edited concurrently.
|
||
|
||
Use the I<--ro> (read-only) option to use C<$name> safely if the disk
|
||
image or virtual machine might be live. You may see strange or
|
||
inconsistent results if running concurrently with other changes, but
|
||
with this option you won't risk disk corruption.";
|
||
|
||
$content .= "\n\n=head1 LICENSE\n\n";
|
||
|
||
foreach (@licenses) {
|
||
if ($_ eq "LGPLv2+") {
|
||
$content .= $LGPLv2plus . "\n\n";
|
||
}
|
||
elsif ($_ eq "GPLv2+") {
|
||
$content .= $GPLv2plus . "\n\n";
|
||
}
|
||
elsif ($_ eq "examples") {
|
||
$content .= $examples_license . "\n\n";
|
||
}
|
||
else {
|
||
die "$progname: $input: invalid --license parameter: $_\n";
|
||
}
|
||
}
|
||
|
||
$content .= "\n\n$reporting_bugs";
|
||
|
||
if ($warning eq "general") {
|
||
$content =~ s/^=head1 DESCRIPTION/=head1 WARNING\n\n$warning_general\n\n=head1 DESCRIPTION/m or die;
|
||
}
|
||
elsif ($warning eq "ro-option") {
|
||
$content =~ s/^=head1 DESCRIPTION/=head1 WARNING\n\n$warning_ro_option\n\n=head1 DESCRIPTION/m or die;
|
||
}
|
||
# else do nothing for $warning "custom", "safe" or "not-set"
|
||
|
||
# Output man page.
|
||
SUBMAN: {
|
||
package Podwrapper::Man;
|
||
|
||
use vars qw(@ISA $VERSION);
|
||
@ISA = qw(Pod::Man);
|
||
$VERSION = $package_version;
|
||
|
||
# Override the L<> method.
|
||
sub cmd_l
|
||
{
|
||
my ($self, $attrs, $text) = @_;
|
||
return $text;
|
||
}
|
||
}
|
||
|
||
if ($man) {
|
||
my $parser = Podwrapper::Man->new (
|
||
name => $name,
|
||
release => $release, section => $section,
|
||
center => "Virtualization Support",
|
||
date => $date,
|
||
stderr => 1, utf8 => 1
|
||
);
|
||
my $output;
|
||
$parser->no_errata_section (1);
|
||
$parser->complain_stderr (1);
|
||
$parser->output_string (\$output);
|
||
$parser->parse_string_document ($content)
|
||
or die "$progname: could not parse input document";
|
||
open OUT, ">$man" or die "$progname: $man: $!";
|
||
print OUT $output or die "$progname: $man: $!";
|
||
close OUT or die "$progname: $man: $!";
|
||
if ($parser->any_errata_seen) {
|
||
unlink $man;
|
||
die "$input: errors or warnings in this POD file, see messages above\n"
|
||
}
|
||
#print "$progname: wrote $man\n";
|
||
}
|
||
|
||
# Output HTML.
|
||
SUBHTML: {
|
||
# Subclass Pod::Simple::XHTML. See the documentation.
|
||
package Podwrapper::XHTML;
|
||
|
||
use vars qw(@ISA $VERSION);
|
||
@ISA = qw(Pod::Simple::XHTML);
|
||
$VERSION = $package_version;
|
||
|
||
# Pod::Simple::XHTML returns uppercase identifiers, whereas the
|
||
# old pod2html returns lowercase ones.
|
||
sub idify
|
||
{
|
||
my $self = shift;
|
||
my $id = $self->SUPER::idify (@_);
|
||
lc ($id);
|
||
}
|
||
|
||
# Note this also allows links to related projects because they all
|
||
# appear together under the http://libguestfs.org website.
|
||
sub is_a_local_page
|
||
{
|
||
local $_ = shift;
|
||
|
||
return 1 if /^Sys::Guestfs/;
|
||
return 0 if /^virt-install/;
|
||
return 1 if /^virt-/;
|
||
return 1 if /^libguestf/;
|
||
return 1 if /^guestf/;
|
||
return 1 if /^guestmount/;
|
||
return 1 if /^guestunmount/;
|
||
return 1 if /^hivex/;
|
||
return 1 if /^supermin/;
|
||
return 1 if /^libnbd/;
|
||
return 1 if /^nbd/;
|
||
return 0;
|
||
}
|
||
|
||
sub resolve_pod_page_link
|
||
{
|
||
my $self = shift;
|
||
my $podname = $_[0]; # eg. "Sys::Guestfs", can be undef
|
||
my $anchor = $_[1]; # eg. "SYNOPSIS", can be undef
|
||
my $r = "";
|
||
if (defined $podname) {
|
||
return $self->SUPER::resolve_pod_page_link (@_)
|
||
unless is_a_local_page ($podname);
|
||
$r .= "$podname.3.html"
|
||
}
|
||
$r .= "#" . $self->idify ($anchor, 1) if defined $anchor;
|
||
$r;
|
||
}
|
||
|
||
sub resolve_man_page_link
|
||
{
|
||
my $self = shift;
|
||
my $name = $_[0]; # eg. "virt-make-fs(1)", can be undef
|
||
my $anchor = $_[1]; # eg. "SYNOPSIS", can be undef
|
||
my $r = "";
|
||
if (defined $name) {
|
||
return $self->SUPER::resolve_man_page_link (@_)
|
||
unless is_a_local_page ($name);
|
||
$name =~ s/\((.*)\)$/.$1/;
|
||
$r .= "$name.html";
|
||
}
|
||
$r .= "#" . $self->idify ($anchor, 1) if defined $anchor;
|
||
$r;
|
||
}
|
||
|
||
# For some reason Pod::Simple::XHTML usually cannot find a
|
||
# title for the page. This defaults the HTML <title> field
|
||
# to the same as the man page name.
|
||
sub default_title { $name }
|
||
}
|
||
|
||
if ($html) {
|
||
mkdir "$abs_top_builddir/website";
|
||
|
||
my $parser = Podwrapper::XHTML->new;
|
||
my $output;
|
||
$parser->no_errata_section (1);
|
||
$parser->complain_stderr (1);
|
||
$parser->output_string (\$output);
|
||
# Added in Pod::Simple 3.16, 2011-03-14.
|
||
eval { $parser->html_charset ("UTF-8") };
|
||
$parser->html_css ("pod.css");
|
||
$parser->index (1);
|
||
$parser->parse_string_document ($content);
|
||
|
||
# Hack for Perl 5.16.
|
||
$output =~ s{/>pod.css<}{/>\n<};
|
||
|
||
open OUT, ">$html" or die "$progname: $html: $!";
|
||
print OUT $output or die "$progname: $html: $!";
|
||
close OUT or die "$progname: $html: $!";
|
||
if ($parser->any_errata_seen) {
|
||
unlink $html;
|
||
die "$input: errors or warnings in this POD file, see messages above\n"
|
||
}
|
||
#print "$progname: wrote $html\n";
|
||
}
|
||
|
||
# Output text.
|
||
if ($text) {
|
||
my $parser = Pod::Simple::Text->new;
|
||
my $output;
|
||
$parser->no_errata_section (1);
|
||
$parser->complain_stderr (1);
|
||
$parser->output_string (\$output);
|
||
$parser->parse_string_document ($content);
|
||
open OUT, ">$text" or die "$progname: $text: $!";
|
||
binmode OUT, ":utf8";
|
||
print OUT $output or die "$progname: $text: $!";
|
||
close OUT or die "$progname: $text: $!";
|
||
if ($parser->any_errata_seen) {
|
||
unlink $text;
|
||
die "$input: errors or warnings in this POD file, see messages above\n"
|
||
}
|
||
#print "$progname: wrote $text\n";
|
||
}
|
||
|
||
sub find_file
|
||
{
|
||
my $input = shift;
|
||
my $use_path = shift;
|
||
local $_;
|
||
|
||
my @search_path = (".");
|
||
push (@search_path, @paths) if $use_path;
|
||
foreach (@search_path) {
|
||
return "$_/$input" if -f "$_/$input";
|
||
}
|
||
die "$progname: $input: cannot find input file on path"
|
||
}
|
||
|
||
sub read_whole_file
|
||
{
|
||
my $input = shift;
|
||
my %options = @_;
|
||
local $/ = undef;
|
||
|
||
$input = find_file ($input, $options{use_path});
|
||
open FILE, $input or die "$progname: $input: $!";
|
||
$_ = <FILE>;
|
||
close FILE;
|
||
$_;
|
||
}
|
||
|
||
sub read_verbatim_file
|
||
{
|
||
my $input = shift;
|
||
my %options = @_;
|
||
my $r = "";
|
||
|
||
$input = find_file ($input, $options{use_path});
|
||
open FILE, $input or die "$progname: $input: $!";
|
||
while (<FILE>) {
|
||
$r .= " $_";
|
||
}
|
||
close FILE;
|
||
$r;
|
||
}
|
||
|
||
=head1 SEE ALSO
|
||
|
||
L<perlpod(1)>,
|
||
L<Pod::Simple(3pm)>,
|
||
libguestfs.git/README.
|
||
|
||
=head1 AUTHOR
|
||
|
||
Richard W.M. Jones.
|
||
|
||
=head1 COPYRIGHT
|
||
|
||
Copyright (C) 2012-2025 Red Hat Inc.
|