Hmm. I think I did something odd in here...
Paul Driver [Tue, 8 Apr 2008 17:55:13 +0000 (17:55 +0000)]
lib/MooseX/AttributeHelpers/Collection/Array.pm
lib/MooseX/AttributeHelpers/Collection/Bag.pm
lib/MooseX/AttributeHelpers/Collection/Hash.pm
lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm
lib/MooseX/AttributeHelpers/Collection/List.pm
lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm [new file with mode: 0644]

index 7c2acf7..47e7b90 100644 (file)
@@ -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<MooseX::AttributeHelpers::MethodProvider::Array>
-for more details.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=item B<method_provider>
-
-=item B<has_method_provider>
+array operations. 
 
-=item B<helper_type>
+=head1 PROVIDED METHODS
 
-=back
+The methods for this metaclass are provided by
+L<MooseX::AttributeHelpers::MethodProvider::Array>.
 
 =head1 BUGS
 
index 48bb388..09beebe 100644 (file)
@@ -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<MooseX::AttributeHelpers::MethodProvider::Bag>
 for more details.
 
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=item B<method_provider>
-
-=item B<has_method_provider>
-
-=item B<helper_type>
-
-=item B<process_options_for_provides>
+=head1 PROVIDED METHODS
 
-=back
+The methods for this metaclass are provided by
+L<MooseX::AttributeHelpers::MethodProvider::Bag>.
 
 =head1 BUGS
 
@@ -107,4 +81,4 @@ L<http://www.iinteractive.com>
 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
index eddb3e4..c2d6acb 100644 (file)
@@ -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<MooseX::AttributeHelpers::MethodProvider::Hash>
 for more details.
 
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=item B<method_provider>
-
-=item B<has_method_provider>
-
-=item B<helper_type>
+=head1 PROVIDED METHODS
 
-=back
+The methods for this metaclass are provided by
+L<MooseX::AttributeHelpers::MethodProvider::Hash>.
 
 =head1 BUGS
 
@@ -92,4 +77,4 @@ L<http://www.iinteractive.com>
 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
index a0c7566..fc9b06e 100644 (file)
@@ -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<MooseX::AttributeHelpers::MethodProvider::ImmutableHash>
-for more details.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=item B<method_provider>
-
-=item B<has_method_provider>
+hash-like operations. 
 
-=item B<helper_type>
+=head1 PROVIDED METHODS
 
-=back
+The methods for this metaclass are provided by
+L<MooseX::AttributeHelpers::MethodProvider::ImmutableHash>.
 
 =head1 BUGS
 
@@ -90,4 +75,4 @@ L<http://www.iinteractive.com>
 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
index bc62680..272f95f 100644 (file)
@@ -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<MooseX::AttributeHelpers::MethodProvider::List>
-for more details.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=item B<method_provider>
-
-=item B<has_method_provider>
+list operations. 
 
-=item B<helper_type>
+=head1 PROVIDED METHODS
 
-=back
+The methods for this metaclass are provided by
+L<MooseX::AttributeHelpers::MethodProvider::List>.
 
 =head1 BUGS
 
diff --git a/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm b/lib/MooseX/AttributeHelpers/Collection/TypeCheck.pm
new file mode 100644 (file)
index 0000000..024ff1c
--- /dev/null
@@ -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, get_values, method>
+
+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 E<lt>frodwith@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut