From 20141033691c58360beff1f1d6329bbe5108a647 Mon Sep 17 00:00:00 2001
From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Sun, 20 May 2007 16:19:16 +0000
Subject: [PATCH]  r1212@llin:  dpavlin | 2007-05-20 17:39:01 +0200  first try
 at implementation of delimiters validation

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@827 07558da8-63fa-0310-ba24-9fe276d99e06
---
 lib/WebPAC/Validate.pm    | 32 +++++++++++++++++++++--
 t/1-validate-delimiters.t | 55 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 85 insertions(+), 2 deletions(-)
 create mode 100755 t/1-validate-delimiters.t

diff --git a/lib/WebPAC/Validate.pm b/lib/WebPAC/Validate.pm
index 55dc374..dafe201 100644
--- 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.10
+Version 0.11
 
 =cut
 
-our $VERSION = '0.10';
+our $VERSION = '0.11';
 
 =head1 SYNOPSIS
 
@@ -52,8 +52,13 @@ Create new validation object
 
   my $validate = new WebPAC::Validate(
   	path => 'conf/validate/file',
+	delimiters => [ ' : ', ' / ', ' ; ', ' , ' ],
   );
 
+Optional parametar C<delimiters> will turn on validating of delimiters. Be
+careful here, those delimiters are just stuck into regex, so they can
+contain L<perlre> regexpes.
+
 =cut
 
 sub new {
@@ -114,6 +119,11 @@ sub new {
 
 	$log->info("validation uses rules from $self->{path}");
 
+	if ( $self->{delimiters} ) {
+		$self->{delimiters_regex} = '(\^[a-z0-9]|' . join('|', @{ $self->{delimiters} }) . ')';
+		$log->info("validation check delimiters with regex $self->{delimiters_regex}");
+	}
+
 	$self ? return $self : return undef;
 }
 
@@ -146,6 +156,22 @@ sub validate_rec {
 
 		next if (!defined($f) || $f eq '' || $f eq '000');
 
+		# first check delimiters
+		if ( my $regex = $self->{delimiters_regex} ) {
+
+			my $template = '';
+
+			foreach my $v (@{ $rec->{$f} }) {
+					warn "## v = ", dump( $v );
+					my $l = _pack_subfields_hash( $v, 1 );
+					warn "## $l [$regex]\n";
+					$l =~ s/$regex/$template.=$1/eg && warn "## new: $l\n";
+					warn "## template: $template\n";
+					$self->{_delimiters_templates}->{$f}->{$template}++;
+			}
+
+		}
+
 		next if (defined( $self->{dont_validate}->{$f} ));
 
 		# track field usage
@@ -222,6 +248,8 @@ sub validate_rec {
 		}
 	}
 
+	$log->debug("_delimiters_templates = ", dump( $self->{_delimiters_templates} ) );
+
 	foreach my $must (sort keys %{ $self->{must_exist} }) {
 		next if ($fields->{$must});
 		$errors->{$must}->{missing}++;
diff --git a/t/1-validate-delimiters.t b/t/1-validate-delimiters.t
new file mode 100755
index 0000000..8a16e4f
--- /dev/null
+++ b/t/1-validate-delimiters.t
@@ -0,0 +1,55 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 4;
+use Test::Exception;
+use blib;
+
+use Data::Dump qw/dump/;
+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#/[^/]*$#/#;
+
+ok(my $v = new WebPAC::Validate(
+	path => "$abs_path/data/validate_test",
+	delimiters => [ ' : ', ' ; ', ' / ', ' \. ' ],
+	debug => $debug,
+), "new");
+
+diag "rules = ", dump( $v->{rules} );
+
+$v->{rules} = {};
+
+sub test_v {
+	my $row = shift || die "no row?";
+
+	my $d = dump( $row );
+
+	$row->{'000'} = [ 42 ];
+
+	$v->reset_errors;
+	my $e = $v->validate_rec( $row );
+
+	diag ">> validate $d\n",dump($e) if ($debug);
+}
+
+test_v({
+	'900' => [ { 'a' => 'a : aa = aaa : a ; a', 'b' => 'b ; b ; b ; b ; a : / z . z . ' }, { 'c' => 'a : b ; c / d' } ]
+});
+
+diag dump($v->{_delimiters_templates});
+
+is_deeply( $v->{_delimiters_templates}, {
+	900 => {
+		"^a :  :  ; ^b ;  ;  ;  ;  :  .  . "            => 1,
+		"^a :  :  ; ^b ;  ;  ;  ;  :  .  . ^c :  ;  / " => 1,
+	},
+}, 'just subfields and delimiters');
+
-- 
2.20.1