From: Paul Driver Date: Tue, 8 Apr 2008 17:55:13 +0000 (+0000) Subject: Hmm. I think I did something odd in here... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e993b282cf63b60c6c52987cd9f6ac93a27eba22;p=gitmo%2FMooseX-AttributeHelpers.git Hmm. I think I did something odd in here... --- diff --git a/lib/MooseX/AttributeHelpers/Collection/Array.pm b/lib/MooseX/AttributeHelpers/Collection/Array.pm index 7c2acf7..47e7b90 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Array.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Array.pm @@ -1,27 +1,21 @@ package MooseX::AttributeHelpers::Collection::Array; use Moose; +use MooseX::AttributeHelpers::Sugar; + +extends 'MooseX::AttributeHelpers::Collection'; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Array; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Array' +define_attribute_helper ( + helper_type => 'ArrayRef', + method_provider => 'MooseX::AttributeHelpers::MethodProvider::Array', + shortcut => 'Collection::Array', ); -sub helper_type { 'ArrayRef' } - no Moose; - -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::Collection::Array; -sub register_implementation { 'MooseX::AttributeHelpers::Collection::Array' } - +no MooseX::AttributeHelpers::Sugar; 1; @@ -53,22 +47,12 @@ MooseX::AttributeHelpers::Collection::Array =head1 DESCRIPTION This module provides an Array attribute which provides a number of -array operations. See L -for more details. - -=head1 METHODS - -=over 4 - -=item B - -=item B - -=item B +array operations. -=item B +=head1 PROVIDED METHODS -=back +The methods for this metaclass are provided by +L. =head1 BUGS diff --git a/lib/MooseX/AttributeHelpers/Collection/Bag.pm b/lib/MooseX/AttributeHelpers/Collection/Bag.pm index 48bb388..09beebe 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Bag.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Bag.pm @@ -2,40 +2,25 @@ package MooseX::AttributeHelpers::Collection::Bag; use Moose; use Moose::Util::TypeConstraints; +use MooseX::AttributeHelpers::Sugar; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Bag; - extends 'MooseX::AttributeHelpers::Collection'; -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Bag' -); - subtype 'Bag' => as 'HashRef[Int]'; -sub helper_type { 'Bag' } - -before 'process_options_for_provides' => sub { - my ($self, $options, $name) = @_; - - # Set some default attribute options here unless already defined - if ((my $type = $self->helper_type) && !exists $options->{isa}){ - $options->{isa} = $type; - } - - $options->{default} = sub { +{} } unless exists $options->{default}; -}; +define_attribute_helper ( + default_options => { default => sub { {} } }, + helper_type => 'Bag', + method_provider => 'MooseX::AttributeHelpers::MethodProvider::Bag', + shortcut => 'Collection::Bag', +); no Moose; no Moose::Util::TypeConstraints; - -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::Collection::Bag; -sub register_implementation { 'MooseX::AttributeHelpers::Collection::Bag' } +no MooseX::AttributeHelpers::Sugar; 1; @@ -72,21 +57,10 @@ This module provides a Bag attribute which provides a number of bag-like operations. See L for more details. -=head1 METHODS - -=over 4 - -=item B - -=item B - -=item B - -=item B - -=item B +=head1 PROVIDED METHODS -=back +The methods for this metaclass are provided by +L. =head1 BUGS @@ -107,4 +81,4 @@ L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut diff --git a/lib/MooseX/AttributeHelpers/Collection/Hash.pm b/lib/MooseX/AttributeHelpers/Collection/Hash.pm index eddb3e4..c2d6acb 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Hash.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Hash.pm @@ -1,27 +1,21 @@ package MooseX::AttributeHelpers::Collection::Hash; use Moose; +use MooseX::AttributeHelpers::Sugar; + +extends 'MooseX::AttributeHelpers::Collection'; our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Hash; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Hash' +define_attribute_helper ( + helper_type => 'HashRef', + method_provider => 'MooseX::AttributeHelpers::MethodProvider::Hash', + shortcut => 'Collection::Hash', ); -sub helper_type { 'HashRef' } - no Moose; - -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::Collection::Hash; -sub register_implementation { 'MooseX::AttributeHelpers::Collection::Hash' } - +no MooseX::AttributeHelpers::Sugar; 1; @@ -59,19 +53,10 @@ This module provides an Hash attribute which provides a number of hash-like operations. See L for more details. -=head1 METHODS - -=over 4 - -=item B - -=item B - -=item B - -=item B +=head1 PROVIDED METHODS -=back +The methods for this metaclass are provided by +L. =head1 BUGS @@ -92,4 +77,4 @@ L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut diff --git a/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm b/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm index a0c7566..fc9b06e 100644 --- a/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm +++ b/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm @@ -1,27 +1,22 @@ package MooseX::AttributeHelpers::Collection::ImmutableHash; use Moose; +use MooseX::AttributeHelpers::Sugar; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::ImmutableHash; - extends 'MooseX::AttributeHelpers::Collection'; -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash' +define_attribute_helper ( + helper_type => 'HashRef', + method_provider => + 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash', + shortcut => 'Collection::ImmutableHash', ); -sub helper_type { 'HashRef' } - no Moose; - -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::Collection::ImmutableHash; -sub register_implementation { 'MooseX::AttributeHelpers::Collection::ImmutableHash' } - +no MooseX::AttributeHelpers::Sugar; 1; @@ -54,22 +49,12 @@ MooseX::AttributeHelpers::Collection::ImmutableHash =head1 DESCRIPTION This module provides a immutable HashRef attribute which provides a number of -hash-line operations. See L -for more details. - -=head1 METHODS - -=over 4 - -=item B - -=item B - -=item B +hash-like operations. -=item B +=head1 PROVIDED METHODS -=back +The methods for this metaclass are provided by +L. =head1 BUGS @@ -90,4 +75,4 @@ L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut diff --git a/lib/MooseX/AttributeHelpers/Collection/List.pm b/lib/MooseX/AttributeHelpers/Collection/List.pm index bc62680..272f95f 100644 --- a/lib/MooseX/AttributeHelpers/Collection/List.pm +++ b/lib/MooseX/AttributeHelpers/Collection/List.pm @@ -1,27 +1,21 @@ package MooseX::AttributeHelpers::Collection::List; use Moose; +use MooseX::AttributeHelpers::Sugar; + +extends 'MooseX::AttributeHelpers::Collection'; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::List; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::List' +define_attribute_helper ( + helper_type => 'ArrayRef', + method_provider => 'MooseX::AttributeHelpers::MethodProvider::List', + shortcut => 'Collection::List', ); -sub helper_type { 'ArrayRef' } - no Moose; - -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::Collection::List; -sub register_implementation { 'MooseX::AttributeHelpers::Collection::List' } - +no MooseX::AttributeHelpers::Sugar; 1; @@ -53,22 +47,12 @@ MooseX::AttributeHelpers::Collection::List =head1 DESCRIPTION This module provides an List attribute which provides a number of -list operations. See L -for more details. - -=head1 METHODS - -=over 4 - -=item B - -=item B - -=item B +list operations. -=item B +=head1 PROVIDED METHODS -=back +The methods for this metaclass are provided by +L. =head1 BUGS diff --git a/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm b/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm new file mode 100644 index 0000000..024ff1c --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm @@ -0,0 +1,86 @@ +package MooseX::AttributeHelpers::Collection::TypeCheck; +use Exporter qw(import); +use Carp qw(confess); +our @EXPORT = qw(type_check); + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +sub type_check { + my ($attribute, $get_values, $method) = @_; + if ($attribute->has_type_constraint && $attribute->type_constraint->isa( + 'Moose::Meta::TypeConstraint::Parameterized')) { + my $constraint = $attribute->type_constraint->type_parameter; + return sub { + foreach my $v ($get_values->(@_)) { + unless ($constraint->check($v)) { + $v = 'undef' unless (defined $v); + confess "Value $v didn't pass container type constraint."; + } + } + goto $method; + }; + } + return $method; +} + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::TypeCheck + +=head1 SYNOPSIS + + use MooseX::AttributeHelpers::Collection::TypeCheck; + + sub push : method { + my ($attr, $reader, $writer) = @_; + return type_check($attr, sub {@_[1,$#_]}, sub { + my $self = shift; + CORE::push(@{ $reader->($self) }, @_); + }); + } + +=head1 DESCRIPTION + +This module provides one function (type_check) which is exported by default. +It is useful when writing method providers for that involve checks on +parameterized types. + +=head1 SUBROUTINES + +=over 4 + +=item type_check I + +Attribute should be the attribute you wish to do the check on, get_values a +method that will return the values to perform the check on, and method the +actual provided method sans type checks. If the attribute is not a +parameterized type, the method will simply be returned unmodified. If it is, +however, the method will be wrapped with another method that checks the types +of the values provided by get_values to ensure that they meet the type +requirements of the provided attribute. + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Paul Driver Efrodwith@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut