File Coverage

blib/lib/MooseX/Meta/Signature/Positional.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package MooseX::Meta::Signature::Positional;
2              
3 2     2   4819 use Moose;
  0            
  0            
4              
5             use Moose::Util qw/does_role/;
6             use MooseX::Meta::Parameter::Moose;
7             use MooseX::Method::Exception;
8             use Scalar::Util qw/blessed/;
9              
10             with qw/MooseX::Meta::Signature/;
11              
12             our $VERSION = '0.01';
13              
14             our $AUTHORITY = 'cpan:BERLE';
15              
16             sub _parameter_metaclass { 'MooseX::Meta::Parameter::Moose' }
17              
18             sub new {
19             my ($class,@parameters) = @_;
20              
21             my $self = $class->meta->new_object;
22              
23             $self->{'@!parameter_map'} = [];
24              
25             foreach my $parameter (@parameters) {
26             if (ref $parameter eq 'HASH') {
27             if (exists $parameter->{metaclass}) {
28             $parameter = $parameter->{metaclass}->new ($parameter);
29             } else {
30             $parameter = $self->_parameter_metaclass->new ($parameter);
31             }
32             }
33              
34             MooseX::Method::Exception->throw ("Parameter must be a MooseX::Meta::Parameter or coercible into one")
35             unless does_role ($parameter,'MooseX::Meta::Parameter');
36              
37             push @{$self->{'@!parameter_map'}},$parameter;
38             }
39              
40             return $self;
41             }
42              
43             sub validate {
44             my $self = shift;
45              
46             my @args;
47              
48             my $pos;
49              
50             eval {
51             for (0 .. $#{$self->{'@!parameter_map'}}) {
52             $pos = $_;
53              
54             push @args,$self->{'@!parameter_map'}->[$_]->validate (( $_ <= $#_ ? $_[$_] : ()));
55             }
56             };
57              
58             if ($@) {
59             if (blessed $@ && $@->isa ('MooseX::Method::Exception')) {
60             $@->error ("Parameter $pos: " . $@->error);
61              
62             $@->rethrow;
63             } else {
64             die $@;
65             }
66             }
67              
68             return @args;
69             }
70              
71             sub export {
72             my ($self) = @_;
73              
74             my $export = [];
75              
76             push @$export,$_->export
77             for @{$self->{'@!parameter_map'}};
78              
79             return $export;
80             }
81              
82             __PACKAGE__->meta->make_immutable(inline_constructor => 0);
83              
84             1;
85              
86             __END__
87              
88             =pod
89              
90             =head1 NAME
91              
92             MooseX::Meta::Signature::Positional - Positional signature metaclass
93              
94             =head1 WARNING
95              
96             This API is unstable, it may change at any time. This should not
97             affect ordinary L<MooseX::Method> usage.
98              
99             =head1 SYNOPSIS
100              
101             use MooseX::Meta::Signature::Positional;
102              
103             my $signature = MooseX::Meta::Signature::Positional->new (
104             { required => 1 }
105             );
106              
107             my @results;
108              
109             eval {
110             @results = $signature->validate (42);
111             };
112              
113             =head1 METHODS
114              
115             =over 4
116              
117             =item B<validate>
118              
119             Validate the arguments against the signature. Returns a list of the
120             validated arguments or throws an exception on validation error.
121              
122             =item B<export>
123              
124             Exports a data structure representing the signature.
125              
126             =back
127              
128             =head1 BUGS
129              
130             Most software has bugs. This module probably isn't an exception.
131             If you find a bug please either email me, or add the bug to cpan-RT.
132              
133             =head1 AUTHOR
134              
135             Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
136              
137             =head1 COPYRIGHT AND LICENSE
138              
139             Copyright 2007 by Anders Nor Berle.
140              
141             This library is free software; you can redistribute it and/or modify
142             it under the same terms as Perl itself.
143              
144             =cut
145