t/007_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 21;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 ## Roles
  14
  15 {
  16     package Constraint;
  17     use strict;
  18     use warnings;
  19     use Moose::Role;
  20
  21     has 'value' => (isa => 'Num', is => 'ro');
  22
  23     around 'validate' => sub {
  24         my $c = shift;
  25         my ($self, $field) = @_;
  26         return undef if $c->($self, $self->validation_value($field));
  27         return $self->error_message;
  28     };
  29
  30     sub validation_value {
  31         my ($self, $field) = @_;
  32         return $field;
  33     }
  34
  35     sub error_message { confess "Abstract method!" }
  36
  37     package Constraint::OnLength;
  38     use strict;
  39     use warnings;
  40     use Moose::Role;
  41
  42     has 'units' => (isa => 'Str', is => 'ro');
  43
  44     override 'validation_value' => sub {
  45         return length(super());
  46     };
  47
  48     override 'error_message' => sub {
  49         my $self = shift;
  50         return super() . ' ' . $self->units;
  51     };
  52
  53 }
  54
  55 ## Classes
  56
  57 {
  58     package Constraint::AtLeast;
  59     use strict;
  60     use warnings;
  61     use Moose;
  62
  63     with 'Constraint';
  64
  65     sub validate {
  66         my ($self, $field) = @_;
  67         ($field >= $self->value);
  68     }
  69
  70     sub error_message { 'must be at least ' . (shift)->value; }
  71
  72     package Constraint::NoMoreThan;
  73     use strict;
  74     use warnings;
  75     use Moose;
  76
  77     with 'Constraint';
  78
  79     sub validate {
  80         my ($self, $field) = @_;
  81         ($field <= $self->value);
  82     }
  83
  84     sub error_message { 'must be no more than ' . (shift)->value; }
  85
  86     package Constraint::LengthNoMoreThan;
  87     use strict;
  88     use warnings;
  89     use Moose;
  90
  91     extends 'Constraint::NoMoreThan';
  92        with 'Constraint::OnLength';
  93
  94     package Constraint::LengthAtLeast;
  95     use strict;
  96     use warnings;
  97     use Moose;
  98
  99     extends 'Constraint::AtLeast';
 100        with 'Constraint::OnLength';
 101 }
 102
 103 my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10);
 104 isa_ok($no_more_than_10, 'Constraint::NoMoreThan');
 105
 106 ok($no_more_than_10->does('Constraint'), '... Constraint::NoMoreThan does Constraint');
 107
 108 ok(!defined($no_more_than_10->validate(1)), '... validated correctly');
 109 is($no_more_than_10->validate(11), 'must be no more than 10', '... validation failed correctly');
 110
 111 my $at_least_10 = Constraint::AtLeast->new(value => 10);
 112 isa_ok($at_least_10, 'Constraint::AtLeast');
 113
 114 ok($at_least_10->does('Constraint'), '... Constraint::AtLeast does Constraint');
 115
 116 ok(!defined($at_least_10->validate(11)), '... validated correctly');
 117 is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly');
 118
 119 # onlength
 120
 121 my $no_more_than_10_chars = Constraint::LengthNoMoreThan->new(value => 10, units => 'chars');
 122 isa_ok($no_more_than_10_chars, 'Constraint::LengthNoMoreThan');
 123 isa_ok($no_more_than_10_chars, 'Constraint::NoMoreThan');
 124
 125 ok($no_more_than_10_chars->does('Constraint'), '... Constraint::LengthNoMoreThan does Constraint');
 126 ok($no_more_than_10_chars->does('Constraint::OnLength'), '... Constraint::LengthNoMoreThan does Constraint::OnLength');
 127
 128 ok(!defined($no_more_than_10_chars->validate('foo')), '... validated correctly');
 129 is($no_more_than_10_chars->validate('foooooooooo'),
 130     'must be no more than 10 chars',
 131     '... validation failed correctly');
 132
 133 my $at_least_10_chars = Constraint::LengthAtLeast->new(value => 10, units => 'chars');
 134 isa_ok($at_least_10_chars, 'Constraint::LengthAtLeast');
 135 isa_ok($at_least_10_chars, 'Constraint::AtLeast');
 136
 137 ok($at_least_10_chars->does('Constraint'), '... Constraint::LengthAtLeast does Constraint');
 138 ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLeast does Constraint::OnLength');
 139
 140 ok(!defined($at_least_10_chars->validate('barrrrrrrrr')), '... validated correctly');
 141 is($at_least_10_chars->validate('bar'), 'must be at least 10 chars', '... validation failed correctly');
 142