Commit | Line | Data |
a7d0cd00 |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
6 | Moose::Cookbook::Recipe6 - The Moose::Role example |
7 | |
8 | =head1 SYNOPSIS |
9 | |
10 | package Constraint; |
11 | use strict; |
12 | use warnings; |
13 | use Moose::Role; |
14 | |
15 | has 'value' => (isa => 'Int', is => 'ro'); |
16 | |
17 | around 'validate' => sub { |
18 | my $c = shift; |
19 | my ($self, $field) = @_; |
20cf91c1 |
20 | return undef if $c->($self, $self->validation_value($field)); |
21 | return $self->error_message; |
a7d0cd00 |
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 strict; |
33 | use warnings; |
34 | use Moose::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 | package Constraint::AtLeast; |
48 | use strict; |
49 | use warnings; |
50 | use Moose; |
51 | |
52 | with 'Constraint'; |
53 | |
54 | sub validate { |
55 | my ($self, $field) = @_; |
56 | ($field >= $self->value); |
57 | } |
58 | |
59 | sub error_message { 'must be at least ' . (shift)->value; } |
60 | |
61 | package Constraint::NoMoreThan; |
62 | use strict; |
63 | use warnings; |
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 strict; |
77 | use warnings; |
78 | use Moose; |
79 | |
80 | extends 'Constraint::NoMoreThan'; |
81 | with 'Constraint::OnLength'; |
82 | |
83 | package Constraint::LengthAtLeast; |
84 | use strict; |
85 | use warnings; |
86 | use Moose; |
87 | |
88 | extends 'Constraint::AtLeast'; |
89 | with 'Constraint::OnLength'; |
90 | |
91 | =head1 DESCRIPTION |
92 | |
93 | Coming Soon. |
94 | |
a7d0cd00 |
95 | =head1 AUTHOR |
96 | |
97 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
98 | |
99 | =head1 COPYRIGHT AND LICENSE |
100 | |
101 | Copyright 2006 by Infinity Interactive, Inc. |
102 | |
103 | L<http://www.iinteractive.com> |
104 | |
105 | This library is free software; you can redistribute it and/or modify |
106 | it under the same terms as Perl itself. |
107 | |
108 | =cut |
109 | |