t/200_examples/001_example.t

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