t/200_examples/001_example.t

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