Dogcows Code - chaz/p5-CGI-Ex/blob - t/1_validate_08_yaml_file.t

   1 # -*- Mode: Perl; -*-
   2
   3 use strict;
   4
   5 $^W = 1;
   6
   7 ### determine number of tests
   8 seek(DATA,0,0);
   9 my $prog  = join "", <DATA>;
  10 my @tests = ($prog =~ /&print_ok\(/g);
  11 my $tests = @tests;
  12 print "1..$tests\n";
  13
  14 require CGI::Ex::Validate;
  15
  16 my ($N, $v, $e, $ok) = (0);
  17
  18 sub validate {
  19   return scalar &CGI::Ex::Validate::validate(@_);
  20 }
  21 sub print_ok {
  22   my $ok = shift;
  23   $N ++;
  24   warn "Test failed at line ".(caller)[2]."\n" if ! $ok;
  25   print "" . ($ok ? "" : "not ") . "ok $N\n";
  26 }
  27 &print_ok(1);
  28
  29 ###----------------------------------------------------------------###
  30
  31 ### where are my samples
  32 my $dir = __FILE__;
  33 $dir =~ tr|\\|/|; # should probably use File::Spec
  34 $dir =~ s|[^/]+$|samples| || die "Couldn't determine dir";
  35 $dir =~ s|^t/|./t/|; # to satisfy conf
  36
  37 ### single group
  38 $v = "$dir/yaml1.val";
  39
  40 $e = &validate({}, $v);
  41 &print_ok($e);
  42 $e = &validate({user => 1}, $v);
  43 &print_ok(! $e);
  44 $e = &validate({user => 1, bar => 1}, $v);
  45 &print_ok($e);
  46 $e = &validate({user => 1, bar => 1, foo => 1}, $v);
  47 &print_ok(! $e);
  48
  49
  50 ### single group - default extension
  51 $v = "$dir/yaml1";
  52
  53 $e = &validate({}, $v);
  54 &print_ok($e);
  55 $e = &validate({user => 1}, $v);
  56 &print_ok(! $e);
  57 $e = &validate({user => 1, bar => 1}, $v);
  58 &print_ok($e);
  59 $e = &validate({user => 1, bar => 1, foo => 1}, $v);
  60 &print_ok(! $e);
  61
  62
  63 ### three groups, some with validate_if's - using arrayref
  64 $v = "$dir/yaml2.val";
  65
  66 $e = &validate({}, $v);
  67 &print_ok($e);
  68
  69 $e = &validate({
  70   raspberry => 'tart',
  71 }, $v);
  72 &print_ok(! $e);
  73
  74 $e = &validate({
  75   foo => 1,
  76   raspberry => 'tart',
  77 }, $v);
  78 &print_ok($e);
  79
  80 $e = &validate({
  81   foo => 1,
  82   bar => 1,
  83   raspberry => 'tart',
  84 }, $v);
  85 &print_ok(! $e);
  86
  87 $e = &validate({
  88   foo => 1,
  89   bar => 1,
  90   hem => 1,
  91   raspberry => 'tart',
  92 }, $v);
  93 &print_ok($e);
  94
  95 $e = &validate({
  96   foo => 1,
  97   bar => 1,
  98   hem => 1,
  99   haw => 1,
 100   raspberry => 'tart',
 101 }, $v);
 102 &print_ok(! $e);
 103
 104
 105 ### three groups, some with validate_if's - using documents
 106 $v = "$dir/yaml3.val";
 107
 108 $e = &validate({}, $v);
 109 &print_ok($e);
 110
 111 $e = &validate({
 112   raspberry => 'tart',
 113 }, $v);
 114 &print_ok(! $e);
 115
 116 $e = &validate({
 117   foo => 1,
 118   raspberry => 'tart',
 119 }, $v);
 120 &print_ok($e);
 121
 122 $e = &validate({
 123   foo => 1,
 124   bar => 1,
 125   raspberry => 'tart',
 126 }, $v);
 127 &print_ok(! $e);
 128
 129 $e = &validate({
 130   foo => 1,
 131   bar => 1,
 132   hem => 1,
 133   raspberry => 'tart',
 134 }, $v);
 135 &print_ok($e);
 136
 137 $e = &validate({
 138   foo => 1,
 139   bar => 1,
 140   hem => 1,
 141   haw => 1,
 142   raspberry => 'tart',
 143 }, $v);
 144 &print_ok(! $e);
 145
 146 __DATA__