60 |
careful here, those delimiters are just stuck into regex, so they can |
careful here, those delimiters are just stuck into regex, so they can |
61 |
contain L<perlre> regexpes. |
contain L<perlre> regexpes. |
62 |
|
|
63 |
|
C<path> and C<delimiters_path> can be specified by L<read_validate_file> and |
64 |
|
L<read_validate_delimiters> calls. |
65 |
|
|
66 |
=cut |
=cut |
67 |
|
|
68 |
sub new { |
sub new { |
72 |
|
|
73 |
my $log = $self->_get_logger(); |
my $log = $self->_get_logger(); |
74 |
|
|
75 |
$log->logdie("need path or delimiters_path") unless ( $self->{path} || $self->{delimiters_path} ); |
$self->read_validate_file( $self->{path} ) if ( $self->{path} ); |
76 |
|
|
77 |
if ( $self->{path} ) { |
if ( $self->{delimiters} ) { |
78 |
|
$self->{delimiters_regex} = '(\^[a-z0-9]|' . join('|', @{ $self->{delimiters} }) . ')'; |
79 |
|
$log->info("validation check delimiters with regex $self->{delimiters_regex}"); |
80 |
|
} |
81 |
|
|
82 |
my $v_file = read_file( $self->{path} ) || |
$self->read_validate_delimiters_file( $self->{delimiters_path} ) if ( $self->{delimiters_path} ); |
|
$log->logdie("can't open validate path $self->{path}: $!"); |
|
83 |
|
|
84 |
my $v; |
return $self; |
85 |
my $curr_line = 1; |
} |
86 |
|
|
|
foreach my $l (split(/[\n\r]+/, $v_file)) { |
|
|
$curr_line++; |
|
87 |
|
|
88 |
# skip comments and whitespaces |
=head2 read_validate_file |
|
next if ($l =~ /^#/ || $l =~ /^\s*$/); |
|
89 |
|
|
90 |
$l =~ s/^\s+//; |
Specify validate rules file |
|
$l =~ s/\s+$//; |
|
91 |
|
|
92 |
my @d = split(/\s+/, $l); |
$validate->read_validate_file( 'conf/validate/file' ); |
93 |
|
|
94 |
my $fld = shift @d; |
Returns number of lines in file |
95 |
|
|
96 |
if ($fld =~ s/!$//) { |
=cut |
|
$self->{must_exist}->{$fld}++; |
|
|
} elsif ($fld =~ s/-$//) { |
|
|
$self->{dont_validate}->{$fld}++; |
|
|
} |
|
97 |
|
|
98 |
$log->logdie("need field name in line $curr_line: $l") unless (defined($fld)); |
sub read_validate_file { |
99 |
|
my $self = shift; |
100 |
|
|
101 |
if (@d) { |
my $path = shift || die "no path?"; |
|
$v->{$fld} = [ map { |
|
|
my $sf = $_; |
|
|
if ( $sf =~ s/!(\*)?$/$1/ ) { |
|
|
$self->{must_exist_sf}->{ $fld }->{ $sf }++; |
|
|
}; |
|
|
$sf; |
|
|
} @d ]; |
|
|
} else { |
|
|
$v->{$fld} = 1; |
|
|
} |
|
102 |
|
|
103 |
|
my $log = $self->_get_logger(); |
104 |
|
|
105 |
|
my $v_file = read_file( $path ) || |
106 |
|
$log->logdie("can't open validate path $path: $!"); |
107 |
|
|
108 |
|
my $v; |
109 |
|
my $curr_line = 1; |
110 |
|
|
111 |
|
foreach my $l (split(/[\n\r]+/, $v_file)) { |
112 |
|
$curr_line++; |
113 |
|
|
114 |
|
# skip comments and whitespaces |
115 |
|
next if ($l =~ /^#/ || $l =~ /^\s*$/); |
116 |
|
|
117 |
|
$l =~ s/^\s+//; |
118 |
|
$l =~ s/\s+$//; |
119 |
|
|
120 |
|
my @d = split(/\s+/, $l); |
121 |
|
|
122 |
|
my $fld = shift @d; |
123 |
|
|
124 |
|
if ($fld =~ s/!$//) { |
125 |
|
$self->{must_exist}->{$fld}++; |
126 |
|
} elsif ($fld =~ s/-$//) { |
127 |
|
$self->{dont_validate}->{$fld}++; |
128 |
} |
} |
129 |
|
|
130 |
$log->debug("current validation rules: ", dump($v)); |
$log->logdie("need field name in line $curr_line: $l") unless (defined($fld)); |
131 |
|
|
132 |
$self->{rules} = $v; |
if (@d) { |
133 |
|
$v->{$fld} = [ map { |
134 |
|
my $sf = $_; |
135 |
|
if ( $sf =~ s/!(\*)?$/$1/ ) { |
136 |
|
$self->{must_exist_sf}->{ $fld }->{ $sf }++; |
137 |
|
}; |
138 |
|
$sf; |
139 |
|
} @d ]; |
140 |
|
} else { |
141 |
|
$v->{$fld} = 1; |
142 |
|
} |
143 |
|
|
|
$log->info("validation uses rules from $self->{path}"); |
|
144 |
} |
} |
145 |
|
|
146 |
if ( $self->{delimiters} ) { |
$log->debug("current validation rules: ", dump($v)); |
147 |
$self->{delimiters_regex} = '(\^[a-z0-9]|' . join('|', @{ $self->{delimiters} }) . ')'; |
|
148 |
$log->info("validation check delimiters with regex $self->{delimiters_regex}"); |
$self->{rules} = $v; |
149 |
} |
|
150 |
|
$log->info("validation uses rules from $path"); |
151 |
|
|
152 |
|
return $curr_line; |
153 |
|
} |
154 |
|
|
155 |
|
=head2 read_validate_delimiters_file |
156 |
|
|
157 |
if ( my $path = $self->{delimiters_path} ) { |
$validate->read_validate_delimiters_file( 'conf/validate/delimiters/file' ); |
158 |
if ( -e $path ) { |
|
159 |
$log->info("using delimiter validation rules from $path"); |
=cut |
160 |
open(my $d, $path) || $log->fatal("can't open $path: $!"); |
|
161 |
while(<$d>) { |
sub read_validate_delimiters_file { |
162 |
chomp($d); |
my $self = shift; |
163 |
if (/^\s*(#*)\s*(\d+)\t+(\d+)\t+(.*)$/) { |
|
164 |
my ($comment,$field,$count,$template) = ($1,$2,$3,$4); |
my $path = shift || die "no path?"; |
165 |
$self->{_validate_delimiters_templates}->{$field}->{$template} = $count unless ($comment); |
|
166 |
} else { |
my $log = $self->_get_logger(); |
167 |
warn "## ignored $d\n"; |
|
168 |
} |
if ( -e $path ) { |
169 |
|
$log->info("using delimiter validation rules from $path"); |
170 |
|
open(my $d, $path) || $log->fatal("can't open $path: $!"); |
171 |
|
while(<$d>) { |
172 |
|
chomp($d); |
173 |
|
if (/^\s*(#*)\s*(\d+)\t+(\d+)\t+(.*)$/) { |
174 |
|
my ($comment,$field,$count,$template) = ($1,$2,$3,$4); |
175 |
|
$self->{_validate_delimiters_templates}->{$field}->{$template} = $count unless ($comment); |
176 |
|
} else { |
177 |
|
warn "## ignored $d\n"; |
178 |
} |
} |
|
close($d); |
|
|
#warn "_validate_delimiters_templates = ",dump( $self->{_validate_delimiters_templates} ); |
|
|
} else { |
|
|
$log->warn("delimiters path $path doesn't exist, it will be created after this run"); |
|
179 |
} |
} |
180 |
|
close($d); |
181 |
|
#warn "_validate_delimiters_templates = ",dump( $self->{_validate_delimiters_templates} ); |
182 |
|
} else { |
183 |
|
$log->warn("delimiters path $path doesn't exist, it will be created after this run"); |
184 |
} |
} |
|
|
|
|
$self ? return $self : return undef; |
|
185 |
} |
} |
186 |
|
|
187 |
=head2 validate_rec |
=head2 validate_rec |