added required subfields

[webpac2] / lib / WebPAC / Validate.pm

diff --git a/lib/WebPAC/Validate.pm b/lib/WebPAC/Validate.pm
index b87dfe9..d553f71 100644 (file)
--- a/lib/WebPAC/Validate.pm
+++ b/lib/WebPAC/Validate.pm
@@ -18,11 +18,11 @@ WebPAC::Validate - provide simple validation for records
 
 =head1 VERSION
 
-Version 0.03
+Version 0.04
 
 =cut
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
 
 =head1 SYNOPSIS
 
@@ -91,7 +91,13 @@ sub new {
                $log->logdie("need field name in line $curr_line: $l") unless (defined($fld));
 
                if (@d) {
-                       $v->{$fld} = \@d;
+                       $v->{$fld} = [ map {
+                               my $sf = $_;
+                               if ( $sf =~ s/!(\*)?$/$1/ ) {
+                                       $self->{must_exist_sf}->{ $fld }->{ $sf }++;
+                               };
+                               $sf;
+                       } @d ];
                } else {
                        $v->{$fld} = 1;
                }
@@ -163,8 +169,12 @@ sub validate_errors {
 
                                        delete($v->{subfields}) if (defined($v->{subfields}));
 
+                                       my $subfields;
+
                                        foreach my $sf (keys %{ $v }) {
 
+                                               $subfields->{ $sf }++;
+
                                                # is non-repeatable but with multiple values?
                                                if ( ! first { $_ eq $sf.'*' } @{$r->{$f}} ) {
                                                        if ( ref($v->{$sf}) eq 'ARRAY' ) {
@@ -186,6 +196,18 @@ sub validate_errors {
                                                'repeatable in: ' .
                                                join('', _pack_subfields_hash( $h, 1) );
                                        }
+
+                                       if ( defined( $self->{must_exist_sf}->{$f} ) ) {
+                                               foreach my $sf (sort keys %{ $self->{must_exist_sf}->{$f} }) {
+warn "====> $f $sf must exist\n";
+                                                       push @errors, "$f missing required subfield $sf"
+                                                               unless (
+                                                                       defined( $subfields->{$f} ) &&
+                                                                       defined( $subfields->{$f}->{$sf} )
+                                                               )
+                                               }
+                                       }
+
                                }
                        } elsif (ref($v) eq 'HASH') {
                                push @errors, "$f has subfields which is not valid";