t/200_examples/001_example.t

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