File Manager

Editing File: /usr/share/texinfo/Texinfo/XS/parsetexi/Parsetexi.pm

# Copyright 2014-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 <http://www.gnu.org/licenses/>.

package Texinfo::Parser;

use Texinfo::XSLoader;

# same as texi2any.pl, although I don't know what the real requirement
# is for this module.
use 5.00405;
use strict;
use warnings;

require Exporter;

use Texinfo::Common;
use Texinfo::Encoding;
use Texinfo::Convert::NodeNameNormalization;
use Texinfo::Report;

our @ISA = qw(Exporter DynaLoader Texinfo::Report);
our %EXPORT_TAGS = ( 'all' => [ qw(
    parser
    parse_texi_text
    parse_texi_line
    parse_texi_file
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

sub get_conf($$)
{
  my $self = shift;
  my $var = shift;
  return $self->{$var};
}

my %parser_default_configuration =
  (%Texinfo::Common::default_parser_state_configuration,
   %Texinfo::Common::default_customization_values);

my %tree_informations;
foreach my $tree_information ('values', 'macros', 'explained_commands', 'labels') {
  $tree_informations{$tree_information} = 1;
}

use Storable qw(dclone); # standard in 5.007003

sub simple_parser {
  goto &parser;
}

# Stub for Texinfo::Parser::parser (line 574)
sub parser (;$$)
{
  my $conf = shift;

my $parser = dclone(\%parser_default_configuration);

reset_parser ();
  # fixme: these are overwritten immediately after
  if (defined($conf)) {
    foreach my $key (keys (%$conf)) {
      if ($key ne 'values' and ref($conf->{$key})) {
        $parser->{$key} = dclone($conf->{$key});
      } else {
        $parser->{$key} = $conf->{$key};
      }

if ($key eq 'include_directories') {
        foreach my $d (@{$conf->{'include_directories'}}) {
          add_include_directory ($d);
        }
      } elsif ($key eq 'values') {
	# This is used by Texinfo::Report::gdt for substituted values
	for my $v (keys %{$conf->{'values'}}) {
	  if (!ref($conf->{'values'}->{$v})) {
	    store_value ($v, $conf->{'values'}->{$v});
          } elsif (ref($conf->{'values'}->{$v}) eq 'HASH') {
            store_value ($v, "<<HASH VALUE>>");
	  } elsif (ref($conf->{'values'}->{$v}) eq 'ARRAY') {
	    store_value ($v, "<<ARRAY VALUE>>");
	  } else {
	    store_value ($v, "<<UNKNOWN VALUE>>");
	  }
	}
      } elsif ($key eq 'expanded_formats') {
        clear_expanded_formats ();

for my $f (@{$parser->{$key}}) {
          add_expanded_format ($f);
        }
      } elsif ($key eq 'documentlanguage') {
        if (defined ($conf->{$key})) {
          set_documentlanguage ($conf->{$key});
        }
      } elsif ($key eq 'SHOW_MENU') {
        conf_set_show_menu ($conf->{$key});
      } elsif ($key eq 'IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME') {
        conf_set_IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME ($conf->{$key});
      } elsif ($key eq 'CPP_LINE_DIRECTIVES') {
        conf_set_CPP_LINE_DIRECTIVES($conf->{$key});
      } else {
        #warn "ignoring parser configuration value \"$key\"\n";
      }
    }
  }

bless $parser;

$parser->Texinfo::Report::new;

return $parser;
}

# Record any @menu elements under $root in the 'menus' array of $node.
sub _find_menus_of_node {
  my $node = shift;
  my $root = shift;

if ($root->{'contents'}) {
    my $contents = $root->{'contents'};
    foreach my $child (@{$contents}) {
      if ($child->{'cmdname'} and $child->{'cmdname'} eq 'menu') {
        push @{$node->{'menus'}}, $child;
      }
    }
  }
}

# Set 'menus' array for each node.  This accounts for malformed input where
# the number of sectioning commands between @node and @menu is not exactly 1.
sub _complete_node_menus {
  my $self = shift;
  my $root = shift;

if (!defined $self->{'nodes'}) {
    $self->{'nodes'} = [];
  }
  my $node;
  foreach my $child (@{$root->{'contents'}}) {
    if ($child->{'cmdname'} and $child->{'cmdname'} eq 'node') {
      $node = $child;
    }
    _find_menus_of_node ($node, $child) unless !defined $node;
  }
}

sub get_parser_info {
  my $self = shift;

my ($TARGETS, $INTL_XREFS, $FLOATS,
      $INDEX_NAMES, $ERRORS, $GLOBAL_INFO, $GLOBAL_INFO2);

$TARGETS = build_label_list ();
  $INTL_XREFS = build_internal_xref_list ();
  $FLOATS = build_float_list ();

$INDEX_NAMES = build_index_data ();
  $self->{'index_names'} = $INDEX_NAMES;

$GLOBAL_INFO = build_global_info ();
  $GLOBAL_INFO2 = build_global_info2 ();

$self->{'targets'} = $TARGETS;
  $self->{'labels'} = {};
  $self->{'internal_references'} = $INTL_XREFS;
  $self->{'floats'} = $FLOATS;
  $self->{'info'} = $GLOBAL_INFO;
  $self->{'extra'} = $GLOBAL_INFO2;

_get_errors ($self);
  Texinfo::Common::complete_indices ($self);
}

use File::Basename; # for fileparse

# Handle 'IGNORE_BEFORE_SETFILENAME' conf value.
# Put everything before @setfilename in a special type.  This allows
# ignoring everything before @setfilename.
sub _maybe_ignore_before_setfilename {
  my ($self, $text_root) = @_;

if ($self->{'IGNORE_BEFORE_SETFILENAME'} and $text_root
      and $self->{'extra'}->{'setfilename'}
      and $self->{'extra'}->{'setfilename'}->{'parent'} eq $text_root) {
    my $before_setfilename = {'type' => 'preamble_before_setfilename',
      'parent' => $text_root,
      'contents' => []};
    while (@{$text_root->{'contents'}}
        and (!$text_root->{'contents'}->[0]->{'cmdname'}
          or $text_root->{'contents'}->[0]->{'cmdname'} ne 'setfilename')) {
      my $content = shift @{$text_root->{'contents'}};
      $content->{'parent'} = $before_setfilename;
      push @{$before_setfilename->{'contents'}}, $content;
    }
    if (!@{$text_root->{'contents'}}) {
      # not found
      #splice @{$text_root->{'contents'}}, 0, 0, @$before_setfilename;
      $text_root->{'contents'} = $before_setfilename->{'contents'};
    } else {
      unshift (@{$text_root->{'contents'}}, $before_setfilename)
        if (@{$before_setfilename->{'contents'}});
    }
  }
}

# Replacement for Texinfo::Parser::parse_texi_file (line 835)
sub parse_texi_file ($$)
{
  my $self = shift;
  my $file_name = shift;
  my $tree_stream;

my $status = parse_file ($file_name);
  if ($status) {
    # TODO: internationalise this message?
    $self->document_error(sprintf("could not open %s: %s", $file_name, $!));
    return undef;
  }

my $TREE = build_texinfo_tree ();
  get_parser_info ($self);
  _complete_node_menus ($self, $TREE);

# line 899
  my $text_root;
  if ($TREE->{'type'} eq 'text_root') {
    $text_root = $TREE;
  } elsif ($TREE->{'contents'} and $TREE->{'contents'}->[0]
      and $TREE->{'contents'}->[0]->{'type'} eq 'text_root') {
    $text_root = $TREE->{'contents'}->[0];
  }

_maybe_ignore_before_setfilename($self, $text_root);

############################################################

my ($basename, $directories, $suffix) = fileparse($file_name);
  $self->{'info'}->{'input_file_name'} = $basename;
  $self->{'info'}->{'input_directory'} = $directories;

return $TREE;
}

# Copy the errors into the error list in Texinfo::Report.
# TODO: Could we just access the error list directly instead of going
# through Texinfo::Report line_error?
sub _get_errors($)
{
  my $self = shift;
  my $ERRORS;
  my $tree_stream = dump_errors();
  eval $tree_stream;
  for my $error (@{$ERRORS}) {
    if ($error->{'type'} eq 'error') {
      $self->line_error ($error->{'message'}, $error->{'line_nr'});
    } else {
      $self->line_warn ($error->{'message'}, $error->{'line_nr'});
    }
  }
}

# Replacement for Texinfo::Parser::parse_texi_text (line 757)
#
# Used in tests under tp/t.
sub parse_texi_text($$;$$$$)
{
    my $self = shift;
    my $text = shift;
    my $lines_nr = shift;
    my $file = shift;
    my $macro = shift;
    my $fixed_line_number = shift;

return undef if (!defined($text));

$self = parser() if (!defined($self));

# make sure that internal byte buffer is in UTF-8 before we pass
    # it in to the XS code.
    utf8::upgrade($text);

parse_text($text);
    my $tree = build_texinfo_tree ();
    my $INDEX_NAMES = build_index_data ();
    $self->{'index_names'} = $INDEX_NAMES;

for my $index (keys %$INDEX_NAMES) {
      if ($INDEX_NAMES->{$index}->{'merged_in'}) {
        $self->{'merged_indices'}-> {$index}
          = $INDEX_NAMES->{$index}->{'merged_in'};
      }
    }

get_parser_info($self);
    _complete_node_menus ($self, $tree);
    return $tree;
}

# Replacement for Texinfo::Parser::parse_texi_line (line 918)
sub parse_texi_line($$;$$$$)
{
    my $self = shift;
    my $text = shift;
    my $lines_nr = shift;
    my $file = shift;
    my $macro = shift;
    my $fixed_line_number = shift;

return undef if (!defined($text));

$self = parser() if (!defined($self));
    utf8::upgrade($text);
    parse_string($text);
    my $tree = build_texinfo_tree ();
    return $tree;
}

# Public interfaces of Texinfo::Parser (starting line 942)
sub indices_information($)
{
  my $self = shift;

my $INDEX_NAMES;
  if (!$self->{'index_names'}) {
    $INDEX_NAMES = build_index_data ();
    $self->{'index_names'} = $INDEX_NAMES;
  }
  return $self->{'index_names'};
}

sub floats_information($)
{
  my $self = shift;
  return $self->{'floats'};
}

sub internal_references_information($)
{
  my $self = shift;
  return $self->{'internal_references'};
}

sub global_commands_information($)
{
  my $self = shift;
  return $self->{'extra'};
}

sub global_informations($)
{
  my $self = shift;
  return $self->{'info'};
}

# Setup labels and nodes info and return labels
sub labels_information($)
{
  goto &Texinfo::Common::labels_information;
}

BEGIN {
  Texinfo::XSLoader::init (
    "Texinfo::Parser",
    "Texinfo::Parser",
    "Texinfo::ParserNonXS",
    "Parsetexi",
    0);
} # end BEGIN

END {
  #reset_parser (); # for debugging memory leaks
}

1;
__END__

Back to Directory File Manager