| # Info.pm: output tree as Info. |
| # |
| # Copyright 2010, 2011, 2012, 2013, 2014, 2015 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::Convert::Plaintext; |
| use Texinfo::Convert::Text; |
| |
| require Exporter; |
| use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
| @ISA = qw(Texinfo::Convert::Plaintext); |
| |
| # Items to export into callers namespace by default. Note: do not export |
| # names by default without a very good reason. Use EXPORT_OK instead. |
| # Do not simply export all your public functions/methods/constants. |
| |
| # This allows declaration use Texinfo::Convert::Info ':all'; |
| # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK |
| # will save memory. |
| %EXPORT_TAGS = ( 'all' => [ qw( |
| convert |
| ) ] ); |
| |
| @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
| |
| @EXPORT = qw( |
| ); |
| |
| $VERSION = '6.1'; |
| |
| 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; |
| |
| 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 = $self->count_bytes($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($self->__("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($self->__("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 += $self->count_bytes($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($self->__("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($self->__("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($self->__("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($self->__("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'}->{'normalized'})); |
| my $prefix; |
| if ($label->{'root'}->{'cmdname'} eq 'node') { |
| $prefix = 'Node'; |
| } else { |
| if ($seen_anchors{$label->{'root'}->{'extra'}->{'normalized'}}) { |
| $self->line_error(sprintf($self->__("\@%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->{'root'}->{'extra'}->{'normalized'}} = $label; |
| } |
| $prefix = 'Ref'; |
| } |
| my ($label_text, $byte_count) = $self->_node_line($label->{'root'}); |
| $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($self->__("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( |
| $self->__("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 = $paragraph->add_text("This is "); |
| # This ensures that spaces in file are kept. |
| $result .= $paragraph->add_next($self->{'output_filename'}); |
| my $program = $self->get_conf('PROGRAM'); |
| my $version = $self->get_conf('PACKAGE_VERSION'); |
| if (defined($program) and $program ne '') { |
| $result .= $paragraph->add_text(", produced by $program version $version from "); |
| } else { |
| $result .= $paragraph->add_text(", produced from "); |
| } |
| $result .= $paragraph->add_next($self->{'input_basename'}); |
| $result .= $paragraph->add_text('.'); |
| $result .= $paragraph->end(); |
| $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->{'extra'} |
| and defined($command->{'extra'}->{'misc_content'})) { |
| my $dircategory = "INFO-DIR-SECTION ".$self->convert_line( |
| {'contents' => $command->{'extra'}->{'misc_content'}}); |
| $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($self->__("\@%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'}->{'normalized'})); |
| 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($self->__( |
| "\@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; |
| } |
| } |
| } |
| $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->{'extra'}->{'brace_command_contents'}->[0])) { |
| my $basefile = Texinfo::Convert::Text::convert( |
| {'contents' => $root->{'extra'}->{'brace_command_contents'}->[0]}, |
| {'code' => 1, Texinfo::Common::_convert_text_options($self)}); |
| if (defined($root->{'extra'}->{'brace_command_contents'}->[4])) { |
| my $extension = Texinfo::Convert::Text::convert( |
| {'contents' => $root->{'extra'}->{'brace_command_contents'}->[4]}, |
| {'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->{'extra'}->{'brace_command_contents'}->[3])) { |
| $alt = Texinfo::Convert::Text::convert( |
| {'contents' => $root->{'extra'}->{'brace_command_contents'}->[3]}, |
| {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->{'extra'}->{'brace_command_contents'}->[3])) { |
| $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> |
| |
| =head1 COPYRIGHT AND LICENSE |
| |
| Copyright 2015 Free Software Foundation, Inc. |
| |
| This library 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. |
| |
| =cut |
