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