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]