Hmm, the same warnings as Moose seems difficult.
[gitmo/Mouse.git] / 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