--- trunk/lib/WebPAC/Parser.pm 2006/09/24 17:49:05 687 +++ trunk/lib/WebPAC/Parser.pm 2006/09/24 21:13:36 691 @@ -3,13 +3,13 @@ use warnings; use strict; -use base qw/WebPAC::Common WebPAC::Normalize/; use PPI; use PPI::Dumper; use Data::Dump qw/dump/; use File::Slurp; +use base qw/WebPAC::Common WebPAC::Normalize/; =head1 NAME @@ -17,11 +17,11 @@ =head1 VERSION -Version 0.01 +Version 0.03 =cut -our $VERSION = '0.01'; +our $VERSION = '0.03'; =head1 SYNOPSIS @@ -51,37 +51,85 @@ $log->logdie("can't iterate_inputs over this config object") unless ($self->{config}->can('iterate_inputs')); - my $source; + $self->read_sources; $self->{config}->iterate_inputs( sub { - my $input = shift; + my ($input, $database) = @_; + return unless $self->valid_database_input($database, $input->{name}); + $self->parse_lookups($database,$input->{name}); + } ); + + $self ? return $self : return undef; +} + +=head2 read_sources + + my $source_files = $parser->read_sources; + +Called by L. + +=cut + +sub read_sources { + my $self = shift; + + my $log = $self->_get_logger(); + + my $nr = 0; + + $self->{config}->iterate_inputs( sub { + my ($input, $database) = @_; + my $path = $input->{normalize}->{path} || return; my $full = $self->{base_path} ? $self->{base_path} . '/' . $path : $path; + $log->logdie("normalization input $full doesn't exist") unless (-e $full); + my $s = read_file( $full ) || $log->logdie("can't read $full: $!"); - $log->debug("adding $path to parser [",length($s)," bytes]"); - $source .= $s; - } ); - $log->debug("collected ", length($source), " bytes of source"); + my $input_name = $input->{name} || $log->logdie("can't deduce name of input: ", dump( $input )); - $self->{source} = $source; + $log->debug("$database/$input_name: adding $path"); - $self ? return $self : return undef; + $self->{valid_inputs}->{$database}->{$input_name} = { + source => $s, + path => $full, + usage => 0, + } unless defined($self->{valid_inputs}->{$database}->{$input_name}); + + $self->{valid_inputs}->{$database}->{$input_name}->{usage}++; + + $nr++; + } ); + + $log->debug("found $nr source files"); + + return $nr; } -=head2 parse +=head2 parse_lookup + + $parser->parse_lookups($database,$input); =cut -sub parse { +sub parse_lookups { my $self = shift; + my ($database, $input) = @_; my $log = $self->_get_logger(); - $log->logdie('no source found in object') unless ($self->{source}); + $log->logdie("invalid database $database" ) unless $self->valid_database( $database ); + $log->logdie("invalid input $input of database $database", ) unless $self->valid_database_input( $database, $input ); + + my $source = $self->{valid_inputs}->{$database}->{$input}->{source}; + my $path = $self->{valid_inputs}->{$database}->{$input}->{path}; + + $log->logdie("no source found for database $database input $input path $path") unless ($source); - my $Document = PPI::Document->new( \$self->{source} ) || $log->logdie("can't parse source:\n", $self->{source}); + $log->info("parsing lookups for $database/$input in $path"); + + my $Document = PPI::Document->new( \$source ) || $log->logdie("can't parse source:\n", $self->{source}); $Document->prune('PPI::Token::Whitespace'); #$Document->prune('PPI::Token::Operator'); @@ -89,6 +137,15 @@ # Find all the named subroutines my $eval_create; + $self->{_lookup_errors} = (); + + sub _lookup_error { + my $self = shift; + my $msg = shift; + $self->_get_logger->logconfess("error without message?") unless ($msg); + push @{ $self->{_lookup_errors} }, $msg; + return ''; + } $Document->find( sub { my ($Document,$Element) = @_; @@ -150,7 +207,9 @@ $log->debug("create: $create"); - $create =~ s/\s+/ /gs; + 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] ); + $eval_create->{ $e[3] }->{ $e[5] } .= $create; if ($#e < 10) { @@ -175,9 +234,42 @@ $Dumper->print; } + $log->error("Parser errors: ", join("\n",@{ $self->{_lookup_errors} }) ) if ($self->{_lookup_errors}); + return 1; } +=head2 valid_database + + my $ok = $parse->valid_database('key'); + +=cut + +sub valid_database { + my $self = shift; + + my $database = shift || return; + $database =~ s/['"]//g; + + return defined($self->{valid_inputs}->{$database}); +} + +=head2 valid_database_input + + my $ok = $parse->valid_database('database_key','input_name'); + +=cut + +sub valid_database_input { + my $self = shift; + + my ($database,$input) = @_; + $database =~ s/['"]//g; + $input =~ s/['"]//g; + + return defined($self->{valid_inputs}->{$database}->{$input}); +} + =head1 AUTHOR Dobrica Pavlinusic, C<< >>