#! /usr/bin/env perl
# $Id: pod2texi.pl 6906 2016-01-01 18:33:45Z karl $
# pod2texi -- convert Pod to Texinfo.
# Copyright 2012, 2013, 2014, 2015, 2016 Free Software Foundation, Inc.
#
# 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 3 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, see <http://www.gnu.org/licenses/>.
#
# Original author: Patrice Dumas <pertusus@free.fr>
use strict;
use Getopt::Long qw(GetOptions);
# for dirname.
use File::Basename;
use File::Spec;
Getopt::Long::Configure("gnu_getopt");
#use Pod::Simple::Debug (4);
BEGIN
{
# emulate -w
$^W = 1;
my ($real_command_name, $command_directory, $command_suffix)
= fileparse($0, '.pl');
my $datadir = '@datadir@';
my $package = '@PACKAGE@';
my $updir = File::Spec->updir();
my $texinfolibdir;
my $lib_dir;
# in-source run
if (($command_suffix eq '.pl' and !(defined($ENV{'TEXINFO_DEV_SOURCE'})
and $ENV{'TEXINFO_DEV_SOURCE'} eq 0)) or $ENV{'TEXINFO_DEV_SOURCE'}) {
my $srcdir = defined $ENV{'srcdir'} ? $ENV{'srcdir'} : $command_directory;
$texinfolibdir = File::Spec->catdir($srcdir, $updir, 'tp');
$lib_dir = File::Spec->catdir($texinfolibdir, 'maintain');
unshift @INC, (File::Spec->catdir($srcdir, 'lib'), $texinfolibdir);
} elsif ($datadir ne '@' .'datadir@' and $package ne '@' . 'PACKAGE@'
and $datadir ne '') {
$texinfolibdir = File::Spec->catdir($datadir, $package);
# try to make package relocatable, will only work if standard relative paths
# are used
if (! -f File::Spec->catfile($texinfolibdir, 'Texinfo', 'Parser.pm')
and -f File::Spec->catfile($command_directory, $updir, 'share',
'texinfo', 'Texinfo', 'Parser.pm')) {
$texinfolibdir = File::Spec->catdir($command_directory, $updir,
'share', 'texinfo');
}
$lib_dir = $texinfolibdir;
unshift @INC, (File::Spec->catdir($texinfolibdir, 'Pod-Simple-Texinfo'),
$texinfolibdir);
}
# '@USE_EXTERNAL_LIBINTL @ and similar are substituted in the
# makefile using values from configure
if (defined($texinfolibdir)) {
if ('@USE_EXTERNAL_LIBINTL@' ne 'yes') {
unshift @INC, (File::Spec->catdir($lib_dir, 'lib', 'libintl-perl', 'lib'));
}
if ('@USE_EXTERNAL_EASTASIANWIDTH@' ne 'yes') {
unshift @INC, (File::Spec->catdir($lib_dir, 'lib', 'Unicode-EastAsianWidth', 'lib'));
}
if ('@USE_EXTERNAL_UNIDECODE@' ne 'yes') {
unshift @INC, (File::Spec->catdir($lib_dir, 'lib', 'Text-Unidecode', 'lib'));
}
}
}
use Pod::Simple::Texinfo;
use Texinfo::Common;
use Texinfo::Parser;
use Texinfo::Structuring;
{
# A fake package to be able to use Pod::Simple::PullParser without generating
# any output.
package Pod::Simple::PullParserRun;
use vars qw(@ISA);
@ISA = ('Pod::Simple::PullParser');
sub new
{
return shift->SUPER::new(@_);
}
sub run(){};
}
my ($real_command_name, $directories, $suffix) = fileparse($0);
# placeholder for string translations, not used for now
sub __($)
{
return $_[0];
}
sub pod2texi_help()
{
return __("Usage: pod2texi [OPTION]... POD...
Translate Perl pod documentation file(s) to Texinfo. There are two
basic modes of operation. First, by default, each pod is translated to
a standalone Texinfo manual.
Second, if C<--base-level> is set higher than 0, each pod is translated
to a file suitable for C<\@include>, and one more file with all the
C<\@include>s is generated, intended to be C<\@include>d in turn within
a hand-written top-level file.
Options:
--appendix-sections use appendix-like sections.
--base-level=NUM|NAME level of the head1 commands; default 0.
--debug=NUM set debugging level.
--help display this help and exit.
--no-fill-section-gaps do not fill sectioning gaps.
--no-section-nodes use anchors for sections instead of nodes.
--output=NAME output to NAME for the first or main manual
instead of standard output.
--preamble=STR insert STR as beginning boilerplate.
--subdir=NAME put files included in the main manual in NAME.
--top top for the main manual.
--unnumbered-sections use unumbered sections.
--version display version information and exit.
Email bug reports to bug-texinfo\@gnu.org,
general questions and discussion to help-texinfo\@gnu.org.
Texinfo home page: http://www.gnu.org/software/texinfo/\n");
}
my $base_level = 0;
my $unnumbered_sections = 0;
my $appendix_sections = 0;
my $output = '-';
my $top = 'top';
my $preamble = undef;
my $subdir;
my $section_nodes = 1;
my $fill_sectioning_gaps = 1;
my $debug = 0;
my $result_options = Getopt::Long::GetOptions (
'help|h' => sub { print pod2texi_help(); exit 0; },
'version|V' => sub {print "$real_command_name $Pod::Simple::Texinfo::VERSION\n\n";
printf __("Copyright (C) %s Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.\n"), "2016";
exit 0;},
'base-level=s' => sub {
if ($_[1] =~ /^[0-4]$/) {
$base_level = $_[1];
} elsif (defined($Texinfo::Common::command_structuring_level{$_[1]})) {
$base_level = $Texinfo::Common::command_structuring_level{$_[1]};
} else {
die sprintf(__("%s: wrong argument for --base-level\n"),
$real_command_name);
}
},
'unnumbered-sections!' => \$unnumbered_sections,
'appendix-sections!' => \$appendix_sections,
'output|o=s' => \$output,
'preamble=s' => \$preamble,
'subdir=s' => \$subdir,
'top=s' => \$top,
'section-nodes!' => \$section_nodes,
'fill-section-gaps!' => \$fill_sectioning_gaps,
'debug=i' => \$debug,
);
exit 1 if (!$result_options);
if (defined($subdir)) {
if (! -d $subdir) {
if (!mkdir($subdir)) {
die sprintf(__("%s: could not create directory %s: %s"),
$real_command_name, $subdir, $!);
}
}
}
my $STDOUT_DOCU_NAME = 'stdout';
my @manuals;
my @all_manual_names;
my @input_files = @ARGV;
# use STDIN if not a tty, like makeinfo does
@input_files = ('-') if (!scalar(@input_files) and !-t STDIN);
die sprintf(__("%s: missing file argument;\n"), $real_command_name)
.sprintf(__("try `%s --help' for more information\n"), $real_command_name)
unless (scalar(@input_files) >= 1);
my @processed_files;
# First gather all the manual names
if ($base_level > 0) {
foreach my $file (@input_files) {
# we don't want to read from STDIN, as the input read would be lost
# same with named pipe and socket...
# FIXME are there other file that have the same problem?
next if ($file eq '-' or -p $file or -S $file);
# not really used, only the manual name is used.
my $parser = Pod::Simple::PullParserRun->new();
$parser->parse_file($file);
my $short_title = $parser->get_short_title();
if (defined($short_title) and $short_title =~ m/\S/) {
push @manuals, $short_title;
push @all_manual_names, $short_title;
#print STDERR "NEW MANUAL: $short_title\n";
} else {
if (!$parser->content_seen) {
warn sprintf(__("%s: ignoring %s without content\n"),
$real_command_name, $file);
next;
}
push @all_manual_names, undef;
}
push @processed_files, $file;
}
} else {
@processed_files = @input_files;
}
sub _fix_texinfo_tree($$$$;$)
{
my $self = shift;
my $manual_texi = shift;
my $section_nodes = shift;
my $fill_gaps_in_sectioning = shift;
my $do_master_menu = shift;
my $parser = Texinfo::Parser::parser();
my $tree = $parser->parse_texi_text($manual_texi);
if ($fill_gaps_in_sectioning) {
my ($added_sections, $added_nodes);
($tree->{'contents'}, $added_sections)
= Texinfo::Structuring::fill_gaps_in_sectioning($tree);
# there should already be nodes associated with other sections. Therefore
# new nodes should only be created for the $added_sections.
if ($section_nodes) {
($tree->{'contents'}, $added_nodes)
= Texinfo::Structuring::insert_nodes_for_sectioning_commands($parser, $tree);
if ($self and $self->texinfo_sectioning_base_level > 0) {
# prepend the manual name
foreach my $node (@$added_nodes) {
# First remove the old normalized entry
delete $parser->{'labels'}->{$node->{'extra'}->{'normalized'}};
# now get the number
my $node_texi = Texinfo::Convert::Texinfo::convert(
{'contents' => $node->{'extra'}->{'node_content'}});
# We could have kept the asis, too, it is kept when !section_nodes
$node_texi =~ s/^\s*(\@asis\{\})?\s*//;
# complete with manual name
my $complete_node_name = $self->_node_name($node_texi);
# now recreate node arg, similar with Texinfo::Structuring::_new_node
my $tree = Texinfo::Parser::parse_texi_text(undef, $complete_node_name);
my $node_arg = $node->{'args'}->[0];
$node_arg->{'contents'} = $tree->{'contents'};
push @{$node_arg->{'contents'}},
{'type' => 'spaces_at_end', 'text' => "\n"};
unshift @{$node_arg->{'contents'}},
{'extra' => {'command' => $node},
'text' => ' ',
'type' => 'empty_spaces_after_command'};
foreach my $content (@{$node_arg->{'contents'}}) {
$content->{'parent'} = $node_arg;
}
# Last parse and register node
my $parsed_node = Texinfo::Parser::_parse_node_manual($node_arg);
#push @{$node->{'extra'}->{'nodes_manuals'}}, $parsed_node;
@{$node->{'extra'}->{'nodes_manuals'}} = ($parsed_node);
if (!Texinfo::Parser::_register_label($parser, $node, $parsed_node, undef)) {
print STDERR "BUG: node not unique, register failed: $parsed_node->{'normalized'}\n";
}
}
}
}
}
my $structure = Texinfo::Structuring::sectioning_structure($parser, $tree);
Texinfo::Structuring::complete_tree_nodes_menus($parser, $tree)
if ($section_nodes);
Texinfo::Structuring::regenerate_master_menu($parser) if ($do_master_menu);
return ($parser, $tree);
}
sub _fix_texinfo_manual($$$$;$)
{
my $self = shift;
my $manual_texi = shift;
my $section_nodes = shift;
my $fill_gaps_in_sectioning = shift;
my $do_master_menu = shift;
my ($parser, $tree) = _fix_texinfo_tree($self, $manual_texi, $section_nodes,
$fill_gaps_in_sectioning, $do_master_menu);
return Texinfo::Convert::Texinfo::convert($tree);
}
sub _do_top_node_menu($)
{
my $manual_texi = shift;
my ($parser, $tree) = _fix_texinfo_tree(undef, $manual_texi, 1, 0, 1);
my $labels = $parser->labels_information();
my $top_node_menu = $labels->{'Top'}->{'menus'}->[0];
if ($top_node_menu) {
return Texinfo::Convert::Texinfo::convert($top_node_menu);
} else {
return '';
}
}
my $file_nr = 0;
# Full manual is collected to generate the top node menu, if $section_nodes
my $full_manual = '';
my @included;
foreach my $file (@processed_files) {
my $manual_texi = '';
my $outfile;
my $name = shift @all_manual_names;
if ($base_level == 0 and !$file_nr) {
$outfile = $output;
} else {
if (defined($name)) {
$outfile = Pod::Simple::Texinfo::_pod_title_to_file_name($name);
$outfile .= '.texi';
} else {
if ($file eq '-') {
$outfile = $STDOUT_DOCU_NAME;
} else {
$outfile = $file;
}
if ($outfile =~ /\.(pm|pod)$/) {
$outfile =~ s/\.(pm|pod)$/.texi/i;
} else {
$outfile .= '.texi';
}
}
$outfile = File::Spec->catfile($subdir, $outfile)
if (defined($subdir));
}
my $new = Pod::Simple::Texinfo->new();
push @included, [$name, $outfile, $file] if ($base_level > 0);
my $fh;
if ($outfile eq '-') {
$fh = *STDOUT;
} else {
open (OUT, ">$outfile") or die sprintf(__("%s: could not open %s for writing: %s\n"),
$real_command_name, $outfile, $!);
$fh = *OUT;
}
# FIXME should use =encoding
binmode($fh, ':encoding(utf8)');
$new->output_string(\$manual_texi);
$new->texinfo_sectioning_base_level($base_level);
if ($section_nodes) {
$new->texinfo_section_nodes(1);
}
if ($unnumbered_sections) {
$new->texinfo_sectioning_style('unnumbered');
} elsif ($appendix_sections) {
$new->texinfo_sectioning_style('appendix');
}
if ($base_level > 0 and @manuals) {
$new->texinfo_internal_pod_manuals(\@manuals);
}
print STDERR "processing $file -> $outfile ($name)\n" if ($debug);
$new->parse_file($file);
if ($section_nodes or $fill_sectioning_gaps) {
if ($debug > 4) {
# print to a file
open (DBGFILE, ">$outfile-dbg") or die sprintf(__("%s: could not open %s: %s\n"),
$real_command_name, "$outfile-dbg", $!);
binmode(DBGFILE, ':encoding(utf8)');
print DBGFILE $manual_texi;
}
$manual_texi = _fix_texinfo_manual($new, $manual_texi, $section_nodes,
$fill_sectioning_gaps);
$full_manual .= $manual_texi if ($section_nodes);
}
print $fh $manual_texi;
if ($outfile ne '-') {
close($fh) or die sprintf(__("%s: error on closing %s: %s\n"),
$real_command_name, $outfile, $!);
}
if ($base_level > 0) {
if (!$new->content_seen) {
# this should only happen for input coming from pipe or the like
warn sprintf(__("%s: removing %s as input file %s has no content\n"),
$real_command_name, $outfile, $file);
unlink ($outfile);
pop @included;
# if we didn't gather the short title, try now, and rename out file if found
} elsif (!defined($name)) {
my $short_title = $new->texinfo_short_title;
if (defined($short_title) and $short_title =~ /\S/) {
push @manuals, $short_title;
pop @included;
my $new_outfile
= Pod::Simple::Texinfo::_pod_title_to_file_name($short_title);
$new_outfile .= '.texi';
$new_outfile = File::Spec->catfile($subdir, $new_outfile)
if (defined($subdir));
if ($new_outfile ne $outfile) {
unless (rename ($outfile, $new_outfile)) {
die sprintf(__("%s: rename %s failed: %s\n"),
$real_command_name, $outfile, $!);
}
}
push @included, [$short_title, $new_outfile, $file];
}
}
}
$file_nr++;
}
if ($base_level > 0) {
my $fh;
if ($output ne '-') {
open (OUT, ">$output") or die sprintf(__("%s: could not open %s for writing: %s\n"),
$real_command_name, $output, $!);
$fh = *OUT;
} else {
$fh = *STDOUT;
}
# FIXME should use =encoding
binmode($fh, ':encoding(utf8)');
my $outfile_name = $output;
$outfile_name = $STDOUT_DOCU_NAME if ($outfile_name eq '-');
$outfile_name =~ s/\.te?x(i|info)?$//;
$outfile_name .= '.info';
if (! defined ($preamble)) {
$preamble = '\input texinfo
@setfilename ' . Pod::Simple::Texinfo::_protect_text($outfile_name) . "
\@documentencoding utf-8
\@settitle $top
\@contents
\@ifnottex
\@node Top
\@top $top
\@end ifnottex\n\n";
}
print $fh $preamble;
if ($section_nodes) {
#print STDERR "\@node Top\n\@top top\n".$full_manual;
my $menu = _do_top_node_menu("\@node Top\n\@top top\n".$full_manual);
print $fh $menu."\n";
}
foreach my $include (@included) {
my $file = $include->[1];
print $fh "\@include ".Pod::Simple::Texinfo::_protect_text($file)."\n";
}
print $fh "\n\@bye\n";
if ($output ne '-') {
close($fh) or die sprintf(__("%s: error on closing %s: %s\n"),
$real_command_name, $output, $!);
}
}
if (defined($output) and $output eq '-') {
close(STDOUT) or die sprintf(__("%s: error on closing stdout: %s\n"),
$real_command_name, $!);
}
1;
__END__
=head1 NAME
pod2texi - convert Pod to Texinfo
=head1 SYNOPSIS
pod2texi [OPTION]... POD...
=head1 DESCRIPTION
Translate Pod file(s) to Texinfo. There are two basic modes of
operation. First, by default, each pod is translated to a standalone
Texinfo manual.
Second, if C<--base-level> is set higher than 0, each pod is translated
to a file suitable for C<@include>, and one more file with all the
C<@include>s is generated, intended to be C<@include>d in turn within a
hand-written top-level file.
=head1 OPTIONS
=over
=item B<--appendix-sections>
Use appendix sectioning commands (C<@appendix>, ...) instead of the
default numbered sectioning Texinfo @-commands (C<@chapter>,
C<@section>, ...).
=item B<--base-level>=I<NUM|NAME>
Sets the level of the C<head1> commands. It may be an integer or a
Texinfo sectioning command (without the C<@>): 1 corresponds to the
C<@chapter>/C<@unnumbered> level, 2 to the C<@section> level, and so on.
The default is 0, meaning that C<head1> commands are still output as
chapters, but the output is arranged as a standalone manual.
If the level is not 0, the pod file is rendered as a fragment of a
Texinfo manual suitable for C<@include>. In this case, each pod file
has an additional sectioning command covering the entire file, one level
above the C<--base-level> value. Therefore, to make each pod file a
chapter in a large manual, you should use C<section> as the base level.
For an example of making Texinfo out of the Perl documentation itself,
see C<contrib/perldoc-all> in the Texinfo source distribution, with
output available at L<http://www.gnu.org/software/perl/manual>.
=item B<--debug>=I<NUM>
Set debugging level to I<NUM>.
=item B<--help>
Display help and exit.
=item B<--output>=I<NAME>
Name for the first manual, or the main manual if there is a main manual.
Default is to write to standard output.
=item B<--no-section-nodes>
Use anchors for sections instead of nodes.
=item B<--no-fill-section-gaps>
Do not fill sectioning gaps with empty C<@unnumbered> files.
Ordinarily, it's good to keep the sectioning hierarchy intact.
=item B<--preamble>=I<STR>
Insert I<STR> as top boilerplate before includes. The default is a
minimal beginning for a Texinfo document, and sets C<@documentencoding>
to C<utf-8> (because the output is written that way).
=item B<--subdir>=I<NAME>
If there is a main manual with include files (each corresponding to
an input pod file), then those include files are put in directory I<NAME>.
=item B<--unnumbered-sections>
Use unnumbered sectioning commands (C<@unnumbered>, ...) instead of the
default numbered sectioning Texinfo @-commands (C<@chapter>,
C<@section>, ...).
=item B<--top>=I<TOP>
Name of the C<@top> element for the main manual. May contain Texinfo code.
=item B<--version>
Display version information and exit.
=back
=head1 SEE ALSO
L<Pod::Simple::Texinfo>. L<perlpod>. The Texinfo manual.
Texinfo home page: L<http://www.gnu.org/software/texinfo/>
=head1 COPYRIGHT
Copyright 2016 Free Software Foundation, Inc.
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 3 of the License,
or (at your option) any later version.
There is NO WARRANTY, to the extent permitted by law.
=head1 AUTHOR
Patrice Dumas E<lt>bug-texinfo@gnu.orgE<gt>.
=cut