18 |
|
|
19 |
=head1 VERSION |
=head1 VERSION |
20 |
|
|
21 |
Version 0.10 |
Version 0.11 |
22 |
|
|
23 |
=cut |
=cut |
24 |
|
|
25 |
our $VERSION = '0.10'; |
our $VERSION = '0.11'; |
26 |
|
|
27 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
28 |
|
|
52 |
|
|
53 |
my $validate = new WebPAC::Validate( |
my $validate = new WebPAC::Validate( |
54 |
path => 'conf/validate/file', |
path => 'conf/validate/file', |
55 |
|
delimiters => [ ' : ', ' / ', ' ; ', ' , ' ], |
56 |
); |
); |
57 |
|
|
58 |
|
Optional parametar C<delimiters> will turn on validating of delimiters. Be |
59 |
|
careful here, those delimiters are just stuck into regex, so they can |
60 |
|
contain L<perlre> regexpes. |
61 |
|
|
62 |
=cut |
=cut |
63 |
|
|
64 |
sub new { |
sub new { |
119 |
|
|
120 |
$log->info("validation uses rules from $self->{path}"); |
$log->info("validation uses rules from $self->{path}"); |
121 |
|
|
122 |
|
if ( $self->{delimiters} ) { |
123 |
|
$self->{delimiters_regex} = '(\^[a-z0-9]|' . join('|', @{ $self->{delimiters} }) . ')'; |
124 |
|
$log->info("validation check delimiters with regex $self->{delimiters_regex}"); |
125 |
|
} |
126 |
|
|
127 |
$self ? return $self : return undef; |
$self ? return $self : return undef; |
128 |
} |
} |
129 |
|
|
156 |
|
|
157 |
next if (!defined($f) || $f eq '' || $f eq '000'); |
next if (!defined($f) || $f eq '' || $f eq '000'); |
158 |
|
|
159 |
|
# first check delimiters |
160 |
|
if ( my $regex = $self->{delimiters_regex} ) { |
161 |
|
|
162 |
|
foreach my $v (@{ $rec->{$f} }) { |
163 |
|
my $l = _pack_subfields_hash( $v, 1 ); |
164 |
|
my $template = ''; |
165 |
|
$l =~ s/$regex/$template.=$1/eg; |
166 |
|
# warn "## template: $template\n"; |
167 |
|
$self->{_delimiters_templates}->{$f}->{$template}++ if ( $template ); |
168 |
|
} |
169 |
|
|
170 |
|
} |
171 |
|
|
172 |
next if (defined( $self->{dont_validate}->{$f} )); |
next if (defined( $self->{dont_validate}->{$f} )); |
173 |
|
|
174 |
# track field usage |
# track field usage |
245 |
} |
} |
246 |
} |
} |
247 |
|
|
248 |
|
$log->debug("_delimiters_templates = ", dump( $self->{_delimiters_templates} ) ); |
249 |
|
|
250 |
foreach my $must (sort keys %{ $self->{must_exist} }) { |
foreach my $must (sort keys %{ $self->{must_exist} }) { |
251 |
next if ($fields->{$must}); |
next if ($fields->{$must}); |
252 |
$errors->{$must}->{missing}++; |
$errors->{$must}->{missing}++; |