~~David~~ has asked for the wisdom of the Perl Monks concerning the following question:

All, I have an object that I create with a 'file' method. The 'file' method uses Parse::RecDescent to parse the file and store some of the contents into the object. I am having problems figuring out how to get parse::recdescent to store the data into my object, however.
My package is called Klarf::1_8 I have a rule in my grammer that looks like this: 
    list  : LIST HEADER
    {
        Klarf::1_8::_store_list( $self, $item{HEADER} )
    }

[download]
I have this subroutine: 
sub _store_list{
    my $self   = shift;
    my $header = lc shift;
    
    my $ref = _get_hash_of_level();
       $ref->{$header} = {};
    $self->{_current_state} = 'LIST';
    $self->{_current_list}  = $header;
    
    say "Found $header" if $self->{_verbose};
}

[download]
The problem is that in my grammer, $self is in the namespace of the Parse::Recdescent object, so my sub gets the Parse::Recdesent object. I tried using Klarf::1_8::_store_list( $__PACKAGE__::self, $item{HEADER} ) but that doesn't work because I haven't declared a package variable by that name. Here is my file sub: 
sub file {
    my $self = shift;
    my $file = shift;
    
    if ( not -f $file ){ carp 'Invalid filename provided' };
        
    my @grammer = <DATA>;
    my $grammer = join ' ', @grammer;
    
    my $parser = Parse::RecDescent->new( $grammer );

    open my $file_h, '<', $file or croak q{Couldn't open file};
    while ( my $line = <$file_h> ){ 
        chomp $line;
        $parser->startrule($line);
    }
    close $file_h;
    
    return $file;
}

[download]
Is there anyway I can accomplish this? I am sure there is. Thanks, David Just in case, here is my complete code 
package Klarf::1_8;
use strict;
use warnings;
use Parse::RecDescent;
use File::Slurp;
use Carp;
use Mouse;
use feature ':5.10';

use Data::Dumper;

=head3 verbose

Turns on messages to see what is going on with the parser.

=cut

sub verbose {
    my $self = shift;
    my $verbose = shift;
    
    $self->{_verbose} = $verbose;
    return $verbose;
}

=head3 file

Loads the file and parses it.  Returns the filename upon success.

=cut

sub file {
    my $self = shift;
    my $file = shift;
    
    if ( not -f $file ){ carp 'Invalid filename provided' };
        
    my @grammer = <DATA>;
    my $grammer = join ' ', @grammer;
    
    my $parser = Parse::RecDescent->new( $grammer );

    open my $file_h, '<', $file or croak q{Couldn't open file};
    while ( my $line = <$file_h> ){ 
        chomp $line;
        $parser->startrule($line);
    }
    close $file_h;
    
    return $file;
}


sub _store_list{
    my $self   = shift;
    my $header = lc shift;
    
    my $ref = _get_hash_of_level();
       $ref->{$header} = {};
    $self->{_current_state} = 'LIST';
    $self->{_current_list}  = $header;
    
    say "Found $header" if $self->{_verbose};
}

sub _store_data{
    my $self = shift;
    $self->{_current_state} = 'DATA';
}

sub _store_line{
    my $self = shift;
    my $line = shift;
    my $col  = shift;
    
    my $data_or_header = defined $col 
                       ? 'header' 
                       : $self->{_current_state} ne 'DATA' 
                       ? 'header'
                       :'data';
    
    my $ref = _get_hash_of_level();
    push @{$ref->{$self->{_current_list}}->{$data_or_header}}, $line; 
}

sub _store_field{
    my $self   = shift;
    my $header = lc shift;
    my $int    = shift;
    my $array  = shift;
    
    $array =~ s/[{}]//g;
    my @array = split /,/, $array;
    
    carp "Expecting field size $int in list $array.  Field $header get
+s undef."
       unless $int == scalar @array;
    
    foreach my $item ( @array ){
        $item =~ s/["\s]//g;    
    }
    
    my $storable;
    if ( $int == 1 ){ $storable = $array[0] }
    else { $storable = \@array };

    my $ref = _get_hash_of_level();
       $ref->{$header} = $storable;
    
    say "Found $header:\t$array" if $self->{_verbose};
}

# i need to know which level of the hash to store each record.
# so this sub returns the correct hash for later storage. 
sub _get_hash_of_level{
    my $self = shift;
    my $idx = $self->{level};
       $idx--;
    my @array = @{$self->{_headerlist}};
    
    if ( not defined $idx ){ $idx = 0 };
    
    my $level = $array[$idx];

    given ( $level ){
        when ( 'filerecord' )   { return $self }
        when ( 'lotrecord' )    { return $self }    
        when ( 'waferrecord' )  { return $self->{$self->{_current_wafe
+r}} }
        when ( 'testrecord' )   { return $self->{$self->{_current_wafe
+r}}->{$self->{_current_test}} }
        when ( 'summaryrecord' ){ return $self->{$self->{_current_wafe
+r}}}
    }
}

sub _store_record{
    my $self   = shift;
    my $header = lc shift;
    my $value  = shift;
       $value //= ''; #/ 
    
    print Dumper $self;  die;
    
    chomp $header;
    chomp $value;
    $value =~ s/"//g;
    
    $self->{_current_record} = $header;
    
    # want to keep the header list so i can look it up via indexing...
    push @{$self->{_headerlist}}, $header 
       unless grep { $header eq $_ } @{$self->{_headerlist}};
    
    given ( $header ){
        when ( 'lotrecord' ){
            $self->{_current_lot} = $value;
            $self->{$header} = $value;
        }
        when ( 'waferrecord' ){
            $self->{_current_wafer} = $value;
            $self->{_num_wafers}++;
            $self->{$value} = {};
        }
        when ( 'testrecord' ){
            $self->{_current_test} = $value;
            $self->{$self->{_current_wafer}}->{$self->{_current_test}}
+ = {};
        }
        when ( 'filerecord' ){
            $self->{$header} = $value;
        }
        when ( 'summaryrecord' ){
            $self->{$self->{_current_wafer}}->{$header} = {};
        }    
        
    }
    
    say "Found $header:\t$value" if $self->{_verbose};
}

# increments and decrements the 'level' of the objectc
# by counting the brackets
sub _level{
    my $self = shift;
    my $dir  = shift;
    if ( $dir eq '+' ){ 
        $self->{_level}++;
    }
    elsif ( $dir eq '-' ){
        $self->{_level}--;
    }
}

1;
# DATA filehandle holds the grammer for parsing the klarf.
__DATA__
    RECORD        : /Record/i
    FIELD        : /Field/i
    LIST        : /List/i
    COLUMN        : /Columns/i
    DATA        : /Data/i
    
    HEADER      : /[\s]*[A-Za-z]+/
    VALUE        : /[\s]*["]?[\w\.]+["]?/
    INT            : /\d+/
    ARRAY        : /\{.+\}/
    LINE        : /.+/
    
    record : RECORD HEADER VALUE(?)
    {
        Klarf::1_8::_store_record( $__PACKAGE__::self, $item{HEADER}, 
+$item{'VALUE(?)'}->[0] )
    }
    
    field : FIELD HEADER INT ARRAY
    {
        Klarf::1_8::_store_field( $self, $item{HEADER}, $item{INT}, $i
+tem{ARRAY} )
    }
    
    list  : LIST HEADER
    {
        Klarf::1_8::_store_list( $self, $item{HEADER} )
    }
    
    data    : DATA INT
    {
        Klarf::1_8::_store_data( $self )
    }
    
    column    : COLUMN INT LINE
    {
        Klarf::1_8::_store_line( $self, $item{LINE}, 'col' )
    }
    
    obracket : /{/ { Klarf::1_8::_level( $self, '+') }
    cbracket : /}/ { Klarf::1_8::_level( $self, '-') }
    
    line    : LINE
    {
        Klarf::1_8::_store_line( $self, $item{LINE} )
    }
    
    klarfline   :   record | field | list | data | column | obracket |
+ cbracket | line
    startrule   :   klarfline(s /;/)

[download]

Replies are listed 'Best First'.
Re: Using Parse::RecDescent in an Object
by ikegami (Patriarch) on Jun 10, 2010 at 17:47 UTC

    Yuk. Just return the extracted data from your parse rule. What follows is a simpler example.

    To build your parser module: 

    #!/usr/bin/env perl

# make_grammar.pl

use strict;
use warnings;

use Parse::RecDescent qw( );

my $grammar = <<'__END_OF_GRAMMAR__';

    {
        use strict;
        use warnings;
    }

    parse : list /\Z/ { $item[1] }

    list  : '(' term(s) ')' { $item[2] }

    term  : /[a-z]+/
          | list

__END_OF_GRAMMAR__

Parse::RecDescent->PreCompile($grammar, 'NestedListParser')
    or die("Bad Grammar\n");

    [download]

    To load the file, you'd do something like: 

    use NestedListParser qw( );

sub load {
    my $self = shift;
    my $qfn  = shift;

    open(my $fh, '<', $qfn)
        or croak("Couldn't open file \"$qfn\": $!");

    my $file; { local $/; $file = <$fh>; }

    my $parser = NestedListParser->new();
    $self->{list} = $parser->parse($file)
        or die("Bad data\n");
}

    [download]

    Updated: Changed to a grammar that better illustrates the solution.

[reply]
[d/l]
[select]
      Thanks, I see your point about returning the result into part of the object.
      I will consider this.
      Thanks, David
[reply]
Re: Using Parse::RecDescent in an Object
by jethro (Monsignor) on Jun 10, 2010 at 17:18 UTC

    If I understand your question correctly, you could do this:

    1. Create wanted object in the Start-up Action (see Parse::RecDescent documentation)
    2. Fill object with parsed data
    3. Return object in the startrule (if the grammar fails, undef is returned instead)

[reply]
      Thanks, I see the startup actions. It almost did what I wanted. What I have ended up doing ( and maybe this is bad ), is to make my file method look like this: 
      sub file {
    my $self = shift;
    my $file = shift;
    
    our $object;
    $object = $self;
    
    if ( not -f $file ){ carp 'Invalid filename provided' };
        
    my @grammer = <DATA>;
    my $grammer = join ' ', @grammer;
    
    my $parser = Parse::RecDescent->new( $grammer );

    open my $file_h, '<', $file or croak q{Couldn't open file};
    while ( my $line = <$file_h> ){ 
        chomp $line;
        $self = $parser->startrule($line);
    }
    close $file_h;
    
    undef $object;
    
    return $file;
}

      [download]
      And all of my grammers use this syntax: 
      Klarf::1_8::_store_line( $Klarf::1_8::object, $item{LINE}, 'col' )

      [download]
      I will work on removing the hard coded package links if possible.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom