r972@llin: dpavlin | 2006-09-24 20:50:22 +0200

 check for valid databases and inputs [0.02]

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@689 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/conf/log.conf b/conf/log.conf
index f5e39ea..c3000c0 100644 (file)
--- a/conf/log.conf
+++ b/conf/log.conf
@@ -20,6 +20,8 @@ log4perl.rootLogger=INFO, LOG, SCREEN
 #log4perl.logger.WebPAC.Lookup.lookup=DEBUG
 
 log4perl.logger.WebPAC.Config=DEBUG
+log4perl.logger.WebPAC::Config::new=INFO
+log4perl.logger.WebPAC::Config::iterate_inputs=INFO
 
 log4perl.logger.WebPAC.Parser=DEBUG
 

diff --git a/lib/WebPAC/Parser.pm b/lib/WebPAC/Parser.pm
index 08eb855..571b945 100644 (file)
--- a/lib/WebPAC/Parser.pm
+++ b/lib/WebPAC/Parser.pm
@@ -17,11 +17,11 @@ WebPAC::Parser - parse perl normalization configuration files and mungle it
 
 =head1 VERSION
 
-Version 0.01
+Version 0.02
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 SYNOPSIS
 
@@ -54,13 +54,15 @@ sub new {
        my $source;
 
        $self->{config}->iterate_inputs( sub {
-               my $input = shift;
+               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]");
+               my $input_name = $input->{name} || $log->logdie("can't deduce name of input: ", dump( $input ));
+               $log->debug("$database/$input_name: adding $path to parser [",length($s)," bytes]");
                $source .= $s;
+               $self->{valid_inputs}->{$database}->{$input_name}++;
        } );
 
        $log->debug("collected ", length($source), " bytes of source");
@@ -81,6 +83,8 @@ sub parse {
 
        $log->logdie('no source found in object') unless ($self->{source});
 
+       $log->debug("valid_inputs = ", dump( $self->{valid_inputs} ));
+
        my $Document = PPI::Document->new( \$self->{source} ) || $log->logdie("can't parse source:\n", $self->{source});
 
        $Document->prune('PPI::Token::Whitespace');
@@ -150,7 +154,9 @@ sub parse {
 
                        $log->debug("create: $create");
 
-                       $create =~ s/\s+/ /gs;
+                       $log->logdie("invalid database $e[3]" ) unless $self->valid_database( $e[3] );
+                       $log->logdie("invalid input $e[5] of database $e[3]", ) unless $self->valid_database_input( $e[3], $e[5] );
+
                        $eval_create->{ $e[3] }->{ $e[5] } .= $create;
 
                        if ($#e < 10) {
@@ -178,6 +184,37 @@ sub parse {
        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<< <dpavlin@rot13.org> >>

diff --git a/t/2-parse.t b/t/2-parse.t
index 2b7564b..6add3b6 100755 (executable)
--- a/t/2-parse.t
+++ b/t/2-parse.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 8;
+use Test::More tests => 19;
 use Test::Exception;
 use blib;
 
@@ -32,6 +32,22 @@ ok(
                debug => $debug,
 ), "new");
 
+my $inputs = {
+       foo => [ qw/foo-input1 foo-input2/ ],
+       bar => [ qw/bar-input/ ],
+       baz => [ qw/baz-input/ ],
+};
+
+foreach my $db (qw/foo bar baz/) {
+       ok($parser->valid_database($db), "database $db");
+       ok($inputs->{$db}, "has known inputs");
+       diag "valid inputs = ", dump($inputs->{$db});
+       foreach my $i (@{ $inputs->{$db} }) {
+               ok($parser->valid_database_input($db,$i), "input $i");
+       }
+}
+ok(! $parser->valid_database('non-existant'), "no database");
+
 ok($parser->{source}, "source exist");
 
 ok($parser->parse, 'parse');

diff --git a/t/conf/normalize/baz.pl b/t/conf/normalize/baz.pl
index e468fd4..acd39d1 100644 (file)
--- a/t/conf/normalize/baz.pl
+++ b/t/conf/normalize/baz.pl
@@ -1,7 +1,12 @@
 marc('900','x',
        lookup(
                sub { rec('200','a') . ' ' . rec('200','b') },
-               'foo','foo-input2',
+               'no-database','baz',
+               sub { rec('245','a') },
+       ),
+       lookup(
+               sub { rec('200','a') . ' ' . rec('200','b') },
+               'foo','no-input',
                sub { rec('245','a') },
        )
 );

diff --git a/t/conf/normalize/foo.pl b/t/conf/normalize/foo.pl
index 0bec8d3..8a2900f 100644 (file)
--- a/t/conf/normalize/foo.pl
+++ b/t/conf/normalize/foo.pl
@@ -6,12 +6,12 @@ marc('777','v',
        ) ||
        lookup(
                sub { '2nd:' . rec('000') },
-               'bar','peri',
+               'bar','bar-input',
                sub { rec(200,'a') . rec('200','e') },
        ) ||
        lookup(
                sub { "3rd:" . rec('000') },
-               'baz','peri',
+               'baz','baz-input',
                sub { rec(200,'a') },
                sub { rec(900,'x') },
        )