# Info.pm: output tree as Info.
#
# Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018
# 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>
package Texinfo::Convert::Info;
use 5.00405;
use strict;
use Texinfo::Common;
use Texinfo::Convert::Plaintext;
use Texinfo::Convert::Text;
use Texinfo::Convert::Paragraph;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Texinfo::Convert::Plaintext);
%EXPORT_TAGS = ( 'all' => [ qw(
convert
) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw(
);
$VERSION = '6.6.91';
my $STDIN_DOCU_NAME = 'stdin';
my %defaults = Texinfo::Convert::Plaintext::converter_defaults(undef, undef);
$defaults{'SHOW_MENU'} = 1;
$defaults{'EXTENSION'} = 'info';
$defaults{'USE_SETFILENAME_EXTENSION'} = 1;
$defaults{'OUTFILE'} = undef;
#$defaults{'TOP_NODE_UP'} = '(dir)';
sub converter_defaults($$)
{
return %defaults;
}
sub output($)
{
my $self = shift;
my $root = shift;
my $result;
$self->_set_outfile();
$self->{'input_basename'} = $STDIN_DOCU_NAME if ($self->{'input_basename'} eq '-');
# no splitting when writing to the null device or to stdout
if ($Texinfo::Common::null_device_file{$self->{'output_file'}}
or $self->{'output_file'} eq '-') {
$self->force_conf('SPLIT_SIZE', undef);
}
push @{$self->{'count_context'}}, {'lines' => 0, 'bytes' => 0,
'locations' => []};
my $header = $self->_info_header();
# header + text between setfilename and first node
my $complete_header = $header;
pop @{$self->{'count_context'}};
return undef unless $self->_create_destination_directory();
my $header_bytes = Texinfo::Convert::Plaintext::count_bytes($self, $header);
my $complete_header_bytes = $header_bytes;
my $elements = Texinfo::Structuring::split_by_node($root);
my $fh;
if (! $self->{'output_file'} eq '') {
if ($self->get_conf('VERBOSE')) {
print STDERR "Output file $self->{'output_file'}\n";
}
$fh = _open_info_file($self, $self->{'output_file'});
if (!$fh) {
return undef;
}
}
print STDERR "DOCUMENT\n" if ($self->get_conf('DEBUG'));
my $out_file_nr = 0;
my @indirect_files;
if (!defined($elements) or $elements->[0]->{'extra'}->{'no_node'}) {
$self->file_line_warn(__("document without nodes"),
$self->{'info'}->{'input_file_name'});
my $output = $header.$self->_convert($root);
$self->_count_context_bug_message('no element ');
my $footnotes = $self->_footnotes();
$self->_count_context_bug_message('no element footnotes ');
$output .= $footnotes;
if ($fh) {
print $fh $output;
} else {
$result = $output;
}
} else {
unless ($self->{'structuring'} and $self->{'structuring'}->{'top_node'}
and $self->{'structuring'}->{'top_node'}->{'extra'}->{'normalized'} eq 'Top') {
$self->file_line_warn(__("document without Top node"),
$self->{'info'}->{'input_file_name'});
}
$out_file_nr = 1;
my $first_node = 0;
$self->{'count_context'}->[-1]->{'bytes'} += $header_bytes;
my @nodes = @$elements;
while (@nodes) {
my $node = shift @nodes;
my $node_text = $self->_convert_element($node);
if (!$first_node) {
$first_node = 1;
if (defined($self->{'text_before_first_node'})) {
$complete_header .= $self->{'text_before_first_node'};
$complete_header_bytes += Texinfo::Convert::Plaintext::count_bytes($self, $self->{'text_before_first_node'});
}
# for the first node, header is prepended, not complete_header
# as 'text_before_first_node' is already part of the node
# text
$node_text = $header . $node_text;
}
if ($fh) {
print $fh $node_text;
} else {
$result .= $node_text;
}
$self->_update_count_context();
if (defined($self->get_conf('SPLIT_SIZE'))
and $self->{'count_context'}->[-1]->{'bytes'} >
$out_file_nr * $self->get_conf('SPLIT_SIZE')
and @nodes and $fh) {
my $close_error;
if (!close ($fh)) {
$close_error = $!;
}
if ($out_file_nr == 1) {
$self->register_close_file($self->{'output_file'});
if (defined($close_error)) {
$self->document_error(sprintf(__("error on closing %s: %s"),
$self->{'output_file'}, $close_error));
return undef;
}
if ($self->get_conf('VERBOSE')) {
print STDERR "Renaming first output file as ".
$self->{'output_file'}.'-'.$out_file_nr."\n";
}
unless (rename($self->{'output_file'},
$self->{'output_file'}.'-'.$out_file_nr)) {
$self->document_error(sprintf(__("rename %s failed: %s"),
$self->{'output_file'}, $!));
return undef;
}
# remove the main file from opened files since it was renamed
# and add the file with a number.
@{$self->{'opened_files'}} = grep {$_ ne $self->{'output_file'}}
@{$self->{'opened_files'}};
push @{$self->{'opened_files'}},
$self->{'output_file'}.'-'.$out_file_nr;
push @indirect_files, [$self->{'output_filename'}.'-'.$out_file_nr,
$complete_header_bytes];
#print STDERR join(' --> ', @{$indirect_files[-1]}) ."\n";
} else {
$self->register_close_file($self->{'output_file'}.'-'.$out_file_nr);
if (defined($close_error)) {
$self->document_error(sprintf(__("error on closing %s: %s"),
$self->{'output_file'}.'-'.$out_file_nr,
$close_error));
return undef;
}
}
$out_file_nr++;
if ($self->get_conf('VERBOSE')) {
print STDERR "New output file ".
$self->{'output_file'}.'-'.$out_file_nr."\n";
}
$fh = _open_info_file($self, $self->{'output_file'}.'-'.$out_file_nr);
if (!$fh) {
return undef;
}
print $fh $complete_header;
$self->_update_count_context();
$self->{'count_context'}->[-1]->{'bytes'} += $complete_header_bytes;
push @indirect_files, [$self->{'output_filename'}.'-'.$out_file_nr,
$self->{'count_context'}->[-1]->{'bytes'}];
#print STDERR join(' --> ', @{$indirect_files[-1]}) ."\n";
}
}
}
my $tag_text = '';
if ($out_file_nr > 1) {
$self->register_close_file($self->{'output_file'}.'-'.$out_file_nr);
if (!close ($fh)) {
$self->document_error(sprintf(__("error on closing %s: %s"),
$self->{'output_file'}.'-'.$out_file_nr, $!));
return undef;
}
if ($self->get_conf('VERBOSE')) {
print STDERR "Outputing the split manual file $self->{'output_file'}\n";
}
$fh = _open_info_file($self, $self->{'output_file'});
if (!$fh) {
return undef;
}
$tag_text = $complete_header;
$tag_text .= "\x{1F}\nIndirect:";
foreach my $indirect (@indirect_files) {
$tag_text .= "\n$indirect->[0]: $indirect->[1]";
}
}
$tag_text .= "\n\x{1F}\nTag Table:\n";
if ($out_file_nr > 1) {
$tag_text .= "(Indirect)\n";
}
# This may happen for anchors in @insertcopying
my %seen_anchors;
foreach my $label (@{$self->{'count_context'}->[-1]->{'locations'}}) {
next unless ($label->{'root'} and $label->{'root'}->{'extra'}
and defined($label->{'root'}->{'extra'}->{'node_content'}));
my $prefix;
if ($label->{'root'}->{'cmdname'} eq 'node') {
$prefix = 'Node';
} else {
$prefix = 'Ref';
}
my ($label_text, $byte_count) = $self->_node_line($label->{'root'});
if ($seen_anchors{$label_text}) {
$self->line_error(sprintf(__("\@%s output more than once: %s"),
$label->{'root'}->{'cmdname'},
Texinfo::Convert::Texinfo::convert({'contents' =>
$label->{'root'}->{'extra'}->{'node_content'}})),
$label->{'root'}->{'line_nr'});
next;
} else {
$seen_anchors{$label_text} = 1;
}
$tag_text .= "$prefix: $label_text\x{7F}$label->{'bytes'}\n";
}
$tag_text .= "\x{1F}\nEnd Tag Table\n";
my $coding = $self->get_conf('OUTPUT_ENCODING_NAME');
if ($coding) {
$tag_text .= "\n\x{1F}\nLocal Variables:\ncoding: $coding\nEnd:\n";
}
if ($fh) {
print $fh $tag_text;
# NOTE it should be possible to close STDOUT. However this leads to
# 'Filehandle STDOUT reopened as FH only for input' if there are files
# reopened after closing STDOUT. So closing STDOUT is handled by the
# caller.
unless ($self->{'output_file'} eq '-') {
$self->register_close_file($self->{'output_file'});
if (!close ($fh)) {
$self->document_error(sprintf(__("error on closing %s: %s"),
$self->{'output_file'}, $!));
}
}
} else {
$result .= $tag_text;
}
return $result;
}
# Wrapper around Texinfo::Common::open_out. Open the file with any CR-LF
# conversion disabled. We need this for tag tables to be correct under
# MS-Windows. Return filehandle or undef on failure.
sub _open_info_file($$)
{
my $self = shift;
my $filename = shift;
my $fh = $self->Texinfo::Common::open_out($filename, undef, 'use_binmode');
if (!$fh) {
$self->document_error(sprintf(
__("could not open %s for writing: %s"),
$filename, $!));
return undef;
}
return $fh;
}
sub _info_header($)
{
my $self = shift;
$self->_set_global_multiple_commands();
my $paragraph = Texinfo::Convert::Paragraph->new();
my $result = add_text($paragraph, "This is ");
# This ensures that spaces in file are kept.
$result .= add_next($paragraph, $self->{'output_filename'});
my $program = $self->get_conf('PROGRAM');
my $version = $self->get_conf('PACKAGE_VERSION');
if (defined($program) and $program ne '') {
$result .= add_text($paragraph, ", produced by $program version $version from ");
} else {
$result .= add_text($paragraph, ", produced from ");
}
$result .= add_next($paragraph, $self->{'input_basename'});
$result .= add_text($paragraph, '.');
$result .= Texinfo::Convert::Paragraph::end($paragraph);
$result .= "\n";
$self->{'empty_lines_count'} = 1;
if ($self->{'extra'} and $self->{'extra'}->{'copying'}) {
print STDERR "COPYING HEADER\n" if ($self->get_conf('DEBUG'));
$self->{'in_copying_header'} = 1;
my $copying = $self->_convert({'contents' =>
$self->{'extra'}->{'copying'}->{'contents'}});
$result .= $copying;
$result .= $self->_footnotes();
delete $self->{'in_copying_header'};
}
if ($self->{'info'}->{'dircategory_direntry'}) {
$self->{'ignored_commands'}->{'direntry'} = 0;
foreach my $command (@{$self->{'info'}->{'dircategory_direntry'}}) {
if ($command->{'cmdname'} eq 'dircategory') {
if ($command->{'args'} and @{$command->{'args'}}
and defined($command->{'args'}->[0]->{'contents'})) {
my $dircategory = "INFO-DIR-SECTION ".$self->convert_line(
{'contents' => $command->{'args'}->[0]->{'contents'}});
$result .= $self->ensure_end_of_line($dircategory);
}
$self->{'empty_lines_count'} = 0;
} elsif ($command->{'cmdname'} eq 'direntry') {
$result .= "START-INFO-DIR-ENTRY\n";
my $direntry = $self->_convert($command);
$result .= $direntry;
$result .= "END-INFO-DIR-ENTRY\n\n";
$self->{'empty_lines_count'} = 1;
}
}
$self->{'ignored_commands'}->{'direntry'} = 1;
}
$self->_unset_global_multiple_commands();
return $result;
}
sub _contents($$$)
{
my $self = shift;
my $section_root = shift;
my $contents_or_shortcontents = shift;
return ('', 0);
}
sub _printindex($$)
{
my $self = shift;
my $printindex = shift;
return $self->_printindex_formatted($printindex, 1);
}
sub _error_outside_of_any_node($$)
{
my $self = shift;
my $root = shift;
if (!$self->{'node'}) {
$self->line_warn(sprintf(__("\@%s outside of any node"),
$root->{'cmdname'}), $root->{'line_nr'});
}
}
my @directions = ('Next', 'Prev', 'Up');
sub _node($$)
{
my $self = shift;
my $node = shift;
my $result = '';
return '' if (!defined($node->{'extra'}->{'node_content'}));
if (!$self->{'empty_lines_count'}) {
$result .= "\n";
$self->_add_text_count("\n");
# if in the first node, complete the 'text_before_first_node' too.
if (!$self->{'first_node_done'}) {
$self->{'text_before_first_node'} .= "\n";
}
}
if (!$self->{'first_node_done'}) {
$self->{'first_node_done'} = 1;
}
# May happen when only converting a fragment
my $output_filename = $self->{'output_filename'};
if (defined($self->{'output_filename'})) {
$output_filename = $self->{'output_filename'};
} else {
$output_filename = '';
}
$self->_add_location($node);
my $node_begin = "\x{1F}\nFile: $output_filename, Node: ";
$result .= $node_begin;
$self->_add_text_count($node_begin);
my ($node_text, $byte_count) = $self->_node_line($node);
my $pre_quote = '';
my $post_quote = '';
if ($node_text =~ /,/) {
if ($self->get_conf('INFO_SPECIAL_CHARS_WARNING')) {
$self->line_warn(sprintf(__(
"\@node name should not contain `,': %s"), $node_text),
$node->{'line_nr'});
}
if ($self->get_conf('INFO_SPECIAL_CHARS_QUOTE')) {
$pre_quote = "\x{7f}";
$post_quote = $pre_quote;
$self->{'count_context'}->[-1]->{'bytes'} += 2;
}
}
$self->{'count_context'}->[-1]->{'bytes'} += $byte_count;
$result .= $pre_quote . $node_text . $post_quote;
foreach my $direction(@directions) {
if ($node->{'node_'.lc($direction)}) {
my $node_direction = $node->{'node_'.lc($direction)};
my $text = ", $direction: ";
$self->_add_text_count($text);
$result .= $text;
if ($node_direction->{'extra'}->{'manual_content'}) {
$result .= $self->convert_line({'type' => '_code',
'contents' => [{'text' => '('},
@{$node_direction->{'extra'}->{'manual_content'}},
{'text' => ')'}]});
}
if ($node_direction->{'extra'}->{'node_content'}) {
my ($node_text, $byte_count) = $self->_node_line($node_direction);
$self->{'count_context'}->[-1]->{'bytes'} += $byte_count;
$result .= $node_text;
}
} elsif ($direction eq 'Up' and $node->{'extra'}->{'normalized'} eq 'Top') {
# add an up direction for Top node
my $text = ", $direction: ".$self->get_conf('TOP_NODE_UP');
$self->_add_text_count($text);
$result .= $text;
}
}
$result .="\n\n";
$self->_add_text_count("\n\n");
$self->{'count_context'}->[-1]->{'lines'} = 3;
$self->{'empty_lines_count'} = 1;
return $result;
}
my @image_files_extensions = ('.png', '.jpg');
sub _image($$)
{
my $self = shift;
my $root = shift;
my @extensions = @image_files_extensions;
my $lines_count = 0;
if (defined($root->{'args'}->[0])
and @{$root->{'args'}->[0]->{'contents'}}) {
my $basefile = Texinfo::Convert::Text::convert(
{'contents' => $root->{'args'}->[0]->{'contents'}},
{'code' => 1, Texinfo::Common::_convert_text_options($self)});
if (defined($root->{'args'}->[4])
and @{$root->{'args'}->[4]->{'contents'}}) {
my $extension = Texinfo::Convert::Text::convert(
{'contents' => $root->{'args'}->[4]->{'contents'}},
{'code' => 1, Texinfo::Common::_convert_text_options($self)});
unshift @extensions, ".$extension";
unshift @extensions, "$extension";
}
my $image_file;
foreach my $extension (@extensions) {
if ($self->Texinfo::Common::locate_include_file ($basefile.$extension)) {
# use the basename and not the file found. It is agreed that it is
# better, since in any case the files are moved.
$image_file = $basefile.$extension;
last;
}
}
my ($text, $width) = $self->_image_text($root, $basefile);
my $alt;
if (defined($root->{'args'}->[3])
and @{$root->{'args'}->[3]->{'contents'}}) {
$alt = Texinfo::Convert::Text::convert(
{'contents' => $root->{'args'}->[3]->{'contents'}},
{Texinfo::Common::_convert_text_options($self)});
}
my $result;
if (defined($image_file) or (defined($text) and defined($alt))) {
$image_file =~ s/\\/\\\\/g;
$image_file =~ s/\"/\\\"/g;
$result = "\x{00}\x{08}[image src=\"$image_file\"";
if (defined($root->{'args'}->[3])
and @{$root->{'args'}->[3]->{'contents'}}) {
$alt =~ s/\\/\\\\/g;
$alt =~ s/\"/\\\"/g;
$result .= " alt=\"$alt\"";
}
if (defined($text)) {
$text =~ s/\\/\\\\/g;
$text =~ s/\"/\\\"/g;
$result .= " text=\"$text\"";
}
$result .= "\x{00}\x{08}]";
if ($self->{'formatters'}->[-1]->{'_top_formatter'}) {
$result .= "\n";
}
my $image_lines_count = ($result =~ tr/\n/\n/) +1;
$self->_add_image($root, $image_lines_count, $width, 1);
} else {
$result = $self->_image_formatted_text($root, $basefile, $text);
$lines_count = ($result =~ tr/\n/\n/);
$self->_add_image($root, $lines_count+1, $width);
}
return ($result, $lines_count);
}
return ('', 0);
}
1;
__END__
# $Id: template.pod 6140 2015-02-22 23:34:38Z karl $
# Automatically generated from maintain/template.pod
=head1 NAME
Texinfo::Convert::Info - Convert Texinfo tree to Info
=head1 SYNOPSIS
my $converter
= Texinfo::Convert::Info->converter({'parser' => $parser});
$converter->output($tree);
$converter->convert($tree);
$converter->convert_tree($tree);
=head1 DESCRIPTION
Texinfo::Convert::Info converts a Texinfo tree to Info.
=head1 METHODS
=over
=item $converter = Texinfo::Convert::Info->converter($options)
Initialize converter from Texinfo to Info.
The I<$options> hash reference holds options for the converter. In
this option hash reference a parser object may be associated with the
I<parser> key. The other options should be configuration options
described in the Texinfo manual. Those options, when appropriate,
override the document content.
See L<Texinfo::Convert::Converter> for more informations.
=item $converter->output($tree)
Convert a Texinfo tree I<$tree> and output the result in files as
described in the Texinfo manual.
=item $result = $converter->convert($tree)
Convert a Texinfo tree I<$tree> or tree portion and return
the resulting output.
=item $result = $converter->convert_tree($tree)
Convert a Texinfo tree portion I<$tree> and return the resulting
output. This function does not try to output a full document but only
portions. For a full document use C<convert>.
=back
=head1 AUTHOR
Patrice Dumas, E<lt>pertusus@free.frE<gt>
=cut