t/200_examples/001_example.t

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