--- trunk/lib/WebPAC/Parser.pm 2006/09/25 13:24:09 703 +++ trunk/lib/WebPAC/Parser.pm 2006/09/29 18:55:31 724 @@ -9,7 +9,7 @@ use Data::Dump qw/dump/; use File::Slurp; -use base qw/WebPAC::Common WebPAC::Normalize/; +use base qw/WebPAC::Common/; =head1 NAME @@ -17,11 +17,11 @@ =head1 VERSION -Version 0.05 +Version 0.06 =cut -our $VERSION = '0.05'; +our $VERSION = '0.06'; =head1 SYNOPSIS @@ -66,18 +66,6 @@ $self ? return $self : return undef; } -=head2 lookup_create_rules - - my $source = $parser->lookup_create_rules($database, $input); - -=cut - -sub lookup_create_rules { - my $self = shift; - my ($database,$input) = @_; - return $self->{_lookup_create}->{ _q($database) }->{ _q($input) }; -} - =head2 valid_database my $ok = $parse->valid_database('key'); @@ -100,8 +88,8 @@ sub valid_database_input { my $self = shift; - my ($database,$input) = @_; + $input = _input_name($input); return defined($self->{valid_inputs}->{ _q($database) }->{ _q($input) }); } @@ -116,6 +104,7 @@ sub depends { my $self = shift; my ($database,$input) = @_; + $input = _input_name($input); $self->_get_logger->debug("depends($database,$input)"); return unless ( defined( $self->{depends}->{ _q($database) } ) && @@ -124,6 +113,58 @@ return $self->{depends}->{ _q($database) }->{ _q($input) }; } +=head2 have_lookup_create + + my @keys = $parser->have_lookup_create($database, $input); + +=cut + +sub have_lookup_create { + my $self = shift; + my ($database,$input) = @_; + $input = _input_name($input); + return unless ( + defined( $self->{_lookup_create_key}->{ _q($database) } ) && + defined( $self->{_lookup_create_key}->{ _q($database) }->{ _q($input) } ) + ); + return keys %{ $self->{_lookup_create_key}->{ _q($database) }->{ _q($input) } }; +} + + +=head2 lookup_create_rules + + my $source = $parser->lookup_create_rules($database, $input); + +=cut + +sub lookup_create_rules { + my $self = shift; + my ($database,$input) = @_; + $input = _input_name($input); + return unless ( + defined( $self->{_lookup_create}->{ _q($database) } ) && + defined( $self->{_lookup_create}->{ _q($database) }->{ _q($input) } ) + ); + return $self->{_lookup_create}->{ _q($database) }->{ _q($input) }; +} + +=head2 normalize_rules + + my $source = $parser->normalize_rules($database, $input); + +=cut + +sub normalize_rules { + my $self = shift; + my ($database,$input) = @_; + $input = _input_name($input); + return unless ( + defined( $self->{_normalize_source}->{ _q($database) } ) && + defined( $self->{_normalize_source}->{ _q($database) }->{ _q($input) } ) + ); + return $self->{_normalize_source}->{ _q($database) }->{ _q($input) }; +} + =head1 PRIVATE =head2 _read_sources @@ -184,7 +225,7 @@ $parser->_parse_lookups($database,$input,$path,$source); -Called for each normalize source (rules) in each input by L +Called for each normalize source (rules) in each input by L It will report invalid databases and inputs in error log after parsing. @@ -208,6 +249,7 @@ my $Document = PPI::Document->new( \$source ) || $log->logdie("can't parse source:\n", $self->{source}); $Document->prune('PPI::Token::Whitespace'); + $Document->prune('PPI::Token::Comment'); #$Document->prune('PPI::Token::Operator'); # Find all the named subroutines @@ -272,21 +314,18 @@ $log->debug("key = $key"); - my $create = ' - $coderef = ' . $e[7] . $e[8] . '; - foreach my $v ($coderef->()) { - next unless (defined($v) && $v ne \'\'); - push @{ $lookup->{\'' . $key . '\'}->{$v} }, $mfn; - } - '; - - $log->debug("create: $create"); - return $self->_lookup_error("invalid database $e[3] in $path" ) unless $self->valid_database( $e[3] ); return $self->_lookup_error("invalid input $e[5] of database $e[3] in $path", ) unless $self->valid_database_input( $e[3], $e[5] ); + my $create = qq{ + save_into_lookup($e[3],$e[5],'$key', $e[7] $e[8] ); + }; + + $log->debug("create: $create"); + # save code to create this lookup - $self->{_lookup_create}->{ _q($e[3]) }->{ _q($e[5]) }->{ _q($key) } .= $create; + $self->{_lookup_create}->{ _q($e[3]) }->{ _q($e[5]) } .= $create; + $self->{_lookup_create_key}->{ _q($e[3]) }->{ _q($e[5]) }->{ _q($key) }++; if (defined( $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) }->{ $key } )) { @@ -314,7 +353,7 @@ $log->debug("create: ", dump($self->{_lookup_create}) ); $log->debug("normalize: $normalize_source"); - $self->{_normalize_source}->{$database}->{$input} = $normalize_source; + $self->{_normalize_source}->{$database}->{$input} .= $normalize_source; if ($self->{debug}) { my $Dumper = PPI::Dumper->new( $Document );