Commit | Line | Data |
684db121 |
1 | package Mouse::Meta::TypeConstraint; |
2 | use strict; |
3 | use warnings; |
9c85e9dc |
4 | use Carp (); |
5 | |
684db121 |
6 | use overload '""' => sub { shift->{name} }, # stringify to tc name |
7 | fallback => 1; |
8 | |
9 | sub new { |
10 | my $class = shift; |
11 | my %args = @_; |
12 | my $name = $args{name} || '__ANON__'; |
13 | |
14 | my $check = $args{_compiled_type_constraint} or Carp::croak("missing _compiled_type_constraint"); |
15 | if (ref $check eq 'Mouse::Meta::TypeConstraint') { |
16 | $check = $check->{_compiled_type_constraint}; |
17 | } |
18 | |
29607c02 |
19 | bless +{ |
20 | name => $name, |
21 | _compiled_type_constraint => $check, |
22 | message => $args{message} |
23 | }, $class; |
684db121 |
24 | } |
25 | |
26 | sub name { shift->{name} } |
27 | |
28 | sub check { |
29 | my $self = shift; |
30 | $self->{_compiled_type_constraint}->(@_); |
31 | } |
32 | |
9c85e9dc |
33 | sub validate { |
34 | my ($self, $value) = @_;\r |
35 | if ($self->{_compiled_type_constraint}->($value)) {\r |
36 | return undef;\r |
37 | }\r |
38 | else {\r |
39 | $self->get_message($value);\r |
40 | }\r |
41 | } |
42 | |
43 | sub assert_valid {\r |
44 | my ($self, $value) = @_;\r |
45 | \r |
46 | my $error = $self->validate($value);\r |
47 | return 1 if ! defined $error;\r |
48 | |
49 | Carp::confess($error);\r |
50 | }\r |
51 | |
52 | |
29607c02 |
53 | sub message { |
54 | return $_[0]->{message}; |
55 | } |
56 | |
57 | sub get_message { |
58 | my ($self, $value) = @_; |
59 | if ( my $msg = $self->message ) { |
60 | local $_ = $value; |
61 | return $msg->($value); |
62 | } |
63 | else { |
64 | $value = ( defined $value ? overload::StrVal($value) : 'undef' ); |
65 | return |
66 | "Validation failed for '" |
67 | . $self->name |
68 | . "' failed with value $value"; |
69 | } |
70 | } |
71 | |
90fe520e |
72 | sub is_a_type_of{ |
73 | my($self, $tc_name) = @_; |
74 | |
75 | return $self->name eq $tc_name |
76 | || $self->name =~ /\A $tc_name \[/xms; # "ArrayRef" =~ "ArrayRef[Foo]" |
77 | } |
78 | |
684db121 |
79 | 1; |
80 | __END__ |
81 | |
82 | =head1 NAME |
83 | |
84 | Mouse::Meta::TypeConstraint - The Mouse Type Constraint Metaclass |
85 | |
86 | =head1 DESCRIPTION |
87 | |
88 | For the most part, the only time you will ever encounter an |
89 | instance of this class is if you are doing some serious deep |
90 | introspection. This API should not be considered final, but |
91 | it is B<highly unlikely> that this will matter to a regular |
92 | Mouse user. |
93 | |
94 | Don't use this. |
95 | |
96 | =head1 METHODS |
97 | |
98 | =over 4 |
99 | |
100 | =item B<new> |
101 | |
102 | =item B<name> |
103 | |
104 | =back |
105 | |
106 | =cut |
107 | |