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
|
# $Id: SimpleParse.pm,v 1.2 1998/04/30 11:58:17 argggh Exp $
use strict;
package SimpleParse;
require Exporter;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(&doparse &untabify &init &nextfrag);
my $INFILE; # Input file handle
my @frags; # Fragments in queue
my @bodyid; # Array of body type ids
my @open; # Fragment opening delimiters
my @term; # Fragment closing delimiters
my $split; # Fragmentation regexp
my $open; # Fragment opening regexp
my $tabwidth; # Tab width
sub init {
my @blksep;
($INFILE, @blksep) = @_;
while (@_ = splice(@blksep,0,3)) {
push(@bodyid, $_[0]);
push(@open, $_[1]);
push(@term, $_[2]);
}
foreach (@open) {
$open .= "($_)|";
$split .= "$_|";
}
chop($open);
foreach (@term) {
next if $_ eq '';
$split .= "$_|";
}
chop($split);
$tabwidth = 8;
}
sub untabify {
my $t = $_[1] || 8;
$_[0] =~ s/([^\t]*)\t/$1.(' ' x ($t - (length($1) % $t)))/ge;
return($_[0]);
}
sub nextfrag {
my $btype = undef;
my $frag = undef;
while (1) {
if ($#frags < 0) {
my $line = <$INFILE>;
if ($. == 1 &&
$line =~ /^.*-[*]-.*?[ \t;]tab-width:[ \t]*([0-9]+).*-[*]-/) {
$tabwidth = $1;
}
&untabify($line, $tabwidth);
# $line =~ s/([^\t]*)\t/
# $1.(' ' x ($tabwidth - (length($1) % $tabwidth)))/ge;
@frags = split(/($split)/o, $line);
}
last if $#frags < 0;
unless ($frags[0]) {
shift(@frags);
} elsif (defined($frag)) {
if (defined($btype)) {
my $next = shift(@frags);
$frag .= $next;
last if $next =~ /^$term[$btype]$/;
} else {
last if $frags[0] =~ /^$open$/o;
$frag .= shift(@frags);
}
} else {
$frag = shift(@frags);
if (defined($frag) && (@_ = $frag =~ /^$open$/o)) {
my $i = 1;
$btype = grep { $i = ($i && !defined($_)) } @_;
}
}
}
$btype = $bodyid[$btype] if $btype;
return($btype, $frag);
}
1;
|
