view release on metacpan or  search on metacpan

inc/Parse/RecDescent.pm  view on Meta::CPAN

    # including the contents of Parse::RecDescent as
    # Parse::RecDescent::Runtime in the resulting precompiled
    # parser.
    if ($opt{-standalone}) {
        local *IN;
        open IN, '<', $Parse::RecDescent::_FILENAME
          or croak("Can't open $Parse::RecDescent::_FILENAME for standalone pre-compilation: $!\n");
        my $exclude = 0;
        print OUT "{\n";
        while (<IN>) {
            if ($_ =~ /^\s*#\s*ifndef\s+RUNTIME\s*$/) {
                ++$exclude;
            }
            if ($exclude) {
                if ($_ =~ /^\s*#\s*endif\s$/) {
                    --$exclude;
                }
            } else {
                if ($_ =~ m/^__END__/) {
                    last;
                }
                s/Parse::RecDescent/$runtime_package/gs;
                print OUT $_;
            }
        }
        close IN;
        print OUT "}\n";
    }

    $self = Parse::RecDescent->new($grammar,  # $grammar
                                   1,         # $compiling
                                   $class     # $namespace
                             )
      || croak("Can't compile bad grammar")
      if $grammar;

    # Do not allow &DESTROY to remove the precompiled namespace
    delete $self->{_not_precompiled};

    foreach ( keys %{$self->{rules}} ) {
        $self->{rules}{$_}{changed} = 1;
    }


    print OUT "package $class;\n";
    if (not $opt{-standalone}) {
        print OUT "use Parse::RecDescent;\n";
    }

    print OUT "{ my \$ERRORS;\n\n";

    $code = $self->_code();
    if ($opt{-standalone}) {
        $code =~ s/Parse::RecDescent/$runtime_package/gs;
    }
    print OUT $code;

    print OUT "}\npackage $class; sub new { ";
    print OUT "my ";

    require Data::Dumper;
    $code = Data::Dumper->Dump([$self], [qw(self)]);
    if ($opt{-standalone}) {
        $code =~ s/Parse::RecDescent/$runtime_package/gs;
    }
    print OUT $code;

    print OUT "}";

    close OUT
      or croak("Can't write to new module file '$modulefile'");
}
#endif

package Parse::RecDescent::LineCounter;


sub TIESCALAR   # ($classname, \$text, $thisparser, $prevflag)
{
    bless {
        text    => $_[1],
        parser  => $_[2],
        prev    => $_[3]?1:0,
          }, $_[0];
}

sub FETCH
{
    my $parser = $_[0]->{parser};
    my $cache = $parser->{linecounter_cache};
    my $from = $parser->{fulltextlen}-length(${$_[0]->{text}})-$_[0]->{prev}
;

    unless (exists $cache->{$from})
    {
        $parser->{lastlinenum} = $parser->{offsetlinenum}
          - Parse::RecDescent::_linecount(substr($parser->{fulltext},$from))
          + 1;
        $cache->{$from} = $parser->{lastlinenum};
    }
    return $cache->{$from};
}

sub STORE
{
    my $parser = $_[0]->{parser};
    $parser->{offsetlinenum} -= $parser->{lastlinenum} - $_[1];
    return undef;
}

sub resync   # ($linecounter)
{
    my $self = tied($_[0]);
    die "Tried to alter something other than a LineCounter\n"
        unless $self =~ /Parse::RecDescent::LineCounter/;

    my $parser = $self->{parser};
    my $apparently = $parser->{offsetlinenum}
             - Parse::RecDescent::_linecount(${$self->{text}})
             + 1;

    $parser->{offsetlinenum} += $parser->{lastlinenum} - $apparently;