--- /dev/null
+package MooseX::AttributeHelpers::Composite;
+use Moose;
+
+extends 'Moose::Meta::Attribute';
+
+with qw(MooseX::AttributeHelpers::Composite::Trait);
+
+package # Over there, search.cpan! Run! Fetch!
+ Moose::Meta::Attribute::Custom::Composite;
+
+sub register_implementation { 'MooseX::AttributeHelpers::Composite' }
+
+1;
--- /dev/null
+package MooseX::AttributeHelpers::Composite::Trait;
+use Moose::Role;
+use MooseX::AttributeHelpers::MethodProvider;
+use MooseX::AttributeHelpers::Meta::Method::Provided;
+
+has provides => (
+ is => 'ro',
+ isa => 'HashRef',
+ default => sub { {} },
+);
+
+after install_accessors => sub {
+ my $attr = shift;
+ my $class = $attr->associated_class;
+
+ my $provides = $attr->provides;
+
+ foreach my $method_provider (keys %$provides) {
+ my $typename = get_provider_type($method_provider);
+ confess "Attribute must be of type $typename to use $method_provider"
+ unless ($attr->has_type_constraint
+ && $attr->type_constraint->is_a_type_of($typename));
+
+ my $spec = $provides->{$method_provider};
+ my $factories = get_provider_methods($method_provider, $spec);
+
+ foreach my $method_name (keys %$factories) {
+ confess "$method_name already exists in class " . $class->name
+ if $class->has_method($method_name);
+
+ my $method = MooseX::AttributeHelpers::Meta::Method::Provided->wrap(
+ $factories->{$method_name}->(
+ $attr,
+ $attr->get_read_method_ref,
+ $attr->get_write_method_ref
+ ),
+ );
+ $attr->associate_method($method);
+ $class->add_method($method_name => $method)
+ }
+ }
+};
+
+1;
--- /dev/null
+package MooseX::AttributeHelpers::MethodProvider;
+
+use strict;
+use warnings;
+
+use Carp qw(confess);
+use Exporter qw(import);
+our @EXPORT = qw(get_provider_methods add_method_provider get_provider_type);
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+my %REGISTRY;
+
+sub get_provider_type {
+ my $name = shift;
+ return $REGISTRY{$name}->{type} || confess "No provider named $name";
+}
+
+sub get_provider_methods {
+ my ($name, $how) = @_;
+ $how ||= q();
+
+ my $methods = $REGISTRY{$name}->{provides}
+ || confess "No provider named $name";
+
+ if ($how eq ':all') {
+ return $methods;
+ }
+
+ if (ref $how eq 'ARRAY') {
+ return {
+ map {
+ $_ => $methods->{$_} || confess "No factory named $_"
+ } (@$how)
+ };
+ }
+
+ if (ref $how eq 'HASH') {
+ return {
+ map {
+ my ($old, $new) = ($_, $how->{$_});
+ $new => $methods->{$old} || confess "No factory named $old"
+ } (keys %$how)
+ };
+ }
+
+ confess "Don't know to get provider methods by $how";
+}
+
+sub add_method_provider ($;%) {
+ my ($name, %options) = @_;
+
+ confess "Already a method provider named $name"
+ if exists $REGISTRY{$name};
+
+ my $method_map = $options{provides} or confess "No factories provided";
+
+ my $consumes = $options{consumes};
+ foreach my $provider (keys %$consumes) {
+ my $methods = get_provider_methods($provider, $consumes->{$provider});
+ foreach (keys %$methods) {
+ confess "Method $_ already provided" if exists $method_map->{$_};
+ $method_map->{$_} = $methods->{$_};
+ };
+ }
+
+ $REGISTRY{$name} = {
+ type => $options{type} || 'Any',
+ provides => $method_map,
+ };
+}
+
+1;
+++ /dev/null
-package MooseX::AttributeHelpers::MethodProvider::Array;
-use Moose::Role;
-use MooseX::AttributeHelpers::Collection::TypeCheck;
-
-our $VERSION = '0.05';
-our $AUTHORITY = 'cpan:STEVAN';
-
-with 'MooseX::AttributeHelpers::MethodProvider::List';
-
-sub push : method {
- my ($attr, $reader, $writer) = @_;
- return type_check($attr, sub {@_[1,$#_]}, sub {
- my $self = shift;
- CORE::push(@{ $reader->($self) }, @_);
- });
-}
-
-sub pop : method {
- my ($attr, $reader, $writer) = @_;
- return sub { CORE::pop(@{ $reader->($_[0]) }) };
-}
-
-sub unshift : method {
- my ($attr, $reader, $writer) = @_;
- return type_check($attr, sub {@_[1,$#_]}, sub {
- my $self = shift;
- CORE::unshift(@{ $reader->($self) }, @_);
- });
-}
-
-sub shift : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- CORE::shift(@{ $reader->($_[0]) });
- };
-}
-
-sub get : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my $self = shift;
- return @{ $reader->($self) }[@_];
- };
-}
-
-sub set : method {
- my ($attr, $reader, $writer) = @_;
- return type_check($attr, sub {@_[2,$#_]}, sub {
- my ($self, $index, @values) = @_;
- my @indexes = (ref $index eq 'ARRAY' ? @$index : ($index));
- @{ $reader->($self) }[@indexes] = @values;
- });
-}
-
-sub clear : method {
- my ($attr, $reader, $writer) = @_;
- return sub { @{ $reader->($_[0]) } = () };
-}
-
-sub delete : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- CORE::splice(@{ $reader->($_[0]) }, $_[1], $_[2] || 1);
- };
-}
-
-sub insert : method {
- my ($attr, $reader, $writer) = @_;
- return type_contraint($attr, sub {@_[2,$#_]}, sub {
- my ($self, $index, @values) = @_;
- CORE::splice(@{ $reader->($self) }, $index, 0, @values);
- });
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::AttributeHelpers::MethodProvider::Array
-
-=head1 DESCRIPTION
-
-This is a role which provides the method generators for
-L<MooseX::AttributeHelpers::Collection::Array>.
-
-=head1 PROVIDED METHODS
-
-This module consumes L<MooseX::AttributeHelpers::MethodProvider::List>, and so
-provides all of its methods as well. All methods work when multiple indexes
-are supplied - special cases are noted.
-
-=over 4
-
-=item B<get(@indexes)>
-
-Behaves just like indexing an arrayref: returns the items indexed by the
-supplied arguments (i.e. C<$self->get_my_stuff(1,2,3)> means
-C<@{$aref}[1,2,3]>).
-
-=item B<set($index, $value)>
-
-=item B<set([$indexes], @values)>
-
-This is just like assigning to an arrayref, except that an arrayref lets you
-assign multiple indexes at once with no strange syntax. You can do that with
-this set as well, but the first argument should be an arrayref of the keys you
-want to assign to. (e.g. C<$self->set_aref([1,2,3], qw(foo bar baz))>)
-
-=item B<pop>
-
-L<perlfunc/pop>
-
-=item B<push($item)>
-
-L<perlfunc/push>
-
-=item B<shift>
-
-L<perlfunc/shift>
-
-=item B<unshift($item)>
-
-L<perlfunc/unshift>
-
-=item B<clear>
-
-Deletes all items from the array.
-
-=item B<delete($index, $length)>
-
-Deletes $length (default: 1) items from the array at $index.
-
-=item B<insert($index, @items)>
-
-Inserts @items into list at $index.
-
-=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
-
-Stevan Little E<lt>stevan@iinteractive.comE<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
--- /dev/null
+package MooseX::AttributeHelpers::MethodProvider::Collection::Array;
+use MooseX::AttributeHelpers::MethodProvider;
+use MooseX::AttributeHelpers::MethodProvider::Util qw(type_check);
+use MooseX::AttributeHelpers::MethodProvider::Collection::List;
+
+our $VERSION = '0.05';
+our $AUTHORITY = 'cpan:STEVAN';
+
+add_method_provider 'Collection::Array' => (
+ type => 'ArrayRef',
+ consumes => { 'Collection::List' => ':all' },
+ provides => {
+ push => sub {
+ my ($attr, $reader, $writer) = @_;
+ return type_check($attr, sub {@_[1,$#_]}, sub {
+ my $self = shift;
+ CORE::push(@{ $reader->($self) }, @_);
+ });
+ },
+
+ pop => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::pop(@{ $reader->($_[0]) }) };
+ },
+
+ unshift => sub {
+ my ($attr, $reader, $writer) = @_;
+ return type_check($attr, sub {@_[1,$#_]}, sub {
+ my $self = shift;
+ CORE::unshift(@{ $reader->($self) }, @_);
+ });
+ },
+
+ shift => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ CORE::shift(@{ $reader->($_[0]) });
+ };
+ },
+
+ get => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $self = shift;
+ return @{ $reader->($self) }[@_];
+ };
+ },
+
+ set => sub {
+ my ($attr, $reader, $writer) = @_;
+ return type_check($attr, sub {@_[2,$#_]}, sub {
+ my ($self, $index, @values) = @_;
+ my @indexes = (ref $index eq 'ARRAY' ? @$index : ($index));
+ @{ $reader->($self) }[@indexes] = @values;
+ });
+ },
+
+ clear => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { @{ $reader->($_[0]) } = () };
+ },
+
+ delete => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ CORE::splice(@{ $reader->($_[0]) }, $_[1], $_[2] || 1);
+ };
+ },
+
+ insert => sub {
+ my ($attr, $reader, $writer) = @_;
+ return type_contraint($attr, sub {@_[2,$#_]}, sub {
+ my ($self, $index, @values) = @_;
+ CORE::splice(@{ $reader->($self) }, $index, 0, @values);
+ });
+ },
+ },
+);
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::MethodProvider::Array
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<MooseX::AttributeHelpers::Collection::Array>.
+
+=head1 PROVIDED METHODS
+
+This module consumes L<MooseX::AttributeHelpers::MethodProvider::List>, and so
+provides all of its methods as well. All methods work when multiple indexes
+are supplied - special cases are noted.
+
+=over 4
+
+=item B<get(@indexes)>
+
+Behaves just like indexing an arrayref: returns the items indexed by the
+supplied arguments (i.e. C<$self->get_my_stuff(1,2,3)> means
+C<@{$aref}[1,2,3]>).
+
+=item B<set($index, $value)>
+
+=item B<set([$indexes], @values)>
+
+This is just like assigning to an arrayref, except that an arrayref lets you
+assign multiple indexes at once with no strange syntax. You can do that with
+this set as well, but the first argument should be an arrayref of the keys you
+want to assign to. (e.g. C<$self->set_aref([1,2,3], qw(foo bar baz))>)
+
+=item B<pop>
+
+L<perlfunc/pop>
+
+=item B<push($item)>
+
+L<perlfunc/push>
+
+=item B<shift>
+
+L<perlfunc/shift>
+
+=item B<unshift($item)>
+
+L<perlfunc/unshift>
+
+=item B<clear>
+
+Deletes all items from the array.
+
+=item B<delete($index, $length)>
+
+Deletes $length (default: 1) items from the array at $index.
+
+=item B<insert($index, @items)>
+
+Inserts @items into list at $index.
+
+=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
+
+Stevan Little E<lt>stevan@iinteractive.comE<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
-package MooseX::AttributeHelpers::MethodProvider::Bag;
-use Moose::Role;
+package MooseX::AttributeHelpers::MethodProvider::Collection::Bag;
+use MooseX::AttributeHelpers::MethodProvider;
+use MooseX::AttributeHelpers::MethodProvider::Collection::ImmutableHash;
+use Moose::Util::TypeConstraints;
our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
-with 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash';
-
-sub add : method {
- my ($attr, $reader, $writer) = @_;
- return sub { $reader->($_[0])->{$_[1]}++ };
-}
-
-sub delete : method {
- my ($attr, $reader, $writer) = @_;
- return sub { CORE::delete $reader->($_[0])->{$_[1]} };
-}
-
-sub reset : method {
- my ($attr, $reader, $writer) = @_;
- return sub { $reader->($_[0])->{$_[1]} = 0 };
-}
+subtype 'Bag' => as 'HashRef[Int]';
+
+add_method_provider 'Collection::Bag' => (
+ type => 'Bag',
+ consumes => { 'Collection::ImmutableHash' => ':all' },
+ provides => {
+ add => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $reader->($_[0])->{$_[1]}++ };
+ },
+
+ delete => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::delete $reader->($_[0])->{$_[1]} };
+ },
+
+ reset => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $reader->($_[0])->{$_[1]} = 0 };
+ },
+ },
+);
1;
=head1 DESCRIPTION
This is a role which provides the method generators for
-L<MooseX::AttributeHelpers::Collection::Bag>. It also consumes
+L<MooseX::AttributeHelpers::Collection::Bag>. It also consumes
L<MooseX::AttributeHelpers::Collection::ImmutableHash>, and thus provides all
of its methods asw well.
--- /dev/null
+package MooseX::AttributeHelpers::MethodProvider::Collection::Hash;
+use MooseX::AttributeHelpers::MethodProvider;
+use MooseX::AttributeHelpers::MethodProvider::Util qw(type_check);
+use MooseX::AttributeHelpers::MethodProvider::Collection::ImmutableHash;
+
+our $VERSION = '0.04';
+our $AUTHORITY = 'cpan:STEVAN';
+
+add_method_provider 'Collection::Hash' => (
+ type => 'HashRef',
+ consumes => { 'Collection::ImmutableHash' => ':all' },
+ provides => {
+ set => sub {
+ my ($attr, $reader, $writer) = @_;
+ type_check(
+ $attr,
+ sub { my ($self, %pairs) = @_; return (values %pairs) },
+ sub {
+ my ($self, @pairs) = @_;
+ my $hash = $reader->($self);
+ while (@pairs) {
+ my $key = shift(@pairs);
+ my $value = shift(@pairs);
+ $hash->{$key} = $value;
+ }
+ },
+ );
+ },
+
+ clear => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { %{$reader->($_[0])} = () };
+ },
+
+ delete => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $hashref = $reader->(shift);
+ CORE::delete @{$hashref}{@_};
+ };
+ },
+ },
+);
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::MethodProvider::Hash
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<MooseX::AttributeHelpers::Collection::Hash>. It consumes
+L<MooseX::AttributeHelpers::MethodProvider::ImmutableHash>, and thus
+provides all its methods as wel.
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+Returns the number of items in the hash.
+
+=item B<delete(@keys)>
+
+Deletes the specified keys from the hash.
+
+=item B<clear>
+
+Deletes all keys from the hash.
+
+=item B<set>
+
+Sets the specified keys to the specified values. You can specify several of
+these at once, in key => value order.
+
+=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
+
+Stevan Little E<lt>stevan@iinteractive.comE<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
+
--- /dev/null
+package MooseX::AttributeHelpers::MethodProvider::Collection::ImmutableHash;
+use MooseX::AttributeHelpers::MethodProvider;
+
+our $VERSION = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
+
+add_method_provider 'Collection::ImmutableHash' => (
+ type => 'HashRef',
+ provides => {
+ exists => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::exists $reader->($_[0])->{$_[1]} };
+ },
+
+ get => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($self, @keys) = @_;
+ @{ $reader->($self) }{@keys}
+ };
+ },
+
+ keys => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::keys %{$reader->($_[0])} };
+ },
+
+ values => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::values %{$reader->($_[0])} };
+ },
+
+ kv => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $h = $reader->($_[0]);
+ map {
+ [ $_, $h->{$_} ]
+ } CORE::keys %{$h}
+ };
+ },
+
+ count => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { scalar CORE::keys %{$reader->($_[0])} };
+ },
+
+ # Deprecated. Does the opposite of what it claims to.
+ empty => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { scalar CORE::keys %{$reader->($_[0])} ? 1 : 0 };
+ },
+
+ is_empty => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::keys %{$reader->($_[0])} == 0 };
+ },
+
+ has_items => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::keys %{$reader->($_[0])} > 0 };
+ },
+ },
+);
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::MethodProvider::ImmutableHash
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<MooseX::AttributeHelpers::Collection::ImmutableHash>.
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+Returns the number of items in the hash.
+
+=item B<empty>
+
+DEPRECATED. This was a misleading name for what it does (returns a boolean
+indicating whether the hash is NOT empty), but we're keeping it for backwards
+compatibility. Do not use it in new code. Use is_empty or has_items instead,
+depending on what you meant.
+
+=item B<is_empty>
+
+Returns a boolean which is true if and only if the hash has no items in it.
+
+=item B<has_items>
+
+Returns a boolean which is true if and only if the hash has at least one item.
+
+=item B<exists>
+
+L<perlfunc/exists>
+
+=item B<get(@keys)>
+
+Gets the values specified by @keys from the hash.
+
+=item B<keys>
+
+L<perlfunc/keys>
+
+=item B<values>
+
+L<perlfunc/values>
+
+=item B<kv>
+
+Returns a list of arrayrefs, each of which is a key => value pair mapping.
+
+=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
+
+Stevan Little E<lt>stevan@iinteractive.comE<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
+
--- /dev/null
+package MooseX::AttributeHelpers::MethodProvider::Collection::List;
+use MooseX::AttributeHelpers::MethodProvider;
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+add_method_provider 'Collection::List' => (
+ type => 'ArrayRef',
+ provides => {
+ count => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { scalar @{$reader->($_[0])} };
+ },
+
+ # Deprecated. Does the opposite of its name.
+ empty => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { scalar @{$reader->($_[0])} ? 1 : 0 };
+ },
+
+ is_empty => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { @{ $reader->($_[0]) } == 0 };
+ },
+
+ has_items => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { @{ $reader->($_[0]) } > 0 };
+ },
+
+ find => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance, $predicate) = @_;
+ foreach my $val (@{$reader->($instance)}) {
+ return $val if $predicate->($val);
+ }
+ return;
+ };
+ },
+
+ map => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance, $f) = @_;
+ CORE::map { $f->($_) } @{$reader->($instance)}
+ };
+ },
+
+ grep => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance, $predicate) = @_;
+ CORE::grep { $predicate->($_) } @{$reader->($instance)}
+ };
+ },
+ },
+);
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::MethodProvider::List
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<MooseX::AttributeHelpers::Collection::List>.
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+Returns the number of items in the list.
+
+=item B<empty>
+
+DEPRECATED. This was a misleading name for what it does (returns a boolean
+indicating whether the list is NOT empty), but we're keeping it for backwards
+compatibility. Do not use it in new code. Use is_empty or has_items instead,
+depending on what you meant.
+
+=item B<is_empty>
+
+Returns a boolean which is true if and only if the list has no items in it.
+
+=item B<has_items>
+
+Returns a boolean which is true if and only if the list has at least one item.
+
+=item B<find($predicate)>
+
+Returns the first item in the list that satisfies $predicate.
+
+=item B<grep>
+
+L<perlfunc/grep>
+
+=item B<map>
+
+L<perlfunc/map>
+
+=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
+
+Stevan Little E<lt>stevan@iinteractive.comE<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
+++ /dev/null
-package MooseX::AttributeHelpers::MethodProvider::Hash;
-use Moose::Role;
-use MooseX::AttributeHelpers::Collection::TypeCheck;
-
-our $VERSION = '0.04';
-our $AUTHORITY = 'cpan:STEVAN';
-
-with 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash';
-
-sub set : method {
- my ($attr, $reader, $writer) = @_;
- type_check(
- $attr,
- sub {
- my ($self, %pairs) = @_;
- return (values %pairs);
- },
- sub {
- my ($self, @pairs) = @_;
- my $hash = $reader->($self);
- while (@pairs) {
- my $key = shift(@pairs);
- my $value = shift(@pairs);
- $hash->{$key} = $value;
- }
- },
- );
-}
-
-sub clear : method {
- my ($attr, $reader, $writer) = @_;
- return sub { %{$reader->($_[0])} = () };
-}
-
-sub delete : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my $hashref = $reader->(shift);
- CORE::delete @{$hashref}{@_};
- };
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::AttributeHelpers::MethodProvider::Hash
-
-=head1 DESCRIPTION
-
-This is a role which provides the method generators for
-L<MooseX::AttributeHelpers::Collection::Hash>. It consumes
-L<MooseX::AttributeHelpers::MethodProvider::ImmutableHash>, and thus
-provides all its methods as wel.
-
-=head1 PROVIDED METHODS
-
-=over 4
-
-=item B<count>
-
-Returns the number of items in the hash.
-
-=item B<delete(@keys)>
-
-Deletes the specified keys from the hash.
-
-=item B<clear>
-
-Deletes all keys from the hash.
-
-=item B<set>
-
-Sets the specified keys to the specified values. You can specify several of
-these at once, in key => value order.
-
-=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
-
-Stevan Little E<lt>stevan@iinteractive.comE<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
-
+++ /dev/null
-package MooseX::AttributeHelpers::MethodProvider::ImmutableHash;
-use Moose::Role;
-
-our $VERSION = '0.03';
-our $AUTHORITY = 'cpan:STEVAN';
-
-sub exists : method {
- my ($attr, $reader, $writer) = @_;
- return sub { CORE::exists $reader->($_[0])->{$_[1]} };
-}
-
-sub get : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my ($self, @keys) = @_;
- @{ $reader->($self) }{@keys}
- };
-}
-
-sub keys : method {
- my ($attr, $reader, $writer) = @_;
- return sub { CORE::keys %{$reader->($_[0])} };
-}
-
-sub values : method {
- my ($attr, $reader, $writer) = @_;
- return sub { CORE::values %{$reader->($_[0])} };
-}
-
-sub kv : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my $h = $reader->($_[0]);
- map {
- [ $_, $h->{$_} ]
- } CORE::keys %{$h}
- };
-}
-
-sub count : method {
- my ($attr, $reader, $writer) = @_;
- return sub { scalar CORE::keys %{$reader->($_[0])} };
-}
-
-# Deprecated. The author was thinking backwardsly when this was written.
-sub empty : method {
- my ($attr, $reader, $writer) = @_;
- return sub { scalar CORE::keys %{$reader->($_[0])} ? 1 : 0 };
-}
-
-sub is_empty : method {
- my ($attr, $reader, $writer) = @_;
- return sub { CORE::keys %{$reader->($_[0])} == 0 };
-}
-
-sub has_items : method {
- my ($attr, $reader, $writer) = @_;
- return sub { CORE::keys %{$reader->($_[0])} > 0 };
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::AttributeHelpers::MethodProvider::ImmutableHash
-
-=head1 DESCRIPTION
-
-This is a role which provides the method generators for
-L<MooseX::AttributeHelpers::Collection::ImmutableHash>.
-
-=head1 PROVIDED METHODS
-
-=over 4
-
-=item B<count>
-
-Returns the number of items in the hash.
-
-=item B<empty>
-
-DEPRECATED. This was a misleading name for what it does (returns a boolean
-indicating whether the hash is NOT empty), but we're keeping it for backwards
-compatibility. Do not use it in new code. Use is_empty or has_items instead,
-depending on what you meant.
-
-=item B<is_empty>
-
-Returns a boolean which is true if and only if the hash has no items in it.
-
-=item B<has_items>
-
-Returns a boolean which is true if and only if the hash has at least one item.
-
-=item B<exists>
-
-L<perlfunc/exists>
-
-=item B<get(@keys)>
-
-Gets the values specified by @keys from the hash.
-
-=item B<keys>
-
-L<perlfunc/keys>
-
-=item B<values>
-
-L<perlfunc/values>
-
-=item B<kv>
-
-Returns a list of arrayrefs, each of which is a key => value pair mapping.
-
-=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
-
-Stevan Little E<lt>stevan@iinteractive.comE<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
-
+++ /dev/null
-package MooseX::AttributeHelpers::MethodProvider::List;
-use Moose::Role;
-
-our $VERSION = '0.01';
-our $AUTHORITY = 'cpan:STEVAN';
-
-sub count : method {
- my ($attr, $reader, $writer) = @_;
- return sub { scalar @{$reader->($_[0])} };
-}
-
-# Deprecated. The author was thinking backwardsly when this was written.
-sub empty : method {
- my ($attr, $reader, $writer) = @_;
- return sub { scalar @{$reader->($_[0])} ? 1 : 0 };
-}
-
-sub is_empty : method {
- my ($attr, $reader, $writer) = @_;
- return sub { @{ $reader->($_[0]) } == 0 };
-}
-
-sub has_items : method {
- my ($attr, $reader, $writer) = @_;
- return sub { @{ $reader->($_[0]) } > 0 };
-}
-
-sub find : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my ($instance, $predicate) = @_;
- foreach my $val (@{$reader->($instance)}) {
- return $val if $predicate->($val);
- }
- return;
- };
-}
-
-sub map : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my ($instance, $f) = @_;
- CORE::map { $f->($_) } @{$reader->($instance)}
- };
-}
-
-sub grep : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my ($instance, $predicate) = @_;
- CORE::grep { $predicate->($_) } @{$reader->($instance)}
- };
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::AttributeHelpers::MethodProvider::List
-
-=head1 DESCRIPTION
-
-This is a role which provides the method generators for
-L<MooseX::AttributeHelpers::Collection::List>.
-
-=head1 PROVIDED METHODS
-
-=over 4
-
-=item B<count>
-
-Returns the number of items in the list.
-
-=item B<empty>
-
-DEPRECATED. This was a misleading name for what it does (returns a boolean
-indicating whether the list is NOT empty), but we're keeping it for backwards
-compatibility. Do not use it in new code. Use is_empty or has_items instead,
-depending on what you meant.
-
-=item B<is_empty>
-
-Returns a boolean which is true if and only if the list has no items in it.
-
-=item B<has_items>
-
-Returns a boolean which is true if and only if the list has at least one item.
-
-=item B<find($predicate)>
-
-Returns the first item in the list that satisfies $predicate.
-
-=item B<grep>
-
-L<perlfunc/grep>
-
-=item B<map>
-
-L<perlfunc/map>
-
-=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
-
-Stevan Little E<lt>stevan@iinteractive.comE<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
-package MooseX::AttributeHelpers::Collection::TypeCheck;
+package MooseX::AttributeHelpers::MethodProvider::Util;
+use strict;
+use warnings;
+
use Exporter qw(import);
use Carp qw(confess);
-our @EXPORT = qw(type_check);
+our @EXPORT_OK = qw(type_check);
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
=head1 NAME
-MooseX::AttributeHelpers::Collection::TypeCheck
+MooseX::AttributeHelpers::MethodProvider::Util
=head1 SYNOPSIS
- use MooseX::AttributeHelpers::Collection::TypeCheck;
+ use MooseX::AttributeHelpers::MethodProvider;
+ use MooseX::AttributeHelpers::MethodProvider::Util qw(type_check);
+
+ add_method_provider 'Collection::Array' => (
+ type => 'ArrayRef',
+ provides => {
+ push => sub {
+ my ($attr, $reader, $writer) = @_;
+ return type_check($attr, sub {@_[1,$#_]}, sub {
+ my $self = shift;
+ push(@{ $reader->($self) }, @_);
+ });
+ },
+ }
+ );
- 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.
+This module provides one function (type_check) which is not exported unless
+requested. It is useful when writing method providers for that involve checks
+on parameterized types.
=head1 SUBROUTINES
+++ /dev/null
-
-package MooseX::AttributeHelpers::Sugar;
-use Carp qw(confess);
-use Exporter qw(import);
-our @EXPORT = qw(define_attribute_helper);
-
-sub define_attribute_helper (%) {
- my %info = @_;
- my $class = caller();
- my $meta = $class->meta;
-
- $meta->add_method('helper_type', sub {$info{helper_type}});
- $meta->add_method('default_options', sub {$info{default_options}});
- $meta->add_method('auto_provide', sub {$info{auto_provide} || 0});
-
- if(my $provider = $info{method_provider}) {
- eval "require $provider";
- confess "Error loading method provider" if $@;
- $meta->add_attribute('+method_provider', default => $provider);
- }
-
- if (my $cons = $info{method_constructors}) {
- $meta->add_attribute('+method_constructors', default => $cons)
- }
-
- if (my $s = $info{shortcut}) {
- $meta->create("Moose::Meta::Attribute::Custom::$s",
- methods => {register_implementation => sub { $class }},
- );
- }
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::AttributeHelpers::Sugar - Convenience for defining AttributeHelper
-metaclasses.
-
-=head1 SYNOPSIS
-
- package MooseX::AttributeHelpers::Counter;
- use Moose;
- use MooseX::AttributeHelpers::Sugar;
-
- extends 'MooseX::AttributeHelpers::Base';
-
- define_attribute_helper (
- default_options => {
- is => 'ro',
- default => 0,
- },
-
- helper_type => 'Num',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::Counter',
- auto_provide => 1,
- shortcut => 'Counter',
- );
-
- no Moose;
- no MooseX::AttributeHelpers::Sugar;
-
- 1;
-
-=head1 DESCRIPTION
-
-This is just sugar to let you declaratively subclass
-L<MooseX::AttributeHelpers::Base>. You still need to explicitly subclass, but
-most of the boilerplate is taken care of for you by the sugar. One function is
-exported.
-
-=over 4
-
-=item B<define_attribute_helper>
-
-The following parameters are accepted, and are used to override methods in
-the base class (see L<its documentation|MooseX::AttributeHelpers::Base> for
-details).
-
-=item B<default_options> I<HashRef>
-
-=item B<helper_type> I<String>
-
-=item B<auto_provide> I<Bool>
-
-=item B<method_provider> I<ClassName>
-
-=item B<method_constructors> I<HashRef>
-
-=back
-
-=head1 SHORTCUT
-
-For ease of use of the generated metaclasses, if you pass in a "shortcut"
-parameter to define_attribute_helper, a class at
-Moose::Meta::Attribute::Custom::$shortcut will be generated for you, which
-allows clients of your class to specify their metaclass by this shortcut
-(without the long prefix).
-
-=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 at cpan.org E<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
projects / gitmo/MooseX-AttributeHelpers.git / commitdiff