r679@llin: dpavlin | 2006-05-16 15:41:59 +0200

 begin work on validation framework

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

diff --git a/TODO b/TODO
index 439afc8..8b51c7c 100644 (file)
--- a/TODO
+++ b/TODO
@@ -14,6 +14,7 @@
 + add support for KinoSearch search library [2.12]
 + added new set-based normalizer which is pure perl code [2.13]
 + added --stats to report field and subfield usage [2.14]
+- add validator for input data [2.15]
 - support arrays for normalize/path and lookup
 - add Excel input format
 - add dBase input format

diff --git a/conf/input/validate_ffzg b/conf/input/validate_ffzg
new file mode 100644 (file)
index 0000000..26567af
--- /dev/null
+++ b/conf/input/validate_ffzg
@@ -0,0 +1,29 @@
+0 
+10 
+101 
+200 a b c d e f g
+205 a 
+210 a c d 
+215 a c d e 
+225 a d e f h i v w
+300 
+314 
+320 
+327 
+330 
+608 
+610 
+675 a b
+686 a 
+700 a b 
+701 a b c d
+702 a b c d e f
+710 a b c d e f
+711 a b c
+801 
+856 u
+990 
+991 
+994 a b c
+998 a 
+999 

diff --git a/conf/log.conf b/conf/log.conf
index df3d5fb..92f6768 100644 (file)
--- a/conf/log.conf
+++ b/conf/log.conf
@@ -19,6 +19,8 @@ log4perl.rootLogger=INFO, LOG, SCREEN
 #log4perl.logger.WebPAC.Lookup=DEBUG
 #log4perl.logger.WebPAC.Lookup.lookup=DEBUG
 
+log4perl.logger.WebPAC.Validate=DEBUG
+
 #log4perl.logger.WebPAC.Input=DEBUG
 #log4perl.logger.WebPAC.Input.ISIS=DEBUG
 #log4perl.logger.WebPAC.Input.ISIS.fetch=DEBUG

diff --git a/lib/WebPAC/Validate.pm b/lib/WebPAC/Validate.pm
new file mode 100644 (file)
index 0000000..dd0a4bf
--- /dev/null
+++ b/lib/WebPAC/Validate.pm
@@ -0,0 +1,110 @@
+package WebPAC::Validate;
+
+use warnings;
+use strict;
+
+use blib;
+
+use base 'WebPAC::Common';
+use File::Slurp;
+use Data::Dumper;
+
+=head1 NAME
+
+WebPAC::Validate - provide simple validation for records
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+This module provide a simple way to validate your file against a simple
+configuration file in following format:
+
+  # field 10 doesn't have any subfields
+  10
+  # same with 101
+  101
+  # field 200 have valid subfields a-g
+  200 a b c d e f g
+  # field 205 can have only subfield a
+  205 a
+  # while 210 can have a c or d
+  210 a c d
+
+=head1 FUNCTIONS
+
+=head2 new
+
+Create new validation object
+
+  my $validate = new WebPAC::Validate(
+       path => '/path/to/input/validate_file',
+  );
+
+=cut
+
+sub new {
+       my $class = shift;
+       my $self = {@_};
+       bless($self, $class);
+
+       my $log = $self->_get_logger();
+
+       foreach my $p (qw/path/) {
+               $log->logconfess("need $p") unless ($self->{$p});
+       }
+
+       my $v_file = read_file( $self->{path} ) ||
+               $log->logdie("can't open validate path $self->{path}: $!");
+
+       my $v;
+       my $curr_line = 1;
+
+       foreach my $l (split(/[\n\r]+/, $v_file)) {
+               $curr_line++;
+               # skip comments
+               next if ($l =~ m/^#/);
+
+               $l =~ s/^\s+//;
+               $l =~ s/\s+$//;
+
+               my @d = split(/\s+/, $l);
+
+               my $fld = shift @d || $log->logdie("need field name in line $curr_line: $l");
+
+               if (@d) {
+                       $v->{$fld}->{ref} = 'ARRAY';
+                       $v->{$fld}->{sf} = \@d;
+               } else {
+                       $v->{$fld}->{ref} = '';
+               }
+
+       }
+
+       $log->debug("current validation rules: ", Dumper($v));
+
+       $self->{rules} = $v;
+
+       $self ? return $self : return undef;
+}
+
+=head1 AUTHOR
+
+Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006 Dobrica Pavlinusic, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of WebPAC::Validate

diff --git a/t/0-load.t b/t/0-load.t
index aab26c6..06d6667 100644 (file)
--- a/t/0-load.t
+++ b/t/0-load.t
@@ -1,11 +1,12 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 12;
+use Test::More tests => 13;
 use blib;
 use strict;
 
 BEGIN {
 use_ok( 'WebPAC' );
+use_ok( 'WebPAC::Validate' );
 use_ok( 'WebPAC::Input' );
 use_ok( 'WebPAC::Input::ISIS' );
 use_ok( 'WebPAC::Store' );

diff --git a/t/1-validate.t b/t/1-validate.t
new file mode 100755 (executable)
index 0000000..7a65ab6
--- /dev/null
+++ b/t/1-validate.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 5;
+use Test::Exception;
+use blib;
+
+use Data::Dumper;
+use Cwd qw/abs_path/;
+
+BEGIN {
+use_ok( 'WebPAC::Validate' );
+}
+
+my $debug = shift @ARGV;
+
+ok(my $abs_path = abs_path($0), "abs_path");
+$abs_path =~ s#/[^/]*$#/#;
+
+throws_ok { new WebPAC::Validate( no_log => 1 ) } qr/need path/, "new without path";
+
+ok(my $v = new WebPAC::Validate(
+       path => "$abs_path/data/validate_test",
+), "new");
+
+ok($v->{rules}, "rules exist");