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;
=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
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;
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
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
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;
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
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
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;
=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
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
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;
=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
--- /dev/null
+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