git.rot13.org Git - webpac2/blob - lib/WebPAC/Validate.pm

   1 package WebPAC::Validate;
   2
   3 use warnings;
   4 use strict;
   5
   6 use blib;
   7
   8 use base 'WebPAC::Common';
   9 use File::Slurp;
  10 use Data::Dumper;
  11
  12 =head1 NAME
  13
  14 WebPAC::Validate - provide simple validation for records
  15
  16 =head1 VERSION
  17
  18 Version 0.01
  19
  20 =cut
  21
  22 our $VERSION = '0.01';
  23
  24 =head1 SYNOPSIS
  25
  26 This module provide a simple way to validate your file against a simple
  27 configuration file in following format:
  28
  29   # field 10 doesn't have any subfields
  30   10
  31   # same with 101
  32   101
  33   # field 200 have valid subfields a-g
  34   200 a b c d e f g
  35   # field 205 can have only subfield a
  36   205 a
  37   # while 210 can have a c or d
  38   210 a c d
  39
  40 =head1 FUNCTIONS
  41
  42 =head2 new
  43
  44 Create new validation object
  45
  46   my $validate = new WebPAC::Validate(
  47         path => '/path/to/input/validate_file',
  48   );
  49
  50 =cut
  51
  52 sub new {
  53         my $class = shift;
  54         my $self = {@_};
  55         bless($self, $class);
  56
  57         my $log = $self->_get_logger();
  58
  59         foreach my $p (qw/path/) {
  60                 $log->logconfess("need $p") unless ($self->{$p});
  61         }
  62
  63         my $v_file = read_file( $self->{path} ) ||
  64                 $log->logdie("can't open validate path $self->{path}: $!");
  65
  66         my $v;
  67         my $curr_line = 1;
  68
  69         foreach my $l (split(/[\n\r]+/, $v_file)) {
  70                 $curr_line++;
  71                 # skip comments
  72                 next if ($l =~ m/^#/);
  73
  74                 $l =~ s/^\s+//;
  75                 $l =~ s/\s+$//;
  76
  77                 my @d = split(/\s+/, $l);
  78
  79                 my $fld = shift @d || $log->logdie("need field name in line $curr_line: $l");
  80
  81                 if (@d) {
  82                         $v->{$fld}->{ref} = 'ARRAY';
  83                         $v->{$fld}->{sf} = \@d;
  84                 } else {
  85                         $v->{$fld}->{ref} = '';
  86                 }
  87
  88         }
  89
  90         $log->debug("current validation rules: ", Dumper($v));
  91
  92         $self->{rules} = $v;
  93
  94         $self ? return $self : return undef;
  95 }
  96
  97 =head1 AUTHOR
  98
  99 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 100
 101 =head1 COPYRIGHT & LICENSE
 102
 103 Copyright 2006 Dobrica Pavlinusic, All Rights Reserved.
 104
 105 This program is free software; you can redistribute it and/or modify it
 106 under the same terms as Perl itself.
 107
 108 =cut
 109
 110 1; # End of WebPAC::Validate