/usr/share/perl5/Data/Stag/IndentParser.pm is in libdata-stag-perl 0.14-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | # $Id: IndentParser.pm,v 1.4 2008/06/03 17:31:15 cmungall Exp $
#
# Copyright (C) 2002 Chris Mungall <cjm@fruitfly.org>
#
# See also - http://stag.sourceforge.net
#
# This module is free software.
# You may distribute this module under the same terms as perl itself
package Data::Stag::IndentParser;
=head1 NAME
Data::Stag::IndentParser.pm - parses stag indent format into stag events
=head1 SYNOPSIS
=cut
=head1 DESCRIPTION
=head1 AUTHOR
=cut
use Exporter;
use Carp;
use FileHandle;
use strict;
use base qw(Data::Stag::BaseGenerator Exporter);
use vars qw($VERSION);
$VERSION="0.14";
sub fmtstr {
return 'indent';
}
our $elt_re = '^([\w\-\+\?\*\:]+)\s*(.*)';
sub parse_fh {
my $self = shift;
my $fh = shift;
my @stack = ();
while(<$fh>) {
chomp;
s/\\\#/MAGIC_WORD_HASH/g;
s/\#.*//;
s/MAGIC_WORD_HASH/\#/g;
# remove trailing ws
s/\s*$//;
next unless $_;
# get indent level
/(\s*)(.*)/s;
my ($indent_txt, $elt) = ($1, $2);
my $indent = length($indent_txt);
if ($elt =~ /^$elt_re/) {
$elt = $1;
my $rest = $2;
my @atts = ();
if ($rest =~ /^\s*\[(.*)/) {
$rest = $1;
while ($rest =~ /^\s*([\w:]+)\s*=\s*(.*)/) {
push(@atts, $1);
$rest = $2;
if ($rest =~ /(.*?)([\s?\]].*)/) {
push(@atts, $1);
$rest = $2;
}
else {
confess("expected SPC | ], found $rest in $_");
}
}
if ($rest =~ /^\s*\]\s*(.*)/) {
$rest = $1;
}
else {
confess("expected ] | TAG=VAL, found $rest");
}
}
$self->pop_to_level($indent, \@stack);
$self->start_event($elt);
if (@atts) {
$self->start_event('@');
while (my ($tag,$val) = splice(@atts,0,2)) {
$self->event($tag,$val);
}
$self->end_event('@');
}
if ($rest =~ /^\s*\"(.*)/) {
my $buf = $1;
my $str = '';
my $done = 0;
while (!$done) {
while (my $c = substr($buf,0,1)) {
$buf = substr($buf,1);
if ($c eq '"') {
$done = 1;
last;
}
$str .= $c;
}
if (!$done) {
$buf = <$fh>;
if (!$buf) {
confess("expected \", found EOF");
}
}
}
$self->evbody($str);
}
push(@stack, [$indent, $elt]);
}
else {
confess("expected INDENT-ELEMENT, found $_");
}
}
$fh->close;
$self->pop_to_level(0, \@stack);
return;
}
sub pop_to_level {
my $self = shift;
my $indent = shift;
my $stack = shift;
while (scalar(@$stack) &&
$stack->[-1]->[0] >= $indent) {
$self->end_event($stack->[-1]->[1]);
pop(@$stack);
}
return;
}
1;
|