# Converter.pm: Common code for Converters.
#
# Copyright 2011-2019 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 .
#
# Original author: Patrice Dumas
package Texinfo::Convert::Converter;
use 5.00405;
use strict;
# for fileparse
use File::Basename;
# for file names portability
use File::Spec;
use Encode;
use Texinfo::Common;
use Texinfo::Structuring;
use Carp qw(cluck);
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter Texinfo::Report);
%EXPORT_TAGS = ( 'all' => [ qw(
xml_protect_text
xml_comment
xml_accent
xml_accents
) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw(
);
$VERSION = '6.7';
my %defaults = (
'ENABLE_ENCODING' => 1,
'OUTFILE' => undef,
'SUBDIR' => undef,
'documentlanguage' => undef,
);
# defaults for all converters. Maybe more could be added, especially what
# can be set with --set and should be the same for all the formats.
our %all_converters_defaults = (
'language_config_dirs' => undef,
'output_format' => undef,
'SPLIT_SIZE' => 300000,
'TOP_NODE_UP' => '(dir)', # up node of Top node default value
'paragraphindent' => 3,
'fillcolumn' => 72,
'expanded_formats' => undef,
'include_directories' => undef,
'IMAGE_LINK_PREFIX' => undef,
'NUMBER_SECTIONS' => 1,
'NUMBER_FOOTNOTES' => 1,
'frenchspacing' => 'off',
'paragraphindent' => 3,
'firstparagraphindent' => 'none',
'allowcodebreaks' => 'true',
'footnotestyle' => 'end',
'deftypefnnewline' => 'off',
'BASEFILENAME_LENGTH' => 255 - 10,
# This is the default, mainly for tests; the caller should set them. These
# values are what is used in tests of the Converters.
'PACKAGE_AND_VERSION' => 'texinfo',
'PACKAGE_VERSION' => '',
'PACKAGE_URL' => 'http://www.gnu.org/software/texinfo/',
'PROGRAM' => '',
'DEBUG' => 0,
'TEST' => 0,
'translated_commands' => {'error' => 'error@arrow{}',},
);
# For translation of in document string.
if (0) {
my $self;
$self->gdt('error@arrow{}');
}
sub converter_defaults($$)
{
return %defaults;
}
sub converter_initialize($)
{
}
sub converter_global_commands($)
{
return ('documentlanguage', 'documentencoding');
}
sub output_internal_links($)
{
my $self = shift;
return undef;
}
sub _informative_command_value($$)
{
my $self = shift;
my $root = shift;
my $cmdname = $root->{'cmdname'};
if ($Texinfo::Common::misc_commands{$cmdname} eq 'skipline') {
return 1;
} elsif (exists($root->{'extra'}->{'text_arg'})) {
return $root->{'extra'}->{'text_arg'};
} elsif ($root->{'extra'} and $root->{'extra'}->{'misc_args'}
and exists($root->{'extra'}->{'misc_args'}->[0])) {
return $root->{'extra'}->{'misc_args'}->[0];
}
return undef;
}
# FIXME documentencoding handling is not reverted by resetting
# a value with set_conf, so _unset_global_multiple_commands won't
# reverse what _set_global_multiple_commands did through
# _informative_command.
sub _informative_command($$)
{
my $self = shift;
my $root = shift;
my $cmdname = $root->{'cmdname'};
$cmdname = 'shortcontents' if ($cmdname eq 'summarycontents');
return if ($self->{'set'}->{$cmdname});
my $value = $self->_informative_command_value($root);
if (defined($value)) {
$self->set_conf($cmdname, $value);
}
}
sub register_close_file($$)
{
my $self = shift;
my $filename = shift;
if ($self->{'unclosed_files'}->{$filename}) {
delete $self->{'unclosed_files'}->{$filename};
} else {
cluck "$filename not opened\n";
}
}
sub converter(;$)
{
my $class = shift;
my $converter = { 'set' => {} };
my $conf;
my $name = 'converter';
if (ref($class) eq 'HASH') {
$conf = $class;
bless $converter;
} elsif (defined($class)) {
bless $converter, $class;
$name = ref($converter);
$conf = shift;
} else {
bless $converter;
$conf = shift;
$name = ref($converter);
}
my %defaults = $converter->converter_defaults($conf);
foreach my $key (keys(%all_converters_defaults)) {
$defaults{$key} = $all_converters_defaults{$key}
if (!exists($defaults{$key}));
}
foreach my $key (keys(%defaults)) {
if (Texinfo::Common::valid_option($key)) {
$converter->{'conf'}->{$key} = $defaults{$key};
} else {
$converter->{$key} = $defaults{$key};
}
}
$converter->{'conf_default'} = \%defaults;
if (defined($conf)) {
if ($conf->{'parser'}) {
$converter->{'parser'} = $conf->{'parser'};
$converter->{'extra'}
= $converter->{'parser'}->global_commands_information();
$converter->{'info'} = $converter->{'parser'}->global_informations();
my $floats = $converter->{'parser'}->floats_information();
my $labels = $converter->{'parser'}->labels_information();
$converter->{'structuring'} = $converter->{'parser'}->{'structuring'};
$converter->{'floats'} = $floats if ($floats);
$converter->{'labels'} = $labels if ($labels);
foreach my $global_command ($converter->converter_global_commands()) {
if (defined($converter->{'extra'}->{$global_command})) {
my $root = $converter->{'extra'}->{$global_command};
# always set unique commands
if (ref($root) ne 'ARRAY') {
$converter->_informative_command($root);
}
}
}
delete $conf->{'parser'};
}
foreach my $key (keys(%$conf)) {
if (Texinfo::Common::valid_option($key)) {
$converter->{'conf'}->{$key} = $conf->{$key};
} elsif (!exists($defaults{$key})) {
warn "$key not a possible configuration in $name\n";
} else {
$converter->{$key} = $conf->{$key};
}
$converter->{'set'}->{$key} = 1;
}
}
$converter->set_conf('OUTPUT_ENCODING_NAME',
$converter->{'info'}->{'input_encoding_name'})
if ($converter->{'info'}->{'input_encoding_name'});
if (!$converter->get_conf('OUTPUT_PERL_ENCODING')
and $converter->get_conf('OUTPUT_ENCODING_NAME')) {
my $perl_encoding
= Encode::resolve_alias($converter->get_conf('OUTPUT_ENCODING_NAME'));
if ($perl_encoding) {
$converter->set_conf('OUTPUT_PERL_ENCODING', $perl_encoding);
}
}
if (!defined($converter->{'expanded_formats'})) {
if ($converter->{'parser'}) {
$converter->{'expanded_formats'} = $converter->{'parser'}->{'expanded_formats'};
} else {
$converter->{'expanded_formats'} = [];
}
}
if (!defined($converter->{'include_directories'})) {
if ($converter->{'parser'}) {
$converter->{'include_directories'} = $converter->{'parser'}->{'include_directories'};
} else {
$converter->{'include_directories'} = [ '.' ];
}
}
# turn the array to a hash for speed. Not sure it really matters for such
# a small array.
foreach my $expanded_format(@{$converter->{'expanded_formats'}}) {
$converter->{'expanded_formats_hash'}->{$expanded_format} = 1;
}
require Texinfo::Report;
# 'require' here instead of 'use' at top of file to cut down run time of
# 'texi2any --help'
$converter->Texinfo::Report::new();
$converter->converter_initialize();
return $converter;
}
sub converter_unclosed_files($)
{
my $self = shift;
return $self->{'unclosed_files'};
}
sub converter_opened_files($)
{
my $self = shift;
if (defined($self->{'opened_files'})) {
return @{$self->{'opened_files'}};
} else {
return ();
}
}
sub _set_global_multiple_commands($;$)
{
my $self = shift;
my $multiple_commands_index = shift;
$multiple_commands_index = 0 if (!defined($multiple_commands_index));
foreach my $global_command ($self->converter_global_commands()) {
if (defined($self->{'extra'}->{$global_command})
and ref($self->{'extra'}->{$global_command}) eq 'ARRAY') {
my $root = $self->{'extra'}->{$global_command}->[$multiple_commands_index];
if ($self->get_conf('DEBUG')) {
print STDERR "SET_global_multiple_commands($multiple_commands_index) $global_command\n";
}
$self->_informative_command($root);
}
}
}
# Notice that set_conf is used, which means that it is not possible to
# customize what is done for those commands. For documentencoding, for
# example the values are not reset correctly, see the FIXME above.
sub _unset_global_multiple_commands($)
{
my $self = shift;
foreach my $global_command ($self->converter_global_commands()) {
if (defined($self->{'extra'}->{$global_command})
and ref($self->{'extra'}->{$global_command}) eq 'ARRAY') {
if (exists($self->{'conf_default'}->{$global_command})) {
if ($self->get_conf('DEBUG')) {
my $default = 'UNDEF';
$default = $self->{'conf_default'}->{$global_command}
if (defined($self->{'conf_default'}->{$global_command}));
my $set = 0;
$set = 1 if ($self->{'set'}->{$global_command});
print STDERR "UNSET_global_multiple_commands $global_command ($set): $default\n";
}
if (Texinfo::Common::valid_option($global_command)) {
$self->set_conf($global_command, $self->{'conf_default'}->{$global_command});
} else {
$self->{$global_command} = $self->{'conf_default'}->{$global_command};
}
}
}
}
}
use Carp;
sub get_conf($$)
{
my $self = shift;
my $conf = shift;
if (!Texinfo::Common::valid_option($conf)) {
cluck "CBUG: unknown option $conf\n";
die;
return undef;
}
return $self->{'conf'}->{$conf};
}
sub set_conf($$$)
{
my $self = shift;
my $conf = shift;
my $value = shift;
if (!Texinfo::Common::valid_option($conf)) {
die "BBUG: unknown option $conf\n";
return undef;
}
if ($self->{'set'}->{$conf}) {
return 0;
} else {
$self->{'conf'}->{$conf} = $value;
return 1;
}
}
sub force_conf($$$)
{
my $self = shift;
my $conf = shift;
my $value = shift;
if (!Texinfo::Common::valid_option($conf)) {
die "ABUG: unknown option $conf\n";
return undef;
}
$self->{'conf'}->{$conf} = $value;
return 1;
}
my $STDIN_DOCU_NAME = 'stdin';
sub _set_outfile($$$)
{
my $self = shift;
# determine input file base name
my $input_basename;
if (defined($self->{'info'}->{'input_file_name'})) {
my ($directories, $suffix);
($input_basename, $directories, $suffix)
= fileparse($self->{'info'}->{'input_file_name'});
} else {
# This could happen if called on a piece of texinfo
$input_basename = '';
}
$self->{'input_basename'} = $input_basename;
if ($input_basename eq '-') {
$input_basename = $STDIN_DOCU_NAME
} else {
$input_basename =~ s/\.te?x(i|info)?$//;
}
$self->{'input_basename_name'} = $input_basename;
my $setfilename;
if (defined($self->get_conf('setfilename'))) {
$setfilename = $self->get_conf('setfilename');
} elsif ($self->{'extra'} and $self->{'extra'}->{'setfilename'}
and $self->{'extra'}->{'setfilename'}->{'extra'}
and defined($self->{'extra'}->{'setfilename'}->{'extra'}->{'text_arg'})) {
$setfilename = $self->{'extra'}->{'setfilename'}->{'extra'}->{'text_arg'}
}
# PREFIX overrides both setfilename and the input file base name
if (defined($self->get_conf('PREFIX'))) {
$setfilename = undef;
$input_basename = $self->get_conf('PREFIX');
}
# the name of the document, which is more or less the basename, without
# extension
my $document_name;
# determine output file and output file name
my $outfile;
if (!defined($self->get_conf('OUTFILE'))) {
if (defined($setfilename) and !$self->get_conf('NO_USE_SETFILENAME')) {
$outfile = $setfilename;
$document_name = $setfilename;
$document_name =~ s/\.[^\.]*$//;
if (!$self->get_conf('USE_SETFILENAME_EXTENSION')) {
$outfile =~ s/\.[^\.]*$//;
$outfile .= '.'.$self->get_conf('EXTENSION')
if (defined($self->get_conf('EXTENSION'))
and $self->get_conf('EXTENSION') ne '');
}
} elsif ($input_basename ne '') {
$outfile = $input_basename;
$document_name = $input_basename;
$outfile .= '.'.$self->get_conf('EXTENSION')
if (defined($self->get_conf('EXTENSION'))
and $self->get_conf('EXTENSION') ne '');
} else {
$outfile = '';
$document_name = $outfile;
}
if (defined($self->get_conf('SUBDIR')) and $outfile ne '') {
my $dir = File::Spec->canonpath($self->get_conf('SUBDIR'));
$outfile = File::Spec->catfile($dir, $outfile);
}
#$self->set_conf('OUTFILE', $outfile);
} else {
$document_name = $self->get_conf('OUTFILE');
$document_name =~ s/\.[^\.]*$//;
$outfile = $self->get_conf('OUTFILE');
}
# the output file without directories part.
my $output_filename = $outfile;
# this is a case that should happen rarely: one wants to get
# the result in a string and there is a setfilename.
if ($outfile eq '' and defined($setfilename)
and !$self->get_conf('NO_USE_SETFILENAME')) {
$output_filename = $setfilename;
$document_name = $setfilename;
$document_name =~ s/\.[^\.]*$//;
}
my ($directories, $suffix);
# We may be handling setfilename there, so it is not obvious that we
# want to use fileparse and not consider unixish separators. However,
# if this is setfilename, it should be a simple file name, so it
# should hopefully be harmless to use fileparse
($document_name, $directories, $suffix) = fileparse($document_name);
$self->{'document_name'} = $document_name;
($output_filename, $directories, $suffix) = fileparse($output_filename);
$self->{'output_filename'} = $output_filename;
if ($self->get_conf('SPLIT')) {
if (defined($self->get_conf('OUTFILE'))) {
$self->{'destination_directory'} = $self->get_conf('OUTFILE');
} elsif (defined($self->get_conf('SUBDIR'))) {
$self->{'destination_directory'} = $self->get_conf('SUBDIR');
} else {
$self->{'destination_directory'} = $document_name;
}
} else {
my ($out_filename, $output_dir, $suffix) = fileparse($outfile);
if ($output_dir ne '') {
$self->{'destination_directory'} = $output_dir;
}
}
if (defined($self->{'destination_directory'})
and $self->{'destination_directory'} ne '') {
$self->{'destination_directory'}
= File::Spec->canonpath($self->{'destination_directory'});
}
$self->{'output_file'} = $outfile;
}
sub _id_to_filename($$)
{
my $self = shift;
my $id = shift;
return substr($id, 0, $self->get_conf('BASEFILENAME_LENGTH'));
}
sub _sectioning_command_normalized_filename($$)
{
my $self = shift;
my $command = shift;
my $no_unidecode;
$no_unidecode = 1 if (defined($self->get_conf('USE_UNIDECODE'))
and !$self->get_conf('USE_UNIDECODE'));
my $normalized_name = Texinfo::Convert::NodeNameNormalization::transliterate_texinfo(
{'contents' => $command->{'args'}->[0]->{'contents'}},
$no_unidecode);
my $filename = $self->_id_to_filename($normalized_name);
$filename .= '.'.$self->get_conf('EXTENSION')
if (defined($self->get_conf('EXTENSION'))
and $self->get_conf('EXTENSION') ne '');
return ($normalized_name, $filename);
}
sub _node_filename($$)
{
my $self = shift;
my $node_info = shift;
my $no_unidecode;
$no_unidecode = 1 if (defined($self->get_conf('USE_UNIDECODE'))
and !$self->get_conf('USE_UNIDECODE'));
my $filename;
if (defined($node_info->{'normalized'})) {
if ($self->get_conf('TRANSLITERATE_FILE_NAMES')) {
$filename = Texinfo::Convert::NodeNameNormalization::transliterate_texinfo(
{'contents' => $node_info->{'node_content'}},
$no_unidecode);
} else {
$filename = $node_info->{'normalized'};
}
} elsif (defined($node_info->{'node_content'})) {
$filename = Texinfo::Convert::NodeNameNormalization::normalize_node (
{ 'contents' => $node_info->{'node_content'} });
} else {
$filename = '';
}
$filename = $self->_id_to_filename($filename);
return $filename;
}
sub _set_element_file($$$)
{
my $self = shift;
my $element = shift;
my $filename = shift;
if (!defined($filename)) {
cluck("_set_element_file: filename not defined\n");
}
if ($self->get_conf('CASE_INSENSITIVE_FILENAMES')) {
if (exists($self->{'filenames'}->{lc($filename)})) {
if ($self->get_conf('DEBUG')) {
print STDERR "Reusing ".$self->{'filenames'}->{lc($filename)}
." for $filename\n";
}
$filename = $self->{'filenames'}->{lc($filename)};
} else {
$self->{'filenames'}->{lc($filename)} = $filename;
}
}
$element->{'filename'} = $filename;
if (defined($self->{'destination_directory'})
and $self->{'destination_directory'} ne '') {
$element->{'out_filename'} =
File::Spec->catfile($self->{'destination_directory'}, $filename);
} else {
$element->{'out_filename'} = $filename;
}
}
sub _top_node_filename($)
{
my $self = shift;
my $top_node_filename;
if (defined($self->get_conf('TOP_FILE'))
and $self->get_conf('TOP_FILE') ne '') {
$top_node_filename = $self->get_conf('TOP_FILE');
} else {
my $extension = '';
$extension = '.'.$self->get_conf('EXTENSION')
if (defined($self->get_conf('EXTENSION'))
and $self->get_conf('EXTENSION') ne '');
$top_node_filename = $self->{'document_name'};
if (defined($top_node_filename)) {
$top_node_filename .= $extension;
}
}
return $top_node_filename;
}
sub _get_element($$)
{
my $self = shift;
my $command = shift;
my $find_container = shift;
my $current = $command;
while (1) {
if ($current->{'type'}) {
if ($current->{'type'} eq 'element') {
return $current;
}
}
if ($current->{'parent'}) {
$current = $current->{'parent'};
} else {
return undef;
}
}
}
sub _set_pages_files($$)
{
my $self = shift;
my $elements = shift;
# Ensure that the document has pages
return undef if (!defined($elements) or !@$elements);
my $extension = '';
$extension = '.'.$self->get_conf('EXTENSION')
if (defined($self->get_conf('EXTENSION'))
and $self->get_conf('EXTENSION') ne '');
if (!$self->get_conf('SPLIT')) {
foreach my $element (@$elements) {
if (!defined($element->{'filename'})) {
$element->{'filename'} = $self->{'output_filename'};
$element->{'out_filename'} = $self->{'output_file'};
}
}
} else {
my $node_top;
#my $section_top;
$node_top = $self->{'labels'}->{'Top'} if ($self->{'labels'});
#$section_top = $self->{'extra'}->{'top'} if ($self->{'extra'});
my $top_node_filename = $self->_top_node_filename();
# first determine the top node file name.
if ($node_top and defined($top_node_filename)) {
my ($node_top_element) = $self->_get_element($node_top);
die "BUG: No element for top node" if (!defined($node_top));
$self->_set_element_file($node_top_element, $top_node_filename);
}
my $file_nr = 0;
my $previous_page;
foreach my $element(@$elements) {
# For Top node.
next if (defined($element->{'filename'}));
if (!$element->{'extra'}->{'first_in_page'}) {
cluck ("No first_in_page for $element\n");
}
if (!defined($element->{'extra'}->{'first_in_page'}->{'filename'})) {
my $file_element = $element->{'extra'}->{'first_in_page'};
foreach my $root_command (@{$file_element->{'contents'}}) {
if ($root_command->{'cmdname'}
and $root_command->{'cmdname'} eq 'node') {
my $node_filename;
# double node are not normalized, they are handled here
if (!defined($root_command->{'extra'}->{'normalized'})
or !defined($self->{'labels'}->{$root_command->{'extra'}->{'normalized'}})) {
$node_filename = 'unknown_node';
} else {
$node_filename = $self->_node_filename($root_command->{'extra'});
}
$node_filename .= $extension;
$self->_set_element_file($file_element, $node_filename);
last;
}
}
if (!defined($file_element->{'filename'})) {
# use section to do the file name if there is no node
my $command = $self->element_command($file_element);
if ($command) {
if ($command->{'cmdname'} eq 'top' and !$node_top
and defined($top_node_filename)) {
$self->_set_element_file($file_element, $top_node_filename);
} else {
my ($normalized_name, $filename)
= $self->_sectioning_command_normalized_filename($command);
$self->_set_element_file($file_element, $filename)
}
} else {
# when everything else has failed
if ($file_nr == 0 and !$node_top
and defined($top_node_filename)) {
$self->_set_element_file($file_element, $top_node_filename);
} else {
my $filename = $self->{'document_name'} . "_$file_nr";
$filename .= $extension;
$self->_set_element_file($element, $filename);
}
$file_nr++;
}
}
}
$element->{'filename'}
= $element->{'extra'}->{'first_in_page'}->{'filename'};
$element->{'out_filename'}
= $element->{'extra'}->{'first_in_page'}->{'out_filename'};
}
}
foreach my $element (@$elements) {
$self->{'file_counters'}->{$element->{'filename'}}++;
print STDERR "Page $element ".Texinfo::Structuring::_print_element_command_texi($element).": $element->{'filename'}($self->{'file_counters'}->{$element->{'filename'}})\n"
if ($self->get_conf('DEBUG'));
}
}
sub output($$)
{
my $self = shift;
my $root = shift;
my $elements;
if (defined($self->get_conf('OUTFILE'))
and ($Texinfo::Common::null_device_file{$self->get_conf('OUTFILE')}
or $self->get_conf('OUTFILE') eq '-'
or $self->get_conf('OUTFILE') eq '')) {
if ($self->get_conf('SPLIT')) {
$self->document_warn(sprintf(__("%s: output incompatible with split"),
$self->get_conf('OUTFILE')));
$self->force_conf('SPLIT', 0);
}
}
if ($self->get_conf('SPLIT')) {
$self->set_conf('NODE_FILES', 1);
}
$self->_set_outfile();
return undef unless $self->_create_destination_directory();
# do that now to have it available for formatting
# NOTE this calls Convert::Converter::_informative_command on all the
# @informative_global commands.
# Thus sets among others language and encodings.
$self->_set_global_multiple_commands(-1);
if ($self->get_conf('USE_NODES')) {
$elements = Texinfo::Structuring::split_by_node($root);
} else {
$elements = Texinfo::Structuring::split_by_section($root);
}
Texinfo::Structuring::split_pages($elements, $self->get_conf('SPLIT'));
# determine file names associated with the different pages
if ($self->{'output_file'} ne '') {
$self->_set_pages_files($elements);
}
#print STDERR "$elements $elements->[0]->{'filename'}\n";
# Now do the output
my $fh;
my $output = '';
if (!$elements or !defined($elements->[0]->{'filename'})) {
# no page
my $outfile;
if ($self->{'output_file'} ne '') {
if ($self->get_conf('SPLIT')) {
$outfile = $self->_top_node_filename();
if (defined($self->{'destination_directory'})
and $self->{'destination_directory'} ne '') {
$outfile = File::Spec->catfile($self->{'destination_directory'},
$outfile);
}
} else {
$outfile = $self->{'output_file'};
}
print STDERR "DO No pages, output in $outfile\n"
if ($self->get_conf('DEBUG'));
$fh = $self->Texinfo::Common::open_out($outfile);
if (!$fh) {
$self->document_error(sprintf(__("could not open %s for writing: %s"),
$outfile, $!));
return undef;
}
} else {
print STDERR "DO No pages, string output\n"
if ($self->get_conf('DEBUG'));
}
if ($elements and @$elements) {
foreach my $element (@$elements) {
my $element_text = $self->convert_tree($element);
$output .= $self->_output_text($element_text, $fh);
}
} else {
$output .= $self->_output_text($self->convert($root), $fh);
}
# NOTE do not close STDOUT now to avoid a perl warning.
if ($fh and $outfile ne '-') {
$self->register_close_file($outfile);
if (!close($fh)) {
$self->document_error(sprintf(__("error on closing %s: %s"),
$outfile, $!));
}
}
return $output if ($self->{'output_file'} eq '');
} else {
# output with pages
print STDERR "DO Elements with filenames\n"
if ($self->get_conf('DEBUG'));
my %files;
foreach my $element (@$elements) {
my $file_fh;
# open the file and output the elements
if (!$files{$element->{'filename'}}->{'fh'}) {
$file_fh = $self->Texinfo::Common::open_out($element->{'out_filename'});
if (!$file_fh) {
$self->document_error(sprintf(__("could not open %s for writing: %s"),
$element->{'out_filename'}, $!));
return undef;
}
$files{$element->{'filename'}}->{'fh'} = $file_fh;
} else {
$file_fh = $files{$element->{'filename'}}->{'fh'};
}
my $element_text = $self->convert_tree($element);
print $file_fh $element_text;
$self->{'file_counters'}->{$element->{'filename'}}--;
if ($self->{'file_counters'}->{$element->{'filename'}} == 0) {
# NOTE do not close STDOUT here to avoid a perl warning
if ($element->{'out_filename'} ne '-') {
$self->register_close_file($element->{'out_filename'});
if (!close($file_fh)) {
$self->document_error(sprintf(__("error on closing %s: %s"),
$element->{'out_filename'}, $!));
return undef;
}
}
}
}
}
}
sub _bug_message($$;$)
{
my $self = shift;
my $message = shift;
my $current = shift;
my $line_message = '';
my $current_element_message = '';
if ($current) {
if ($current->{'line_nr'}) {
my $line_number = $current->{'line_nr'};
my $file = $line_number->{'file_name'};
$line_message
= "in: $line_number->{'file_name'}:$line_number->{'line_nr'}";
if ($line_number->{'macro'} ne '') {
$line_message .= " (possibly involving $line_number->{'macro'})";
}
$line_message .= "\n";
}
if ($current) {
$current_element_message = "current: ".
Texinfo::Common::_print_current($current);
}
}
my $additional_information = '';
if ($line_message.$current_element_message ne '') {
$additional_information = "Additional informations:\n".
$line_message.$current_element_message;
}
warn "You found a bug: $message\n\n".$additional_information;
}
# This is not used as code, but used to mark months as strings to be
# translated
if (0) {
my $self;
my @mark_month_for_translation = (
$self->gdt('January'),
$self->gdt('February'),
$self->gdt('March'),
$self->gdt('April'),
$self->gdt('May'),
$self->gdt('June'),
$self->gdt('July'),
$self->gdt('August'),
$self->gdt('September'),
$self->gdt('October'),
$self->gdt('November'),
$self->gdt('December')
);
}
sub _create_destination_directory($)
{
my $self = shift;
if (defined($self->{'destination_directory'})
and ! -d $self->{'destination_directory'}) {
if (!mkdir($self->{'destination_directory'}, oct(755))) {
if ($self->get_conf('SPLIT')
and $self->get_conf('EXTENSION')
and $self->get_conf('EXTENSION') ne '') {
my ($volume, $directories, $file)
= File::Spec->splitpath($self->{'destination_directory'}, 1);
my $new_directory = File::Spec->catpath($volume,
$directories . '.' . $self->get_conf('EXTENSION'), $file);
if (! -d $new_directory) {
if (!mkdir($new_directory, oct(755))) {
$self->document_error(sprintf(__(
"could not create directories `%s' or `%s': %s"),
$self->{'destination_directory'}, $new_directory, $!));
return undef;
}
}
$self->{'destination_directory'} = $new_directory;
} else {
$self->document_error(sprintf(__(
"could not create directory `%s': %s"),
$self->{'destination_directory'}, $!));
return undef;
}
}
}
return 1;
}
sub _float_type_number($$)
{
my $self = shift;
my $float = shift;
my $type;
if ($float->{'extra'}->{'type'}
and $float->{'extra'}->{'type'}->{'normalized'} ne '') {
$type = {'contents' => $float->{'extra'}->{'type'}->{'content'}};
}
my $tree;
if ($type) {
if (defined($float->{'number'})) {
$tree = $self->gdt("{float_type} {float_number}",
{'float_type' => $type,
'float_number' => $float->{'number'}});
} else {
$tree = $self->gdt("{float_type}",
{'float_type' => $type});
}
} elsif (defined($float->{'number'})) {
$tree = $self->gdt("{float_number}",
{'float_number' => $float->{'number'}});
}
return $tree;
}
# This is used when the formatted text has no comment nor new line, but
# one want to add the comment or new line from the original arg
sub _end_line_or_comment($$)
{
my $self = shift;
my $root = shift;
my $end_line;
my $comment = $root->{'args'}->[-1]->{'extra'}->{'comment_at_end'}
if $root->{'args'}->[-1]->{'extra'};
if ($comment) {
$end_line = $self->convert_tree($comment);
} elsif ($root->{'args'}->[-1]->{'extra'}
and $root->{'args'}->[-1]->{'extra'}->{'spaces_after_argument'}) {
my $text = $root->{'args'}->[-1]->{'extra'}->{'spaces_after_argument'};
if (chomp($text)) {
$end_line = "\n";
} else {
$end_line = '';
}
} else {
$end_line = '';
}
return $end_line;
}
sub _collect_leading_trailing_spaces_arg($$)
{
my $self = shift;
my $arg = shift;
#print STDERR "$arg->{'type'}: @{$arg->{'contents'}}\n";
my @result;
if ($arg->{'extra'} and
$arg->{'extra'}->{'spaces_before_argument'}) {
$result[0] = $arg->{'extra'}->{'spaces_before_argument'};
} elsif ($arg->{'contents'} and $arg->{'contents'}->[0]
and defined($arg->{'contents'}->[0]->{'text'})
and $arg->{'contents'}->[0]->{'text'} !~ /\S/
and defined($arg->{'contents'}->[0]->{'type'})) {
#print STDERR "$arg->{'contents'}->[0]->{'type'}\n";
warn "Unknown leading space type $arg->{'contents'}->[0]->{'type'}\n"
if ($arg->{'contents'}->[0]->{'type'} ne 'empty_spaces_after_command'
and $arg->{'contents'}->[0]->{'type'} ne 'empty_spaces_before_argument'
# FIXME should we really catch this too?
and $arg->{'contents'}->[0]->{'type'} ne 'empty_line_after_command'
);
$result[0] = $arg->{'contents'}->[0]->{'text'};
return @result if (scalar(@{$arg->{'contents'}}) == 1);
}
if ($arg->{'extra'} and
$arg->{'extra'}->{'spaces_after_argument'}) {
$result[1] = $arg->{'extra'}->{'spaces_after_argument'};
} elsif ($arg->{'contents'}) {
my $index = -1;
$index-- if ($arg->{'contents'}->[-1]
and $arg->{'contents'}->[-1]->{'cmdname'}
and ($arg->{'contents'}->[-1]->{'cmdname'} eq 'c'
or $arg->{'contents'}->[-1]->{'cmdname'} eq 'comment'));
if (scalar(@{$arg->{'contents'}}) + $index > 0) {
if ($arg->{'contents'}->[$index]
and defined($arg->{'contents'}->[$index]->{'text'})
and $arg->{'contents'}->[$index]->{'text'} !~ /\S/
and defined($arg->{'contents'}->[$index]->{'type'})) {
#print STDERR "$arg->{'contents'}->[$index]->{'type'}\n";
warn "Unknown trailing space type $arg->{'contents'}->[$index]->{'type'}\n"
if ($arg->{'contents'}->[$index]->{'type'} ne 'spaces_at_end'
and $arg->{'contents'}->[$index]->{'type'} ne 'space_at_end_block_command'
);
$result[1] = $arg->{'contents'}->[$index]->{'text'};
}
}
}
return @result;
}
sub _table_item_content_tree($$$)
{
my $self = shift;
my $root = shift;
my $contents = shift;
my $converted_tree = {'parent' => $root};
my $table_command = $root->{'parent'}->{'parent'}->{'parent'};
if ($table_command->{'extra'}
and $table_command->{'extra'}->{'command_as_argument'}) {
my $command_as_argument
= $table_command->{'extra'}->{'command_as_argument'};
my $command = {'cmdname' => $command_as_argument->{'cmdname'},
'line_nr' => $root->{'line_nr'},
'parent' => $converted_tree };
if ($command_as_argument->{'type'} eq 'definfoenclose_command') {
$command->{'type'} = $command_as_argument->{'type'};
$command->{'extra'}->{'begin'} = $command_as_argument->{'extra'}->{'begin'};
$command->{'extra'}->{'end'} = $command_as_argument->{'extra'}->{'end'};
}
my $arg = {'type' => 'brace_command_arg',
'contents' => $contents,
'parent' => $command,};
$command->{'args'} = [$arg];
$contents = [$command];
}
$converted_tree->{'contents'} = $contents;
return $converted_tree;
}
sub _level_corrected_section($$)
{
my $self = shift;
my $root = shift;
my $heading_level = $root->{'level'};
my $command;
if ($heading_level ne $Texinfo::Common::command_structuring_level{$root->{'cmdname'}}) {
$command
= $Texinfo::Common::level_to_structuring_command{$root->{'cmdname'}}->[$heading_level];
} else {
$command = $root->{'cmdname'};
}
return $command;
}
# generic output method
sub output_no_split($$)
{
my $self = shift;
my $root = shift;
$self->_set_outfile();
return undef unless $self->_create_destination_directory();
my $fh;
if (! $self->{'output_file'} eq '') {
$fh = $self->Texinfo::Common::open_out($self->{'output_file'});
if (!$fh) {
$self->document_error(sprintf(__("could not open %s for writing: %s"),
$self->{'output_file'}, $!));
return undef;
}
}
$self->_set_global_multiple_commands(-1);
if ($self->get_conf('USE_NODES')) {
return $self->convert_document_nodes($root, $fh);
} else {
return $self->convert_document_sections($root, $fh);
}
}
# output fo $fh if defined, otherwise return the text.
sub _output_text($$$)
{
my $self = shift;
my $text = shift;
my $fh = shift;
if ($fh) {
print $fh $text;
return '';
} else {
return $text;
}
}
sub _convert_document_elements($$;$$)
{
my $self = shift;
my $root = shift;
my $elements = shift;
my $fh = shift;
if ($elements) {
my $result = '';
foreach my $element (@$elements) {
$result .= $self->_output_text($self->convert_tree($element), $fh);
}
return $result;
} else {
return $self->_output_text($self->convert_tree($root), $fh);
}
}
sub convert_document_sections($$;$)
{
my $self = shift;
my $root = shift;
my $fh = shift;
my $elements = Texinfo::Structuring::split_by_section($root);
return $self->_convert_document_elements($root, $elements, $fh);
}
sub convert_document_nodes($$;$)
{
my $self = shift;
my $root = shift;
my $fh = shift;
my $elements = Texinfo::Structuring::split_by_node($root);
return $self->_convert_document_elements($root, $elements, $fh);
}
# if in this container, we are 'inline', within a running text
my @inline_types = ('def_line', 'paragraph', 'preformatted',
'line_arg', 'block_line_arg', 'menu_entry_name', 'menu_entry_node');
my %inline_types;
foreach my $type (@inline_types) {
$inline_types{$type} = 1;
}
my %not_inline_commands = (%Texinfo::Common::root_commands,
%Texinfo::Common::block_commands, %Texinfo::Common::context_brace_command);
# Return 1 if inline in a running text, 0 if right in top-level or block
# environment, and undef otherwise.
sub _inline_or_block($$)
{
my $self = shift;
my $current = shift;
if ($current->{'type'} and $inline_types{$current->{'type'}}) {
return 1;
} elsif ($current->{'cmdname'}
and exists($not_inline_commands{$current->{'cmdname'}})) {
return 0;
} else {
return undef;
}
}
# return true if in running text context
sub _is_inline($$)
{
my $self = shift;
my $current = shift;
while ($current->{'parent'}) {
$current = $current->{'parent'};
my $inline_or_block = $self->_inline_or_block($current);
return ($inline_or_block) if (defined($inline_or_block));
}
return 0;
}
# return true if container or parent may hold running text
sub _in_inline($$)
{
my $self = shift;
my $current = shift;
my $inline_or_block = $self->_inline_or_block($current);
return ($inline_or_block) if (defined($inline_or_block));
return $self->_is_inline($current);
}
our %default_args_code_style = (
'email' => [1],
'anchor' => [1],
'uref' => [1],
'url' => [1],
'math' => [1],
'inforef' => [1,undef,1],
'image' => [1, 1, 1, undef, 1],
# and type?
'float' => [1],
);
foreach my $code_style_command (keys(%Texinfo::Common::code_style_commands)) {
$default_args_code_style{$code_style_command} = [1];
}
foreach my $ref_cmd ('pxref', 'xref', 'ref') {
$default_args_code_style{$ref_cmd} = [1, undef, undef, 1];
}
sub convert_accents($$$;$)
{
my $self = shift;
my $accent = shift;
my $format_accents = shift;
my $in_upper_case = shift;
my ($contents, $stack)
= Texinfo::Common::find_innermost_accent_contents($accent);
my $result = $self->convert_tree({'contents' => $contents});
my $encoded;
if ($self->get_conf('ENABLE_ENCODING')) {
$encoded = Texinfo::Convert::Unicode::encoded_accents($self, $result, $stack,
$self->get_conf('OUTPUT_ENCODING_NAME'),
$format_accents,
$in_upper_case);
}
if (!defined($encoded)) {
foreach my $accent_command (reverse(@$stack)) {
$result = &$format_accents ($self, $result, $accent_command,
$in_upper_case);
}
return $result;
} else {
return $encoded;
}
}
# This method allows to count words in elements and returns an array
# and a text already formatted.
sub sort_element_counts($$;$$)
{
my $converter = shift;
my $tree = shift;
my $use_sections = shift;
my $count_words = shift;
my $elements;
if ($use_sections) {
$elements = Texinfo::Structuring::split_by_section($tree);
} else {
$elements = Texinfo::Structuring::split_by_node($tree);
}
if (!$elements) {
@$elements = ($tree);
} elsif (scalar(@$elements) >= 1
and (!$elements->[0]->{'extra'}->{'node'}
and !$elements->[0]->{'extra'}->{'section'})) {
shift @$elements;
}
my $max_count = 0;
my @name_counts_array;
require Texinfo::Convert::Texinfo;
foreach my $element (@$elements) {
my $name = 'UNNAMED element';
if ($element->{'extra'}
and ($element->{'extra'}->{'node'} or $element->{'extra'}->{'section'})) {
my $command = $element->{'extra'}->{'element_command'};
if ($command->{'cmdname'} eq 'node') {
$name = Texinfo::Convert::Texinfo::convert({'contents'
=> $command->{'extra'}->{'nodes_manuals'}->[0]->{'node_content'}});
} else {
$name = "\@$command->{'cmdname'}"
.Texinfo::Convert::Texinfo::convert($command->{'args'}->[0]);
}
}
chomp($name);
my $count;
my $element_content = $converter->convert_tree($element);
if ($count_words) {
my @res = split /\W+/, $element_content;
$count = scalar(@res);
} else {
my @res = split /^/, $element_content;
$count = scalar(@res);
}
push @name_counts_array, [$count, $name];
if ($count > $max_count) {
$max_count = $count;
}
}
my @sorted_name_counts_array = sort {$a->[0] <=> $b->[0]} @name_counts_array;
@sorted_name_counts_array = reverse(@sorted_name_counts_array);
my $max_length = length($max_count);
my $result = '';
foreach my $sorted_count (@sorted_name_counts_array) {
$result .= sprintf("%${max_length}d $sorted_count->[1]\n", $sorted_count->[0]);
}
return (\@sorted_name_counts_array, $result);
}
# XML related methods and variables that may be used in different
# XML Converters.
sub xml_protect_text($$)
{
my $self = shift;
my $text = shift;
if (!defined($text)) {
cluck;
}
$text =~ s/&/&/g;
$text =~ s/</g;
$text =~ s/>/>/g;
$text =~ s/\"/"/g;
return $text;
}
# Add any index sub-entries specified with @subentry, separated by commas.
sub convert_index_subentries {
my ($self, $entry) = @_;
my $result = '';
my $tmp = $entry->{'command'};
while ($tmp->{'extra'} and $tmp->{'extra'}->{'subentry'}) {
$tmp = $tmp->{'extra'}->{'subentry'};
$result .= $self->_convert({'text' => ', '});
$result .= $self->_convert($tmp->{'args'}->[0]);
}
return $result;
}
# 'today' is not set here.
our %default_xml_commands_formatting;
$default_xml_commands_formatting{'normal'} = {
'TeX' => 'TeX',
'LaTeX' => 'LaTeX',
'bullet' => '•',
'copyright' => '©',
'registeredsymbol' => '®',
'dots' => '…',
'enddots' => '...',
'equiv' => '≡',
# in general the following is not used since error
# appears in 'translated_commands'
'error' => 'error-->',
'expansion' => '→',
'arrow' => '→',
'click' => '→',
'minus' => '-',
'point' => '∗',
'print' => '-|',
'result' => '⇒',
'aa' => 'å',
'AA' => 'Å',
'ae' => 'æ',
'oe' => 'œ', #pertusus: also . œ not in html 3.2
'AE' => 'Æ',
'OE' => 'Œ', #pertusus: also . Œ not in html 3.2
'o' => 'ø',
'O' => 'Ø',
'ss' => 'ß',
'DH' => 'Ð',
'dh' => 'ð',
'TH' => 'Þ',
'th' => 'þ',
'l' => 'ł',
'L' => 'Ł',
'exclamdown' => '¡',
'questiondown' => '¿',
'pounds' => '£',
'ordf' => 'ª',
'ordm' => 'º',
'comma' => ',',
'atchar' => '@',
'ampchar' => '&',
'lbracechar' => '{',
'rbracechar' => '}',
'backslashchar' => '\\',
'hashchar' => '#',
'euro' => '€',
'geq' => '≥',
'leq' => '≤',
'tie' => ' ',
'textdegree' => '°',
'quotedblleft' => '“',
'quotedblright' => '”',
'quoteleft' => '‘',
'quoteright' => '’',
'quotedblbase' => '„',
'quotesinglbase' => '‚',
'guillemetleft' => '«',
'guillemetright' => '»',
'guillemotleft' => '«',
'guillemotright' => '»',
'guilsinglleft' => '‹',
'guilsinglright' => '›',
};
foreach my $no_brace_command (keys(%Texinfo::Common::no_brace_commands)) {
$default_xml_commands_formatting{'normal'}->{$no_brace_command}
= $Texinfo::Common::no_brace_commands{$no_brace_command};
}
$default_xml_commands_formatting{'normal'}->{'&'} = '&';
sub xml_comment($$)
{
my $self = shift;
my $text = shift;
chomp $text;
$text =~ s/--+/-/go;
return '' . "\n";
}
our %xml_accent_entities = (
'"', 'uml',
'~', 'tilde',
'^', 'circ',
'`', 'grave',
"'", 'acute',
",", 'cedil',
'ringaccent', 'ring',
'ogonek', 'ogon',
);
my %xml_accent_text_with_entities = (
'ringaccent' => 'aA',
"'" => 'aeiouyAEIOUY',
',' => 'cC',
'^' => 'aeiouAEIOU',
'`' => 'aeiouAEIOU',
'~' => 'nNaoAO',
'"' => 'aeiouyAEIOU',
# according to http://www2.lib.virginia.edu/small/vhp/download/ISO.txt
# however this doesn't seems to work in firefox
# 'ogonek' => 'aeiuAEIU',
);
sub xml_accent($$$;$$)
{
my $self = shift;
my $text = shift;
my $command = shift;
my $in_upper_case = shift;
my $use_numeric_entities = shift;
my $accent = $command->{'cmdname'};
if ($in_upper_case and $text =~ /^\w$/) {
$text = uc ($text);
}
return "&${text}$xml_accent_entities{$accent};"
if (defined($xml_accent_entities{$accent})
and defined($xml_accent_text_with_entities{$accent})
and ($text =~ /^[$xml_accent_text_with_entities{$accent}]$/));
if ($use_numeric_entities
and exists($Texinfo::Convert::Unicode::unicode_accented_letters{$accent})
and exists($Texinfo::Convert::Unicode::unicode_accented_letters{$accent}->{$text})) {
return '' .
hex($Texinfo::Convert::Unicode::unicode_accented_letters{$accent}->{$text}). ';';
}
return $text . '<' if ($accent eq 'v');
# FIXME it is not possible to call xml_protect_text since what is in $text
# may already be xml. But this means that each time ascii_accent changes
# it should be changed here too.
return Texinfo::Convert::Text::ascii_accent($text, $command);
}
sub _xml_accent_numeric_entities($$;$)
{
my $self = shift;
my $text = shift;
my $command = shift;
my $in_upper_case = shift;
return $self->xml_accent($text, $command, $in_upper_case, 1);
}
sub xml_accents($$;$)
{
my $self = shift;
my $accent = shift;
my $in_upper_case = shift;
my $format_accents;
if ($self->get_conf('USE_NUMERIC_ENTITY')) {
$format_accents = \&_xml_accent_numeric_entities;
} else {
$format_accents = \&xml_accent;
}
return $self->convert_accents($accent, $format_accents, $in_upper_case);
}
1;
__END__
=head1 NAME
Texinfo::Convert::Converter - Parent class for Texinfo tree converters
=head1 SYNOPSIS
package Texinfo::Convert::MyConverter;
use Texinfo::Convert::Converter;
@ISA = qw(Texinfo::Convert::Converter);
sub converter_defaults ($$) {
return %myconverter_defaults;
}
sub converter_initialize($) {
my $self = shift;
$self->{'document_context'} = [{}];
}
sub converter_global_commands($) {
return ('documentlanguage', documentencoding', 'paragraphindent');
}
sub convert($$) {
...
}
sub convert_tree($$) {
...
}
sub output($$) {
...
}
# end of Texinfo::Convert::MyConverter
my $converter = Texinfo::Convert::MyConverter->converter(
{'parser' => $parser});
$converter->output($texinfo_tree);
=head1 DESCRIPTION
Texinfo::Convert::Converter is a super class that can be used to
simplify converters initialization. The class also provide some
useful methods.
In turn, the converter should define some methods. Three are
optional, C, C and
C and used for initialization, to
give C some informations.
The C method is more or less mandatory and should
convert portions of Texinfo tree. The C