Dogcows Code - chaz/p5-CGI-Ex/blob - t/1_validate_07_yaml.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 ### single group
  32 $v = '
  33 user:
  34   required: 1
  35 foo:
  36   required_if: bar
  37 ';
  38
  39 $e = &validate({}, $v);
  40 &print_ok($e);
  41 $e = &validate({user => 1}, $v);
  42 &print_ok(! $e);
  43 $e = &validate({user => 1, bar => 1}, $v);
  44 &print_ok($e);
  45 $e = &validate({user => 1, bar => 1, foo => 1}, $v);
  46 &print_ok(! $e);
  47
  48
  49 ### three groups, some with validate_if's - using arrayref
  50 $v = '
  51 - group validate_if: foo
  52   bar:
  53     required: 1
  54 - group validate_if: hem
  55   haw: { required: 1 }
  56 - raspberry:
  57     required: 1
  58 ';
  59
  60 $e = &validate({}, $v);
  61 &print_ok($e);
  62
  63 $e = &validate({
  64   raspberry => 'tart',
  65 }, $v);
  66 &print_ok(! $e);
  67
  68 $e = &validate({
  69   foo => 1,
  70   raspberry => 'tart',
  71 }, $v);
  72 &print_ok($e);
  73
  74 $e = &validate({
  75   foo => 1,
  76   bar => 1,
  77   raspberry => 'tart',
  78 }, $v);
  79 &print_ok(! $e);
  80
  81 $e = &validate({
  82   foo => 1,
  83   bar => 1,
  84   hem => 1,
  85   raspberry => 'tart',
  86 }, $v);
  87 &print_ok($e);
  88
  89 $e = &validate({
  90   foo => 1,
  91   bar => 1,
  92   hem => 1,
  93   haw => 1,
  94   raspberry => 'tart',
  95 }, $v);
  96 &print_ok(! $e);
  97
  98
  99 ### three groups, some with validate_if's - using documents
 100 $v = '---
 101 group validate_if: foo
 102 bar:
 103   required: 1
 104 ---
 105 group validate_if: hem
 106 haw: { required: 1 }
 107 ---
 108 raspberry:
 109   required: 1
 110 ';
 111
 112 $e = &validate({}, $v);
 113 &print_ok($e);
 114
 115 $e = &validate({
 116   raspberry => 'tart',
 117 }, $v);
 118 &print_ok(! $e);
 119
 120 $e = &validate({
 121   foo => 1,
 122   raspberry => 'tart',
 123 }, $v);
 124 &print_ok($e);
 125
 126 $e = &validate({
 127   foo => 1,
 128   bar => 1,
 129   raspberry => 'tart',
 130 }, $v);
 131 &print_ok(! $e);
 132
 133 $e = &validate({
 134   foo => 1,
 135   bar => 1,
 136   hem => 1,
 137   raspberry => 'tart',
 138 }, $v);
 139 &print_ok($e);
 140
 141 $e = &validate({
 142   foo => 1,
 143   bar => 1,
 144   hem => 1,
 145   haw => 1,
 146   raspberry => 'tart',
 147 }, $v);
 148 &print_ok(! $e);
 149
 150 __DATA__