usr/share/texinfo/DebugTexinfo/DebugCount.pm

# DebugTexinfo::DebugCount.pm: gather information on bytes and lines
# count for debugging purposes.
#
# Copyright 2011, 2012 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>
# ./texi2any.pl --set TEXINFO_OUTPUT_FORMAT=debugcount file.texi

use strict;

use Texinfo::Convert::Info;

package DebugTexinfo::DebugCount;
use vars qw(@ISA);
@ISA = qw(Texinfo::Convert::Info);

sub _convert($$)
{
  my $self = shift;
  my $root = shift;
  
  $self->{'level'}++;
  $self->{'command_type_nr'}++;
  $self->_update_count_context();
  my $bytes_before = $self->{'count_context'}->[-1]->{'bytes'};
  my $number_before = "($self->{'count_context'}->[-1]->{'bytes'},$self->{'count_context'}->[-1]->{'lines'})";
  my $command_nr = '['.$self->{'command_type_nr'}.']';
  my $command_type = '';
  $command_type .= '@'.$root->{'cmdname'} if ($root->{'cmdname'});
  $command_type .= ":$root->{'type'}" if ($root->{'type'});
  if (defined($root->{'text'})) {
    $command_type .= ":text";
    my $text = $root->{'text'};
    $text =~ s/\n/\\n/g;
    $text =~ s/\f/\\f/g;
    $command_type .= "|$text|";
  }
  my $string_before = ' ' x $self->{'level'}. "$command_nr $number_before $command_type\n";
  push @{$self->{'debug_count_strings'}}, $string_before;
  
  my $text =
    Texinfo::Convert::Plaintext::_convert($self, $root);
  my $all_locations_string = '';
  if ($self->{'count_context'}->[-1]->{'locations'}) {
    foreach my $location (@{$self->{'count_context'}->[-1]->{'locations'}}) {
      my $location_nr;
      if (defined($self->{'debug_location_counts'})
           and defined ($self->{'debug_location_counts'}->{$location})) {
        $location_nr = $self->{'debug_location_counts'}->{$location};
      } else {
        $self->{'debug_location_counter'}++;
        $location_nr = $self->{'debug_location_counter'};
        $self->{'debug_location_counts'}->{$location} = $location_nr;
      }
      my $location_string = '';
      if (defined($location->{'lines'})) {
        $location_string .= " l $location->{'lines'}";
      }
      if (defined($location->{'bytes'})) {
        $location_string .= " b $location->{'bytes'}";
      }
      if (defined($self->{'debug_locations_strings'}->{$location})) {
        if ($self->{'debug_locations_strings'}->{$location} eq $location_string) {
          $location_string = '';
        } else {
          $self->{'debug_locations_strings'}->{$location} = $location_string;
          $location_string = " ($location_nr)$location_string";
        }
      } else {
        $self->{'debug_locations_strings'}->{$location} = $location_string;
        $location_string = " ($location_nr)$location_string";
      }
      $all_locations_string .= $location_string if ($location_string);
    }
    $all_locations_string .= "\n" if ($all_locations_string);
  }
  #push @{$self->{'debug_count_strings'}}, ' ' x $self->{'level'}. "TEXT: $text|\n"
  #  if ($self->{'count_context'}->[-1]->{'bytes'} > $bytes_before);
  $self->_update_count_context();
  my $number_after = "($self->{'count_context'}->[-1]->{'bytes'},$self->{'count_context'}->[-1]->{'lines'})";
  my $string_after = ' ' x $self->{'level'}. "$command_nr $number_after\n";
  $string_after .= " locations $all_locations_string"
     if ($all_locations_string ne '');
  push @{$self->{'debug_count_strings'}}, $string_after;
  $self->{'level'}--;
  if ($self->{'level'} > 0) {
    return $text;
  } else {
    my $result = join('',@{$self->{'debug_count_strings'}}).$text;
    @{$self->{'debug_count_strings'}} = ();
    return $result;
  }
}

1;