CRLF to LF
[gitmo/Mouse.git] / t / 200_examples / 001_example.t
CommitLineData
7a50b450 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 20;
7use 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
89my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10);
90isa_ok($no_more_than_10, 'Constraint::NoMoreThan');
91
92ok($no_more_than_10->does('Constraint'), '... Constraint::NoMoreThan does Constraint');
93
94ok(!defined($no_more_than_10->validate(1)), '... validated correctly');
95is($no_more_than_10->validate(11), 'must be no more than 10', '... validation failed correctly');
96
97my $at_least_10 = Constraint::AtLeast->new(value => 10);
98isa_ok($at_least_10, 'Constraint::AtLeast');
99
100ok($at_least_10->does('Constraint'), '... Constraint::AtLeast does Constraint');
101
102ok(!defined($at_least_10->validate(11)), '... validated correctly');
103is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly');
104
105# onlength
106
107my $no_more_than_10_chars = Constraint::LengthNoMoreThan->new(value => 10, units => 'chars');
108isa_ok($no_more_than_10_chars, 'Constraint::LengthNoMoreThan');
109isa_ok($no_more_than_10_chars, 'Constraint::NoMoreThan');
110
111ok($no_more_than_10_chars->does('Constraint'), '... Constraint::LengthNoMoreThan does Constraint');
112ok($no_more_than_10_chars->does('Constraint::OnLength'), '... Constraint::LengthNoMoreThan does Constraint::OnLength');
113
114ok(!defined($no_more_than_10_chars->validate('foo')), '... validated correctly');
115is($no_more_than_10_chars->validate('foooooooooo'),
116 'must be no more than 10 chars',
117 '... validation failed correctly');
118
119my $at_least_10_chars = Constraint::LengthAtLeast->new(value => 10, units => 'chars');
120isa_ok($at_least_10_chars, 'Constraint::LengthAtLeast');
121isa_ok($at_least_10_chars, 'Constraint::AtLeast');
122
123ok($at_least_10_chars->does('Constraint'), '... Constraint::LengthAtLeast does Constraint');
124ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLeast does Constraint::OnLength');
125
126ok(!defined($at_least_10_chars->validate('barrrrrrrrr')), '... validated correctly');
127is($at_least_10_chars->validate('bar'), 'must be at least 10 chars', '... validation failed correctly');
128