our
$VERSION
=
'0.01'
;
our
$AUTHORITY
=
'cpan:BERLE'
;
sub
_parameter_metaclass {
'MooseX::Meta::Parameter::Moose'
}
sub
new {
my
(
$class
,
%parameters
) =
@_
;
my
$self
=
$class
->meta->new_object;
$self
->{
'%!parameter_map'
} = {};
for
(
keys
%parameters
) {
my
$parameter
=
$parameters
{
$_
};
if
(
ref
$parameter
eq
'HASH'
) {
if
(
exists
$parameter
->{metaclass}) {
$parameter
=
$parameter
->{metaclass}->new (
$parameter
);
}
else
{
$parameter
=
$self
->_parameter_metaclass->new (
$parameter
);
}
}
MooseX::Method::Exception->throw (
"Parameter must be a MooseX::Meta::Parameter or coercible into one"
)
unless
does_role (
$parameter
,
'MooseX::Meta::Parameter'
);
$self
->{
'%!parameter_map'
}->{
$_
} =
$parameter
;
}
return
$self
;
}
sub
validate {
my
$self
=
shift
;
my
$args
;
if
(
ref
$_
[0] eq
'HASH'
) {
$args
=
$_
[0];
}
else
{
$args
= {
@_
};
}
my
$name
;
eval
{
for
(
keys
%{
$self
->{
'%!parameter_map'
}}) {
$name
=
$_
;
$args
->{
$_
} =
$self
->{
'%!parameter_map'
}->{
$_
}->validate ((
exists
$args
->{
$_
} ?
$args
->{
$_
} : ()));
}
};
if
($@) {
if
(blessed $@ && $@->isa (
'MooseX::Method::Exception'
)) {
$@->error (
"Parameter ($name): "
. $@->error);
$@->rethrow;
}
else
{
die
$@;
}
}
return
$args
;
}
sub
export {
my
(
$self
) =
@_
;
my
$export
= {};
$export
->{
$_
} =
$self
->{
'%!parameter_map'
}->{
$_
}->export
for
keys
%{
$self
->{
'%!parameter_map'
}};
return
$export
;
}
__PACKAGE__->meta->make_immutable(
inline_constructor
=> 0);
1;