--- trunk/lib/WebPAC/Parser.pm 2006/09/25 11:14:53 698 +++ trunk/lib/WebPAC/Parser.pm 2006/09/25 13:46:36 705 @@ -17,11 +17,11 @@ =head1 VERSION -Version 0.04 +Version 0.05 =cut -our $VERSION = '0.04'; +our $VERSION = '0.05'; =head1 SYNOPSIS @@ -61,46 +61,100 @@ $log->logdie("can't iterate_inputs over this config object") unless ($self->{config}->can('iterate_inputs')); - $self->read_sources; - - $self->{config}->iterate_inputs( sub { - my ($input, $database) = @_; - return unless $self->valid_database_input($database, _input_name($input)); - $self->parse_lookups($database, _input_name($input)); - } ); + $self->_read_sources; $self ? return $self : return undef; } -=head2 read_sources +=head2 valid_database - my $source_files = $parser->read_sources; + my $ok = $parse->valid_database('key'); -Called by L. +=cut + +sub valid_database { + my $self = shift; + + my $database = shift || return; + + return defined($self->{valid_inputs}->{ _q($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) = @_; + $input = _input_name($input); + return defined($self->{valid_inputs}->{ _q($database) }->{ _q($input) }); +} + +=head2 depends + +Return all databases and inputs on which specified one depends + + $depends_on = $parser->depends('database','input'); =cut -sub _input_name($); +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) } ) && + defined( $self->{depends}->{ _q($database) }->{ _q($input) } ) + ); + return $self->{depends}->{ _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) }; +} + +=head1 PRIVATE + +=head2 _read_sources + + my $source_files = $parser->_read_sources; + +Called by L. + +=cut -sub read_sources { +sub _read_sources { my $self = shift; my $log = $self->_get_logger(); my $nr = 0; + my @lookups; + $self->{config}->iterate_inputs( sub { my ($input, $database) = @_; - my @normalize; - - if (ref($input->{normalize}) eq 'ARRAY') { - @normalize = @{ $input->{normalize} }; - } else { - @normalize = ( $input->{normalize} ); - } + $log->debug("database: $database input = ", dump($input)); - foreach my $normalize (@normalize) { + foreach my $normalize (@{ $input->{normalize} }) { my $path = $normalize->{path}; return unless($path); @@ -114,13 +168,11 @@ $log->debug("$database/$input_name: adding $path"); - $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}++; - $self->{valid_inputs}->{$database}->{$input_name}->{usage}++; + push @lookups, sub { + $self->_parse_lookups( $database, $input_name, $full, $s ); + }; $nr++; } @@ -128,22 +180,25 @@ $log->debug("found $nr source files"); + # parse all lookups + $_->() foreach (@lookups); + return $nr; } -=head2 parse_lookups +=head2 _parse_lookups - $parser->parse_lookups($database,$input); + $parser->_parse_lookups($database,$input,$path,$source); -Called for 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. =cut -sub parse_lookups { +sub _parse_lookups { my $self = shift; - my ($database, $input) = @_; + my ($database, $input, $path, $source) = @_; $input = _input_name($input); @@ -152,12 +207,9 @@ $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); - $log->info("parsing lookups for $database/$input from $path"); + $log->info("parsing lookups for $database/$input from $path (",length($source)," bytes)"); my $Document = PPI::Document->new( \$source ) || $log->logdie("can't parse source:\n", $self->{source}); @@ -240,16 +292,15 @@ return $self->_lookup_error("invalid input $e[5] of database $e[3] in $path", ) unless $self->valid_database_input( $e[3], $e[5] ); # 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]) }->{ _q($key) } .= "# lookup for $e[3]/$e[5]/$key\n\n$create"; - if (defined( $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) } )) { - my $dep_key = $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) }; - $log->warn("dependency of $database/$input on $e[3]/$e[5] allready recorded as $dep_key, now changed to $key") if ($dep_key ne $key); + if (defined( $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) }->{ $key } )) { + $log->warn("dependency of $database/$input on $e[3]/$e[5] with $key allready recorded"); } # save this dependency - $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) } .= $key; + $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) }->{$key}++; if ($#e < 10) { $e[8]->insert_after( $e[8]->clone ); @@ -282,63 +333,6 @@ } -=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'); - -=cut - -sub valid_database { - my $self = shift; - - my $database = shift || return; - - return defined($self->{valid_inputs}->{ _q($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) = @_; - return defined($self->{valid_inputs}->{ _q($database) }->{ _q($input) }); -} - -=head2 depends - -Return all databases and inputs on which specified one depends - - $depends_on = $parser->depends('database','input'); - -=cut - -sub depends { - my $self = shift; - my ($database,$input) = @_; - $self->_get_logger->debug("depends($database,$input)"); - return unless defined( $self->{depends}->{ _q($database) }->{ _q($input) } ); - return $self->{depends}->{ _q($database) }->{ _q($input) }; -} - -=head1 PRIVATE - =head2 _q Strip single or double quotes around value