DXR is a code search and navigation tool aimed at making sense of large projects. It supports full-text and regex searches as well as structural queries.

Mercurial (495129e490bc)

VCS Links

Line Code
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
# $Id: SimpleParse.pm,v 1.2 2005/12/04 14:40:04 timeless%mozdev.org 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 $l = shift;
    my $t = shift || 8;
    $l =~ s/([^\t]*)\t/$1.(' ' x ($t - (length($1) % $t)))/ge;
    return $l;
}

sub nextfrag {
    my $btype = undef;
    my $frag = undef;

    while (1) {
        unless (scalar @frags) {
            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 unless (scalar @frags);
        }

        unless (length $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;