- The warning for 'no associated methods' is now split out into the
check_associated_methods method, so that extensions can safely call
'after install_accessors => ...'. (hdp)
+ - Move currying syntax for delegation in from AttributeHelpers. (hdp)
+
+ * Moose::AttributeHelpers
+ - Moved in from MooseX with API tweaks. See Moose::Manual::Delta for
+ details. (hdp, jhannah, rbuels)
0.84 Fri, Jun 26, 2009
* Moose::Role
which delegate to the C<node> and C<children> methods (respectively) of the Tree
instance stored in the C<parent> slot.
+You may also use an array reference to curry arguments to the original method.
+
+ has 'thing' => (
+ ...
+ handles => { set_foo => [ set => [ 'foo' ] ] },
+ );
+
+ # $self->set_foo(...) calls $self->thing->set('foo', ...)
+
+The first element of the array reference is the original method name, and the
+second is an array reference of curried arguments.
+
=item C<REGEXP>
The regexp option works very similar to the ARRAY option, except that it builds
--- /dev/null
+
+package Moose::AttributeHelpers;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose 0.56 ();
+
+use Moose::AttributeHelpers::Trait::Bool;
+use Moose::AttributeHelpers::Trait::Counter;
+use Moose::AttributeHelpers::Trait::Number;
+use Moose::AttributeHelpers::Trait::String;
+use Moose::AttributeHelpers::Trait::Collection::List;
+use Moose::AttributeHelpers::Trait::Collection::Array;
+use Moose::AttributeHelpers::Trait::Collection::Hash;
+use Moose::AttributeHelpers::Trait::Collection::ImmutableHash;
+use Moose::AttributeHelpers::Trait::Collection::Bag;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers - Extend your attribute interfaces
+
+=head1 SYNOPSIS
+
+ package MyClass;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'mapping' => (
+ traits => [ 'Collection::Hash' ],
+ is => 'rw',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ handles => {
+ exists_in_mapping => 'exists',
+ ids_in_mapping => 'keys',
+ get_mapping => 'get',
+ set_mapping => 'set',
+ set_quantity => [ set => [ 'quantity' ] ],
+ },
+ );
+
+
+ # ...
+
+ my $obj = MyClass->new;
+ $obj->set_quantity(10); # quantity => 10
+ $obj->set_mapping(4, 'foo'); # 4 => 'foo'
+ $obj->set_mapping(5, 'bar'); # 5 => 'bar'
+ $obj->set_mapping(6, 'baz'); # 6 => 'baz'
+
+
+ # prints 'bar'
+ print $obj->get_mapping(5) if $obj->exists_in_mapping(5);
+
+ # prints '4, 5, 6'
+ print join ', ', $obj->ids_in_mapping;
+
+=head1 DESCRIPTION
+
+While L<Moose> attributes provide you with a way to name your accessors,
+readers, writers, clearers and predicates, this library provides commonly
+used attribute helper methods for more specific types of data.
+
+As seen in the L</SYNOPSIS>, you specify the extension via the
+C<trait> parameter. Available meta classes are below; see L</METHOD PROVIDERS>.
+
+=head1 PARAMETERS
+
+=head2 handles
+
+This is like C<< handles >> in L<Moose/has>, but only HASH references are
+allowed. Keys are method names that you want installed locally, and values are
+methods from the method providers (below). Currying with delegated methods works normally for C<< handles >>.
+
+=head1 METHOD PROVIDERS
+
+=over
+
+=item L<Number|Moose::AttributeHelpers::Trait::Number>
+
+Common numerical operations.
+
+=item L<String|Moose::AttributeHelpers::Trait::String>
+
+Common methods for string operations.
+
+=item L<Counter|Moose::AttributeHelpers::Trait::Counter>
+
+Methods for incrementing and decrementing a counter attribute.
+
+=item L<Bool|Moose::AttributeHelpers::Trait::Bool>
+
+Common methods for boolean values.
+
+=item L<Collection::Hash|Moose::AttributeHelpers::Trait::Collection::Hash>
+
+Common methods for hash references.
+
+=item L<Collection::ImmutableHash|Moose::AttributeHelpers::Trait::Collection::ImmutableHash>
+
+Common methods for inspecting hash references.
+
+=item L<Collection::Array|Moose::AttributeHelpers::Trait::Collection::Array>
+
+Common methods for array references.
+
+=item L<Collection::List|Moose::AttributeHelpers::Trait::Collection::List>
+
+Common list methods for array references.
+
+=back
+
+=head1 CAVEAT
+
+This is an early release of this module. Right now it is in great need
+of documentation and tests in the test suite. However, we have used this
+module to great success at C<$work> where it has been tested very thoroughly
+and deployed into a major production site.
+
+I plan on getting better docs and tests in the next few releases, but until
+then please refer to the few tests we do have and feel free email and/or
+message me on irc.perl.org if you have any questions.
+
+=head1 TODO
+
+We need tests and docs badly.
+
+=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>
+
+B<with contributions from:>
+
+Robert (rlb3) Boone
+
+Paul (frodwith) Driver
+
+Shawn (Sartak) Moore
+
+Chris (perigrin) Prather
+
+Robert (phaylon) Sedlacek
+
+Tom (dec) Lanyon
+
+Yuval Kogman
+
+Jason May
+
+Cory (gphat) Watson
+
+Florian (rafl) Ragwitz
+
+Evan Carroll
+
+Jesse (doy) Luehrs
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2009 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 Moose::AttributeHelpers::MethodProvider::Array;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'Moose::AttributeHelpers::MethodProvider::List';
+
+sub push : method {
+ my ($attr, $reader, $writer) = @_;
+
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ my $instance = CORE::shift;
+ $container_type_constraint->check($_)
+ || confess "Value " . ($_||'undef') . " did not pass container type constraint '$container_type_constraint'"
+ foreach @_;
+ CORE::push @{$reader->($instance)} => @_;
+ };
+ }
+ else {
+ return sub {
+ my $instance = CORE::shift;
+ CORE::push @{$reader->($instance)} => @_;
+ };
+ }
+}
+
+sub pop : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ CORE::pop @{$reader->($_[0])}
+ };
+}
+
+sub unshift : method {
+ my ($attr, $reader, $writer) = @_;
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ my $instance = CORE::shift;
+ $container_type_constraint->check($_)
+ || confess "Value " . ($_||'undef') . " did not pass container type constraint '$container_type_constraint'"
+ foreach @_;
+ CORE::unshift @{$reader->($instance)} => @_;
+ };
+ }
+ else {
+ return sub {
+ my $instance = CORE::shift;
+ CORE::unshift @{$reader->($instance)} => @_;
+ };
+ }
+}
+
+sub shift : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ CORE::shift @{$reader->($_[0])}
+ };
+}
+
+sub get : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ $reader->($_[0])->[$_[1]]
+ };
+}
+
+sub set : method {
+ my ($attr, $reader, $writer) = @_;
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ ($container_type_constraint->check($_[2]))
+ || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint '$container_type_constraint'";
+ $reader->($_[0])->[$_[1]] = $_[2]
+ };
+ }
+ else {
+ return sub {
+ $reader->($_[0])->[$_[1]] = $_[2]
+ };
+ }
+}
+
+sub accessor : method {
+ my ($attr, $reader, $writer) = @_;
+
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ my $self = shift;
+
+ if (@_ == 1) { # reader
+ return $reader->($self)->[$_[0]];
+ }
+ elsif (@_ == 2) { # writer
+ ($container_type_constraint->check($_[1]))
+ || confess "Value " . ($_[1]||'undef') . " did not pass container type constraint '$container_type_constraint'";
+ $reader->($self)->[$_[0]] = $_[1];
+ }
+ else {
+ confess "One or two arguments expected, not " . @_;
+ }
+ };
+ }
+ else {
+ return sub {
+ my $self = shift;
+
+ if (@_ == 1) { # reader
+ return $reader->($self)->[$_[0]];
+ }
+ elsif (@_ == 2) { # writer
+ $reader->($self)->[$_[0]] = $_[1];
+ }
+ else {
+ confess "One or two arguments expected, not " . @_;
+ }
+ };
+ }
+}
+
+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], 1;
+ }
+}
+
+sub insert : method {
+ my ($attr, $reader, $writer) = @_;
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ ($container_type_constraint->check($_[2]))
+ || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint '$container_type_constraint'";
+ CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2];
+ };
+ }
+ else {
+ return sub {
+ CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2];
+ };
+ }
+}
+
+sub splice : method {
+ my ($attr, $reader, $writer) = @_;
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ my ( $self, $i, $j, @elems ) = @_;
+ ($container_type_constraint->check($_))
+ || confess "Value " . (defined($_) ? $_ : 'undef') . " did not pass container type constraint '$container_type_constraint'" for @elems;
+ CORE::splice @{$reader->($self)}, $i, $j, @elems;
+ };
+ }
+ else {
+ return sub {
+ my ( $self, $i, $j, @elems ) = @_;
+ CORE::splice @{$reader->($self)}, $i, $j, @elems;
+ };
+ }
+}
+
+sub sort_in_place : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance, $predicate) = @_;
+
+ die "Argument must be a code reference"
+ if $predicate && ref $predicate ne 'CODE';
+
+ my @sorted;
+ if ($predicate) {
+ @sorted = CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
+ }
+ else {
+ @sorted = CORE::sort @{$reader->($instance)};
+ }
+
+ $writer->($instance, \@sorted);
+ };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::MethodProvider::Array
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::Collection::Array>.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+This module also consumes the B<List> method providers, to
+see those provided methods, refer to that documentation.
+
+=over 4
+
+=item B<get>
+
+=item B<pop>
+
+=item B<push>
+
+=item B<set>
+
+=item B<shift>
+
+=item B<unshift>
+
+=item B<clear>
+
+=item B<delete>
+
+=item B<insert>
+
+=item B<splice>
+
+=item B<sort_in_place>
+
+Sorts the array I<in place>, modifying the value of the attribute.
+
+You can provide an optional subroutine reference to sort with (as you
+can with the core C<sort> function). However, instead of using C<$a>
+and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead.
+
+=item B<accessor>
+
+If passed one argument, returns the value of the requested element.
+If passed two arguments, sets the value of the requested element.
+
+=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-2009 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 Moose::AttributeHelpers::MethodProvider::Bag;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'Moose::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 };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::MethodProvider::Bag
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::Collection::Bag>.
+
+This role is composed from the
+L<Moose::AttributeHelpers::Collection::ImmutableHash> role.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+=item B<delete>
+
+=item B<empty>
+
+=item B<exists>
+
+=item B<get>
+
+=item B<keys>
+
+=item B<add>
+
+=item B<reset>
+
+=item B<values>
+
+=item B<kv>
+
+=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-2009 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 Moose::AttributeHelpers::MethodProvider::Bool;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub set : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], 1) };
+}
+
+sub unset : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], 0) };
+}
+
+sub toggle : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], !$reader->($_[0])) };
+}
+
+sub not : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { !$reader->($_[0]) };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::MethodProvider::Bool
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::Bool>.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<set>
+
+=item B<unset>
+
+=item B<toggle>
+
+=item B<not>
+
+=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
+
+Jason May E<lt>jason.a.may@gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2009 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 Moose::AttributeHelpers::MethodProvider::Counter;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub reset : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $attr->default($_[0])) };
+}
+
+sub set : method {
+ my ($attr, $reader, $writer, $value) = @_;
+ return sub { $writer->($_[0], $_[1]) };
+}
+
+sub inc {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) + (defined($_[1]) ? $_[1] : 1) ) };
+}
+
+sub dec {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) - (defined($_[1]) ? $_[1] : 1) ) };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::MethodProvider::Counter
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::Counter>.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<set>
+
+=item B<inc>
+
+=item B<dec>
+
+=item B<reset>
+
+=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-2009 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 Moose::AttributeHelpers::MethodProvider::Hash;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'Moose::AttributeHelpers::MethodProvider::ImmutableHash';
+
+sub set : method {
+ my ($attr, $reader, $writer) = @_;
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ my ( $self, @kvp ) = @_;
+
+ my ( @keys, @values );
+
+ while ( @kvp ) {
+ my ( $key, $value ) = ( shift(@kvp), shift(@kvp) );
+ ($container_type_constraint->check($value))
+ || confess "Value " . ($value||'undef') . " did not pass container type constraint '$container_type_constraint'";
+ push @keys, $key;
+ push @values, $value;
+ }
+
+ if ( @values > 1 ) {
+ @{ $reader->($self) }{@keys} = @values;
+ } else {
+ $reader->($self)->{$keys[0]} = $values[0];
+ }
+ };
+ }
+ else {
+ return sub {
+ if ( @_ == 3 ) {
+ $reader->($_[0])->{$_[1]} = $_[2]
+ } else {
+ my ( $self, @kvp ) = @_;
+ my ( @keys, @values );
+
+ while ( @kvp ) {
+ push @keys, shift @kvp;
+ push @values, shift @kvp;
+ }
+
+ @{ $reader->($_[0]) }{@keys} = @values;
+ }
+ };
+ }
+}
+
+sub accessor : method {
+ my ($attr, $reader, $writer) = @_;
+
+ if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
+ my $container_type_constraint = $attr->type_constraint->type_parameter;
+ return sub {
+ my $self = shift;
+
+ if (@_ == 1) { # reader
+ return $reader->($self)->{$_[0]};
+ }
+ elsif (@_ == 2) { # writer
+ ($container_type_constraint->check($_[1]))
+ || confess "Value " . ($_[1]||'undef') . " did not pass container type constraint '$container_type_constraint'";
+ $reader->($self)->{$_[0]} = $_[1];
+ }
+ else {
+ confess "One or two arguments expected, not " . @_;
+ }
+ };
+ }
+ else {
+ return sub {
+ my $self = shift;
+
+ if (@_ == 1) { # reader
+ return $reader->($self)->{$_[0]};
+ }
+ elsif (@_ == 2) { # writer
+ $reader->($self)->{$_[0]} = $_[1];
+ }
+ else {
+ confess "One or two arguments expected, not " . @_;
+ }
+ };
+ }
+}
+
+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
+
+Moose::AttributeHelpers::MethodProvider::Hash
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::Collection::Hash>.
+
+This role is composed from the
+L<Moose::AttributeHelpers::Collection::ImmutableHash> role.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+Returns the number of elements in the hash.
+
+=item B<delete>
+
+Removes the element with the given key
+
+=item B<defined>
+
+Returns true if the value of a given key is defined
+
+=item B<empty>
+
+If the list is populated, returns true. Otherwise, returns false.
+
+=item B<clear>
+
+Unsets the hash entirely.
+
+=item B<exists>
+
+Returns true if the given key is present in the hash
+
+=item B<get>
+
+Returns an element of the hash by its key.
+
+=item B<keys>
+
+Returns the list of keys in the hash.
+
+=item B<set>
+
+Sets the element in the hash at the given key to the given value.
+
+=item B<values>
+
+Returns the list of values in the hash.
+
+=item B<kv>
+
+Returns the key, value pairs in the hash
+
+=item B<accessor>
+
+If passed one argument, returns the value of the requested key. If passed two
+arguments, sets the value of the requested key.
+
+=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-2009 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 Moose::AttributeHelpers::MethodProvider::ImmutableHash;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub exists : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::exists $reader->($_[0])->{$_[1]} ? 1 : 0 };
+}
+
+sub defined : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { CORE::defined $reader->($_[0])->{$_[1]} ? 1 : 0 };
+}
+
+sub get : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ if ( @_ == 2 ) {
+ $reader->($_[0])->{$_[1]}
+ } else {
+ 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 elements : 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])} };
+}
+
+sub empty : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { scalar CORE::keys %{$reader->($_[0])} ? 1 : 0 };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::MethodProvider::ImmutableHash
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::Collection::ImmutableHash>.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+Returns the number of elements in the list.
+
+=item B<empty>
+
+If the list is populated, returns true. Otherwise, returns false.
+
+=item B<exists>
+
+Returns true if the given key is present in the hash
+
+=item B<defined>
+
+Returns true if the value of a given key is defined
+
+=item B<get>
+
+Returns an element of the hash by its key.
+
+=item B<keys>
+
+Returns the list of keys in the hash.
+
+=item B<values>
+
+Returns the list of values in the hash.
+
+=item B<kv>
+
+Returns the key, value pairs in the hash as array references
+
+=item B<elements>
+
+Returns the key, value pairs in the hash as a flattened list
+
+=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-2009 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 Moose::AttributeHelpers::MethodProvider::List;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub count : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ scalar @{$reader->($_[0])}
+ };
+}
+
+sub empty : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ scalar @{$reader->($_[0])} ? 1 : 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 sort : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance, $predicate) = @_;
+ die "Argument must be a code reference"
+ if $predicate && ref $predicate ne 'CODE';
+
+ if ($predicate) {
+ CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
+ }
+ else {
+ CORE::sort @{$reader->($instance)};
+ }
+ };
+}
+
+sub grep : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance, $predicate) = @_;
+ CORE::grep { $predicate->($_) } @{$reader->($instance)}
+ };
+}
+
+sub elements : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance) = @_;
+ @{$reader->($instance)}
+ };
+}
+
+sub join : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ($instance, $separator) = @_;
+ join $separator, @{$reader->($instance)}
+ };
+}
+
+sub get : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ $reader->($_[0])->[$_[1]]
+ };
+}
+
+sub first : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ $reader->($_[0])->[0]
+ };
+}
+
+sub last : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ $reader->($_[0])->[-1]
+ };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::MethodProvider::List
+
+=head1 SYNOPSIS
+
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'options' => (
+ metaclass => 'Collection::List',
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ auto_deref => 1,
+ handles => {
+ all_options => 'elements',
+ map_options => 'map',
+ filter_options => 'grep',
+ find_option => 'find',
+ first_option => 'first',
+ last_option => 'last',
+ get_option => 'get',
+ join_options => 'join',
+ count_options => 'count',
+ do_i_have_options => 'empty',
+ sorted_options => 'sort',
+ }
+ );
+
+ no Moose;
+ 1;
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::Collection::List>.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+Returns the number of elements in the list.
+
+ $stuff = Stuff->new;
+ $stuff->options(["foo", "bar", "baz", "boo"]);
+
+ my $count = $stuff->count_options;
+ print "$count\n"; # prints 4
+
+=item B<empty>
+
+If the list is populated, returns true. Otherwise, returns false.
+
+ $stuff->do_i_have_options ? print "Good boy.\n" : die "No options!\n" ;
+
+=item B<find>
+
+This method accepts a subroutine reference as its argument. That sub
+will receive each element of the list in turn. If it returns true for
+an element, that element will be returned by the C<find> method.
+
+ my $found = $stuff->find_option( sub { $_[0] =~ /^b/ } );
+ print "$found\n"; # prints "bar"
+
+=item B<grep>
+
+This method accepts a subroutine reference as its argument. This
+method returns every element for which that subroutine reference
+returns a true value.
+
+ my @found = $stuff->filter_options( sub { $_[0] =~ /^b/ } );
+ print "@found\n"; # prints "bar baz boo"
+
+=item B<map>
+
+This method accepts a subroutine reference as its argument. The
+subroutine will be executed for each element of the list. It is
+expected to return a modified version of that element. The return
+value of the method is a list of the modified options.
+
+ my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } );
+ print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag"
+
+=item B<sort>
+
+Sorts and returns the elements of the list.
+
+You can provide an optional subroutine reference to sort with (as you
+can with the core C<sort> function). However, instead of using C<$a>
+and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead.
+
+ # ascending ASCIIbetical
+ my @sorted = $stuff->sort_options();
+
+ # Descending alphabetical order
+ my @sorted_options = $stuff->sort_options( sub { lc $_[1] cmp lc $_[0] } );
+ print "@sorted_options\n"; # prints "foo boo baz bar"
+
+=item B<elements>
+
+Returns all of the elements of the list
+
+ my @option = $stuff->all_options;
+ print "@options\n"; # prints "foo bar baz boo"
+
+=item B<join>
+
+Joins every element of the list using the separator given as argument.
+
+ my $joined = $stuff->join_options( ':' );
+ print "$joined\n"; # prints "foo:bar:baz:boo"
+
+=item B<get>
+
+Returns an element of the list by its index.
+
+ my $option = $stuff->get_option(1);
+ print "$option\n"; # prints "bar"
+
+=item B<first>
+
+Returns the first element of the list.
+
+ my $first = $stuff->first_option;
+ print "$first\n"; # prints "foo"
+
+=item B<last>
+
+Returns the last element of the list.
+
+ my $last = $stuff->last_option;
+ print "$last\n"; # prints "boo"
+
+=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-2009 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 Moose::AttributeHelpers::MethodProvider::String;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub append : method {
+ my ($attr, $reader, $writer) = @_;
+
+ return sub { $writer->( $_[0], $reader->($_[0]) . $_[1] ) };
+}
+
+sub prepend : method {
+ my ($attr, $reader, $writer) = @_;
+
+ return sub { $writer->( $_[0], $_[1] . $reader->($_[0]) ) };
+}
+
+sub replace : method {
+ my ($attr, $reader, $writer) = @_;
+
+ return sub {
+ my ( $self, $regex, $replacement ) = @_;
+ my $v = $reader->($_[0]);
+
+ if ( (ref($replacement)||'') eq 'CODE' ) {
+ $v =~ s/$regex/$replacement->()/e;
+ } else {
+ $v =~ s/$regex/$replacement/;
+ }
+
+ $writer->( $_[0], $v);
+ };
+}
+
+sub match : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $reader->($_[0]) =~ $_[1] };
+}
+
+sub chop : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $v = $reader->($_[0]);
+ CORE::chop($v);
+ $writer->( $_[0], $v);
+ };
+}
+
+sub chomp : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $v = $reader->($_[0]);
+ chomp($v);
+ $writer->( $_[0], $v);
+ };
+}
+
+sub inc : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $v = $reader->($_[0]);
+ $v++;
+ $writer->( $_[0], $v);
+ };
+}
+
+sub clear : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->( $_[0], '' ) }
+}
+
+sub substr : method {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $self = shift;
+ my $v = $reader->($self);
+
+ my $offset = defined $_[0] ? shift : 0;
+ my $length = defined $_[0] ? shift : CORE::length($v);
+ my $replacement = defined $_[0] ? shift : undef;
+
+ my $ret;
+ if (defined $replacement) {
+ $ret = CORE::substr($v, $offset, $length, $replacement);
+ $writer->($self, $v);
+ }
+ else {
+ $ret = CORE::substr($v, $offset, $length);
+ }
+
+ return $ret;
+ };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::MethodProvider::String
+
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for
+L<Moose::AttributeHelpers::String>.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<append>
+
+=item B<prepend>
+
+=item B<replace>
+
+=item B<match>
+
+=item B<chomp>
+
+=item B<chop>
+
+=item B<inc>
+
+=item B<clear>
+
+=item B<substr>
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Base;
+use Moose::Role;
+use Moose::Util::TypeConstraints;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+requires 'helper_type';
+
+# these next two are the possible methods
+# you can use in the 'handles' map.
+
+# provide a Class or Role which we can
+# collect the method providers from
+
+# requires_attr 'method_provider'
+
+# or you can provide a HASH ref of anon subs
+# yourself. This will also collect and store
+# the methods from a method_provider as well
+has 'method_constructors' => (
+ is => 'ro',
+ isa => 'HashRef',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ return +{} unless $self->has_method_provider;
+ # or grab them from the role/class
+ my $method_provider = $self->method_provider->meta;
+ return +{
+ map {
+ $_ => $method_provider->get_method($_)
+ } $method_provider->get_method_list
+ };
+ },
+);
+
+# extend the parents stuff to make sure
+# certain bits are now required ...
+has '+default' => (required => 1);
+has '+type_constraint' => (required => 1);
+
+## Methods called prior to instantiation
+
+sub process_options_for_handles {
+ my ($self, $options) = @_;
+
+ if (my $type = $self->helper_type) {
+ (exists $options->{isa})
+ || confess "You must define a type with the $type metaclass";
+
+ my $isa = $options->{isa};
+
+ unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) {
+ $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint($isa);
+ }
+
+ ($isa->is_a_type_of($type))
+ || confess "The type constraint for a $type ($options->{isa}) must be a subtype of $type";
+ }
+}
+
+before '_process_options' => sub {
+ my ($self, $name, $options) = @_;
+ $self->process_options_for_handles($options, $name);
+};
+
+around '_canonicalize_handles' => sub {
+ my $next = shift;
+ my $self = shift;
+ my $handles = $self->handles;
+ return unless $handles;
+ unless ('HASH' eq ref $handles) {
+ $self->throw_error(
+ "The 'handles' option must be a HASH reference, not $handles"
+ );
+ }
+ return map {
+ my $to = $handles->{$_};
+ $to = [ $to ] unless ref $to;
+ $_ => $to
+ } keys %$handles;
+};
+
+## methods called after instantiation
+
+before 'install_accessors' => sub { (shift)->check_handles_values };
+
+sub check_handles_values {
+ my $self = shift;
+
+ my $method_constructors = $self->method_constructors;
+
+ my %handles = $self->_canonicalize_handles;
+
+ for my $original_method (values %handles) {
+ my $name = $original_method->[0];
+ (exists $method_constructors->{$name})
+ || confess "$name is an unsupported method type";
+ }
+
+}
+
+around '_make_delegation_method' => sub {
+ my $next = shift;
+ my ($self, $handle_name, $method_to_call) = @_;
+
+ my ($name, $curried_args) = @$method_to_call;
+
+ $curried_args ||= [];
+
+ my $method_constructors = $self->method_constructors;
+
+ my $code = $method_constructors->{$name}->(
+ $self,
+ $self->get_read_method_ref,
+ $self->get_write_method_ref,
+ );
+
+ return $next->(
+ $self,
+ $handle_name,
+ sub {
+ my $instance = shift;
+ return $code->($instance, @$curried_args, @_);
+ },
+ );
+};
+
+no Moose::Role;
+no Moose::Util::TypeConstraints;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Moose::AttributeHelpers::Trait::Base - base role for helpers
+
+=head1 METHODS
+
+=head2 check_handles_values
+
+Confirms that handles has all valid possibilities in it.
+
+=head2 process_options_for_handles
+
+Ensures that the type constraint (C<isa>) matches the helper type.
+
+=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 AUTHORS
+
+Yuval Kogman
+
+Shawn M Moore
+
+Jesse Luehrs
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2009 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 Moose::AttributeHelpers::Trait::Bool;
+use Moose::Role;
+use Moose::AttributeHelpers::MethodProvider::Bool;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'Moose::AttributeHelpers::Trait::Base';
+
+sub helper_type { 'Bool' }
+
+# NOTE:
+# we don't use the method provider for this
+# module since many of the names of the provied
+# methods would conflict with keywords
+# - SL
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::Bool'
+);
+
+before 'process_options_for_handles' => 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;
+ }
+};
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Bool;
+sub register_implementation { 'Moose::AttributeHelpers::Trait::Bool' }
+
+1;
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Bool
+
+=head1 SYNOPSIS
+
+ package Room;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'is_lit' => (
+ metaclass => 'Bool',
+ is => 'rw',
+ isa => 'Bool',
+ default => sub { 0 },
+ handles => {
+ illuminate => 'set',
+ darken => 'unset',
+ flip_switch => 'toggle',
+ is_dark => 'not',
+ }
+ );
+
+ my $room = Room->new();
+ $room->illuminate; # same as $room->is_lit(1);
+ $room->darken; # same as $room->is_lit(0);
+ $room->flip_switch; # same as $room->is_lit(not $room->is_lit);
+ return $room->is_dark; # same as !$room->is_lit
+
+=head1 DESCRIPTION
+
+This provides a simple boolean attribute, which supports most of the
+basic math operations.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<helper_type>
+
+=item B<method_constructors>
+
+=item B<has_method_provider>
+
+=item B<method_provider>
+
+=back
+
+=head1 PROVIDED METHODS
+
+It is important to note that all those methods do in place
+modification of the value stored in the attribute.
+
+=over 4
+
+=item I<set>
+
+Sets the value to C<1>.
+
+=item I<unset>
+
+Set the value to C<0>.
+
+=item I<toggle>
+
+Toggle the value. If it's true, set to false, and vice versa.
+
+=item I<not>
+
+Equivalent of 'not C<$value>'.
+
+=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
+
+Jason May
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2009 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 Moose::AttributeHelpers::Trait::Collection;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'Moose::AttributeHelpers::Trait::Base';
+
+no Moose::Role;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Collection - Base class for all collection type helpers
+
+=head1 DESCRIPTION
+
+Documentation to come.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<container_type>
+
+=item B<container_type_constraint>
+
+=item B<has_container_type>
+
+=item B<process_options_for_handles>
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Collection::Array;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::AttributeHelpers::MethodProvider::Array;
+
+with 'Moose::AttributeHelpers::Trait::Collection';
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::Array'
+);
+
+sub helper_type { 'ArrayRef' }
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Collection::Array;
+sub register_implementation {
+ 'Moose::AttributeHelpers::Trait::Collection::Array'
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Collection::Array
+
+=head1 SYNOPSIS
+
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'options' => (
+ metaclass => 'Collection::Array',
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ default => sub { [] },
+ handles => {
+ add_options => 'push',
+ remove_last_option => 'pop',
+ }
+ );
+
+=head1 DESCRIPTION
+
+This module provides an Array attribute which provides a number of
+array operations. See L<Moose::AttributeHelpers::MethodProvider::Array>
+for more details.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<method_provider>
+
+=item B<has_method_provider>
+
+=item B<helper_type>
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Collection::Bag;
+use Moose::Role;
+use Moose::Util::TypeConstraints;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::AttributeHelpers::MethodProvider::Bag;
+
+with 'Moose::AttributeHelpers::Trait::Collection';
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::Bag'
+);
+
+subtype 'Bag' => as 'HashRef[Int]';
+
+sub helper_type { 'Bag' }
+
+before 'process_options_for_handles' => 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};
+};
+
+no Moose::Role;
+no Moose::Util::TypeConstraints;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Collection::Bag;
+sub register_implementation {
+ 'Moose::AttributeHelpers::Trait::Collection::Bag'
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Collection::Bag
+
+=head1 SYNOPSIS
+
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'word_histogram' => (
+ metaclass => 'Collection::Bag',
+ is => 'ro',
+ isa => 'Bag', # optional ... as is defalt
+ handles => {
+ add_word => 'add',
+ get_count_for => 'get',
+ has_any_words => 'empty',
+ num_words => 'count',
+ delete_word => 'delete',
+ }
+ );
+
+=head1 DESCRIPTION
+
+This module provides a Bag attribute which provides a number of
+bag-like operations. See L<Moose::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_handles>
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Collection::Hash;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::AttributeHelpers::MethodProvider::Hash;
+
+with 'Moose::AttributeHelpers::Trait::Collection';
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::Hash'
+);
+
+sub helper_type { 'HashRef' }
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Collection::Hash;
+sub register_implementation {
+ 'Moose::AttributeHelpers::Trait::Collection::Hash'
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Collection::Hash
+
+=head1 SYNOPSIS
+
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'options' => (
+ metaclass => 'Collection::Hash',
+ is => 'ro',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ handles => {
+ set_option => 'set',
+ get_option => 'get',
+ has_options => 'empty',
+ num_options => 'count',
+ delete_option => 'delete',
+ }
+ );
+
+=head1 DESCRIPTION
+
+This module provides a Hash attribute which provides a number of
+hash-like operations. See L<Moose::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>
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Collection::ImmutableHash;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::AttributeHelpers::MethodProvider::ImmutableHash;
+
+with 'Moose::AttributeHelpers::Trait::Collection';
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::ImmutableHash'
+);
+
+sub helper_type { 'HashRef' }
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Collection::ImmutableHash;
+sub register_implementation {
+ 'Moose::AttributeHelpers::Trait::Collection::ImmutableHash'
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Collection::ImmutableHash
+
+=head1 SYNOPSIS
+
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'options' => (
+ metaclass => 'Collection::ImmutableHash',
+ is => 'ro',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ handles => {
+ get_option => 'get',
+ has_options => 'empty',
+ get_option_list => 'keys',
+ }
+ );
+
+=head1 DESCRIPTION
+
+This module provides a immutable HashRef attribute which provides a number of
+hash-line operations. See L<Moose::AttributeHelpers::MethodProvider::ImmutableHash>
+for more details.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<method_provider>
+
+=item B<has_method_provider>
+
+=item B<helper_type>
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Collection::List;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::AttributeHelpers::MethodProvider::List;
+
+with 'Moose::AttributeHelpers::Trait::Collection';
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::List'
+);
+
+sub helper_type { 'ArrayRef' }
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Collection::List;
+sub register_implementation {
+ 'Moose::AttributeHelpers::Trait::Collection::List'
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Collection::List
+
+=head1 SYNOPSIS
+
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'options' => (
+ metaclass => 'Collection::List',
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ default => sub { [] },
+ handles => {
+ map_options => 'map',
+ filter_options => 'grep',
+ }
+ );
+
+=head1 DESCRIPTION
+
+This module provides an List attribute which provides a number of
+list operations. See L<Moose::AttributeHelpers::MethodProvider::List>
+for more details.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<method_provider>
+
+=item B<has_method_provider>
+
+=item B<helper_type>
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Counter;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::AttributeHelpers::MethodProvider::Counter;
+
+with 'Moose::AttributeHelpers::Trait::Base';
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::Counter',
+);
+
+sub helper_type { 'Num' }
+
+before 'process_options_for_handles' => 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->{is} = 'ro' unless exists $options->{is};
+ $options->{default} = 0 unless exists $options->{default};
+};
+
+after 'check_handles_values' => sub {
+ my $self = shift;
+ my $handles = $self->handles;
+
+ unless (scalar keys %$handles) {
+ my $method_constructors = $self->method_constructors;
+ my $attr_name = $self->name;
+
+ foreach my $method (keys %$method_constructors) {
+ $handles->{$method . '_' . $attr_name} = $method;
+ }
+
+ $self->_set_handles($handles);
+ }
+};
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Counter;
+sub register_implementation { 'Moose::AttributeHelpers::Trait::Counter' }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Counter
+
+=head1 SYNOPSIS
+
+ package MyHomePage;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'counter' => (
+ metaclass => 'Counter',
+ is => 'ro',
+ isa => 'Num',
+ default => sub { 0 },
+ handles => {
+ inc_counter => 'inc',
+ dec_counter => 'dec',
+ reset_counter => 'reset',
+ }
+ );
+
+ my $page = MyHomePage->new();
+ $page->inc_counter; # same as $page->counter($page->counter + 1);
+ $page->dec_counter; # same as $page->counter($page->counter - 1);
+
+=head1 DESCRIPTION
+
+This module provides a simple counter attribute, which can be
+incremented and decremented.
+
+If your attribute definition does not include any of I<is>, I<isa>,
+I<default> or I<handles> but does use the C<Counter> metaclass,
+then this module applies defaults as in the L</SYNOPSIS>
+above. This allows for a very basic counter definition:
+
+ has 'foo' => (metaclass => 'Counter');
+ $obj->inc_foo;
+
+=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_handles>
+
+Run before its superclass method.
+
+=item B<check_handles_values>
+
+Run after its superclass method.
+
+=back
+
+=head1 PROVIDED METHODS
+
+It is important to note that all those methods do in place
+modification of the value stored in the attribute.
+
+=over 4
+
+=item I<set>
+
+Set the counter to the specified value.
+
+=item I<inc>
+
+Increments the value stored in this slot by 1. Providing an argument will
+cause the counter to be increased by specified amount.
+
+=item I<dec>
+
+Decrements the value stored in this slot by 1. Providing an argument will
+cause the counter to be increased by specified amount.
+
+=item I<reset>
+
+Resets the value stored in this slot to it's default value.
+
+=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-2009 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 Moose::AttributeHelpers::Trait::Number;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'Moose::AttributeHelpers::Trait::Base';
+
+sub helper_type { 'Num' }
+
+# NOTE:
+# we don't use the method provider for this
+# module since many of the names of the provied
+# methods would conflict with keywords
+# - SL
+
+has 'method_constructors' => (
+ is => 'ro',
+ isa => 'HashRef',
+ lazy => 1,
+ default => sub {
+ return +{
+ set => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $_[1]) };
+ },
+ add => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) + $_[1]) };
+ },
+ sub => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) - $_[1]) };
+ },
+ mul => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) * $_[1]) };
+ },
+ div => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) / $_[1]) };
+ },
+ mod => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) % $_[1]) };
+ },
+ abs => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], abs($reader->($_[0])) ) };
+ },
+ }
+ }
+);
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::Number;
+sub register_implementation { 'Moose::AttributeHelpers::Trait::Number' }
+
+1;
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Number
+
+=head1 SYNOPSIS
+
+ package Real;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'integer' => (
+ metaclass => 'Number',
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 5 },
+ handles => {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+ }
+ );
+
+ my $real = Real->new();
+ $real->add(5); # same as $real->integer($real->integer + 5);
+ $real->sub(2); # same as $real->integer($real->integer - 2);
+
+=head1 DESCRIPTION
+
+This provides a simple numeric attribute, which supports most of the
+basic math operations.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<helper_type>
+
+=item B<method_constructors>
+
+=back
+
+=head1 PROVIDED METHODS
+
+It is important to note that all those methods do in place
+modification of the value stored in the attribute.
+
+=over 4
+
+=item I<set ($value)>
+
+Alternate way to set the value.
+
+=item I<add ($value)>
+
+Adds the current value of the attribute to C<$value>.
+
+=item I<sub ($value)>
+
+Subtracts the current value of the attribute to C<$value>.
+
+=item I<mul ($value)>
+
+Multiplies the current value of the attribute to C<$value>.
+
+=item I<div ($value)>
+
+Divides the current value of the attribute to C<$value>.
+
+=item I<mod ($value)>
+
+Modulus the current value of the attribute to C<$value>.
+
+=item I<abs>
+
+Sets the current value of the attribute to its absolute value.
+
+=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
+
+Robert Boone
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2009 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 Moose::AttributeHelpers::Trait::String;
+use Moose::Role;
+
+our $VERSION = '0.83';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::AttributeHelpers::MethodProvider::String;
+
+with 'Moose::AttributeHelpers::Trait::Base';
+
+has 'method_provider' => (
+ is => 'ro',
+ isa => 'ClassName',
+ predicate => 'has_method_provider',
+ default => 'Moose::AttributeHelpers::MethodProvider::String',
+);
+
+sub helper_type { 'Str' }
+
+before 'process_options_for_handles' => 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->{is} = 'rw' unless exists $options->{is};
+ $options->{default} = '' unless exists $options->{default};
+};
+
+after 'check_handles_values' => sub {
+ my $self = shift;
+ my $handles = $self->handles;
+
+ unless (scalar keys %$handles) {
+ my $method_constructors = $self->method_constructors;
+ my $attr_name = $self->name;
+
+ foreach my $method (keys %$method_constructors) {
+ $handles->{$method} = ($method . '_' . $attr_name);
+ }
+ }
+};
+
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Trait::String;
+sub register_implementation { 'Moose::AttributeHelpers::Trait::String' }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::String
+
+=head1 SYNOPSIS
+
+ package MyHomePage;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'text' => (
+ metaclass => 'String',
+ is => 'rw',
+ isa => 'Str',
+ default => sub { '' },
+ handles => {
+ add_text => 'append',
+ replace_text => 'replace',
+ }
+ );
+
+ my $page = MyHomePage->new();
+ $page->add_text("foo"); # same as $page->text($page->text . "foo");
+
+=head1 DESCRIPTION
+
+This module provides a simple string attribute, to which mutating string
+operations can be applied more easily (no need to make an lvalue attribute
+metaclass or use temporary variables). Additional methods are provided for
+completion.
+
+If your attribute definition does not include any of I<is>, I<isa>,
+I<default> or I<handles> but does use the C<String> metaclass,
+then this module applies defaults as in the L</SYNOPSIS>
+above. This allows for a very basic counter definition:
+
+ has 'foo' => (metaclass => 'String');
+ $obj->append_foo;
+
+=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_handles>
+
+Run before its superclass method.
+
+=item B<check_handles_values>
+
+Run after its superclass method.
+
+=back
+
+=head1 PROVIDED METHODS
+
+It is important to note that all those methods do in place
+modification of the value stored in the attribute.
+
+=over 4
+
+=item I<inc>
+
+Increments the value stored in this slot using the magical string autoincrement
+operator. Note that Perl doesn't provide analogous behavior in C<-->, so
+C<dec> is not available.
+
+=item I<append> C<$string>
+
+Append a string, like C<.=>.
+
+=item I<prepend> C<$string>
+
+Prepend a string.
+
+=item I<replace> C<$pattern> C<$replacement>
+
+Performs a regexp substitution (L<perlop/s>). There is no way to provide the
+C<g> flag, but code references will be accepted for the replacement, causing
+the regex to be modified with a single C<e>. C</smxi> can be applied using the
+C<qr> operator.
+
+=item I<match> C<$pattern>
+
+Like I<replace> but without the replacement. Provided mostly for completeness.
+
+=item C<chop>
+
+L<perlfunc/chop>
+
+=item C<chomp>
+
+L<perlfunc/chomp>
+
+=item C<clear>
+
+Sets the string to the empty string (not the value passed to C<default>).
+
+=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-2009 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
it documented here, or think we missed an important feature, please
send us a patch.
+=head1 Version 0.85
+
+L<Moose::AttributeHelpers> has been moved into the Moose core from
+L<MooseX::AttributeHelpers>. Major changes include:
+
+=over
+
+=item C<traits>, not C<metaclass>
+
+All of the method providers are available via traits only. The custom
+metaclasses were strictly inferior to applying attribute metaclass traits.
+
+=item C<handles>, not C<provides> or C<curries>
+
+C<provides> syntax was like core Moose C<< handles => HASHREF >> syntax, but
+with the keys and values reversed. This was confusing, and
+AttributeHelpers now uses C<< handles => HASHREF >> in a way that
+should be intuitive to anyone already familiar with it for normal attributes.
+
+The C<curries> functionality provided by AttributeHelpers has been generalized
+to apply to all cases of C<< handles => HASHREF >>, though not every piece of
+functionality has been ported (currying with a CODEREF is not supported).
+
+=back
+
+See L<Moose::AttributeHelpers> for the new documentation.
+
=head1 Version 0.84
The C<Role> type has been deprecated. On its own, it was useless,
));
__PACKAGE__->meta->add_attribute('handles' => (
reader => 'handles',
+ writer => '_set_handles',
predicate => 'has_handles',
));
__PACKAGE__->meta->add_attribute('documentation' => (
$method_body = $method_to_call
if 'CODE' eq ref($method_to_call);
+ my $curried_arguments = [];
+
+ ($method_to_call, $curried_arguments) = @$method_to_call
+ if 'ARRAY' eq ref($method_to_call);
+
return $self->delegation_metaclass->new(
name => $handle_name,
package_name => $self->associated_class->name,
attribute => $self,
delegate_to_method => $method_to_call,
+ curried_arguments => $curried_arguments || [],
);
}
|| confess
'You must supply a delegate_to_method which is a method name or a CODE reference';
+ exists $options{curried_arguments}
+ || ( $options{curried_arguments} = [] );
+
+ ( $options{curried_arguments} &&
+ ( 'ARRAY' eq ref $options{curried_arguments} ) )
+ || confess 'You must supply a curried_arguments which is an ARRAY reference';
+
my $self = $class->_new( \%options );
weaken( $self->{'attribute'} );
return bless $options, $class;
}
+sub curried_arguments { (shift)->{'curried_arguments'} }
+
sub associated_attribute { (shift)->{'attribute'} }
sub delegate_to_method { (shift)->{'delegate_to_method'} }
method_name => $method_to_call,
object => $instance
);
- $proxy->$method_to_call(@_);
+ my @args = (@{ $self->curried_arguments }, @_);
+ $proxy->$method_to_call(@args);
};
}
The method in the associated attribute's value to which we
delegate. This can be either a method name or a code reference.
+=item I<curried_arguments>
+
+An array reference of arguments that will be prepended to the argument list for
+any call to the delegating method.
+
=back
=item B<< $metamethod->associated_attribute >>
Returns the attribute associated with this method.
+=item B<< $metamethod->curried_arguments >>
+
+Return any curried arguments that will be passed to the delegated method.
+
=item B<< $metamethod->delegate_to_method >>
Returns the method to which this method delegates, as passed to the
use strict;
use warnings;
-use Test::More tests => 88;
+use Test::More tests => 89;
use Test::Exception;
has 'foo' => (
is => 'rw',
default => sub { Foo->new },
- handles => { 'foo_bar' => 'bar' }
+ handles => {
+ 'foo_bar' => 'bar',
+ 'foo_bar_to_20' => [ bar => [ 20 ] ],
+ }
);
}
is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
+# curried handles
+$bar->foo_bar_to_20;
+is($bar->foo_bar, 20, '... correctly curried a single argument');
+
# -------------------------------------------------------------------
# ARRAY handles
# -------------------------------------------------------------------
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Foo;
+ use Moose;
+
+ has 'bar' => (is => 'rw');
+
+ package Stuffed::Role;
+ use Moose::Role;
+
+ has 'options' => (
+ traits => [ 'Collection::Array' ],
+ is => 'ro',
+ isa => 'ArrayRef[Foo]',
+ );
+
+ package Bulkie::Role;
+ use Moose::Role;
+
+ has 'stuff' => (
+ traits => [ 'Collection::Array' ],
+ is => 'ro',
+ isa => 'ArrayRef',
+ handles => {
+ get_stuff => 'get',
+ }
+ );
+
+ package Stuff;
+ use Moose;
+
+ ::lives_ok {
+ with 'Stuffed::Role';
+ } '... this should work correctly';
+
+ ::lives_ok {
+ with 'Bulkie::Role';
+ } '... this should work correctly';
+
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 14;
+use Test::Moose;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'counter' => (traits => ['Counter']);
+}
+
+my $page = MyHomePage->new();
+isa_ok($page, 'MyHomePage');
+
+can_ok($page, $_) for qw[
+ dec_counter
+ inc_counter
+ reset_counter
+];
+
+is($page->counter, 0, '... got the default value');
+
+$page->inc_counter;
+is($page->counter, 1, '... got the incremented value');
+
+$page->inc_counter;
+is($page->counter, 2, '... got the incremented value (again)');
+
+$page->dec_counter;
+is($page->counter, 1, '... got the decremented value');
+
+$page->reset_counter;
+is($page->counter, 0, '... got the original value');
+
+# check the meta ..
+
+my $counter = $page->meta->get_attribute('counter');
+does_ok($counter, 'Moose::AttributeHelpers::Trait::Counter');
+
+is($counter->helper_type, 'Num', '... got the expected helper type');
+
+is($counter->type_constraint->name, 'Num', '... got the expected default type constraint');
+
+is_deeply($counter->handles, {
+ 'inc_counter' => 'inc',
+ 'dec_counter' => 'dec',
+ 'reset_counter' => 'reset',
+ 'set_counter' => 'set',
+}, '... got the right default handles methods');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'counter' => (
+ traits => [ 'Counter' ],
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 0 },
+ handles => {
+ inc_counter => 'inc',
+ dec_counter => 'dec',
+ reset_counter => 'reset',
+ }
+ );
+}
+
+my $page = MyHomePage->new();
+isa_ok($page, 'MyHomePage');
+
+can_ok($page, $_) for qw[
+ counter
+ dec_counter
+ inc_counter
+ reset_counter
+];
+
+lives_ok {
+ $page->meta->remove_attribute('counter')
+} '... removed the counter attribute okay';
+
+ok(!$page->meta->has_attribute('counter'), '... no longer has the attribute');
+
+ok(!$page->can($_), "... our class no longer has the $_ method") for qw[
+ counter
+ dec_counter
+ inc_counter
+ reset_counter
+];
+
+
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 29;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+package Subject;
+
+use Moose::Role;
+use Moose::AttributeHelpers;
+
+has observers => (
+ traits => [ 'Collection::Array' ],
+ is => 'ro',
+ isa => 'ArrayRef[Observer]',
+ auto_deref => 1,
+ default => sub { [] },
+ handles => {
+ 'add_observer' => 'push',
+ 'count_observers' => 'count',
+ },
+);
+
+sub notify {
+ my ($self) = @_;
+ foreach my $observer ( $self->observers() ) {
+ $observer->update($self);
+ }
+}
+
+###############################################################################
+
+package Observer;
+
+use Moose::Role;
+
+requires 'update';
+
+###############################################################################
+
+package Counter;
+
+use Moose;
+use Moose::AttributeHelpers;
+
+with 'Subject';
+
+has count => (
+ traits => [ 'Counter' ],
+ is => 'ro',
+ isa => 'Int',
+ default => 0,
+ handles => {
+ inc_counter => 'inc',
+ dec_counter => 'dec',
+ },
+);
+
+after qw(inc_counter dec_counter) => sub {
+ my ($self) = @_;
+ $self->notify();
+};
+
+###############################################################################
+
+package Display;
+
+use Test::More;
+
+use Moose;
+
+with 'Observer';
+
+sub update {
+ my ( $self, $subject ) = @_;
+ like $subject->count, qr{^-?\d+$}, 'Observed number ' . $subject->count;
+}
+
+###############################################################################
+
+package main;
+
+my $count = Counter->new();
+
+ok($count->can('add_observer'), 'add_observer method added');
+
+ok($count->can('count_observers'), 'count_observers method added');
+
+ok($count->can('inc_counter'), 'inc_counter method added');
+
+ok($count->can('dec_counter'), 'dec_counter method added');
+
+$count->add_observer( Display->new() );
+
+is($count->count_observers, 1, 'Only one observer');
+
+is($count->count, 0, 'Default to zero');
+
+$count->inc_counter;
+
+is($count->count, 1, 'Increment to one ');
+
+$count->inc_counter for (1 .. 6);
+
+is($count->count, 7, 'Increment up to seven');
+
+$count->dec_counter;
+
+is($count->count, 6, 'Decrement to 6');
+
+$count->dec_counter for (1 .. 5);
+
+is($count->count, 1, 'Decrement to 1');
+
+$count->dec_counter for (1 .. 2);
+
+is($count->count, -1, 'Negative numbers');
+
+$count->inc_counter;
+
+is($count->count, 0, 'Back to zero');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'counter' => (
+ traits => [qw/Counter/],
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 0 },
+ handles => {
+ inc_counter => 'inc',
+ dec_counter => 'dec',
+ reset_counter => 'reset',
+ set_counter => 'set'
+ }
+ );
+}
+
+my $page = MyHomePage->new();
+isa_ok($page, 'MyHomePage');
+
+can_ok($page, $_) for qw[
+ dec_counter
+ inc_counter
+ reset_counter
+ set_counter
+];
+
+is($page->counter, 0, '... got the default value');
+
+$page->inc_counter;
+is($page->counter, 1, '... got the incremented value');
+
+$page->inc_counter;
+is($page->counter, 2, '... got the incremented value (again)');
+
+$page->dec_counter;
+is($page->counter, 1, '... got the decremented value');
+
+$page->reset_counter;
+is($page->counter, 0, '... got the original value');
+
+$page->set_counter(5);
+is($page->counter, 5, '... set the value');
+
+$page->inc_counter(2);
+is($page->counter, 7, '... increment by arg');
+
+$page->dec_counter(5);
+is($page->counter, 2, '... decrement by arg');
+
+# check the meta ..
+
+my $counter = $page->meta->get_attribute('counter');
+does_ok($counter, 'Moose::AttributeHelpers::Trait::Counter');
+
+is($counter->helper_type, 'Num', '... got the expected helper type');
+
+is($counter->type_constraint->name, 'Int', '... got the expected type constraint');
+
+is_deeply($counter->handles, {
+ inc_counter => 'inc',
+ dec_counter => 'dec',
+ reset_counter => 'reset',
+ set_counter => 'set'
+}, '... got the right handles methods');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 69;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+my $sort;
+{
+ package Stuff;
+ use Moose;
+
+ has 'options' => (
+ traits => [qw/Collection::Array/],
+ is => 'ro',
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ handles => {
+ 'add_options' => 'push',
+ 'remove_last_option' => 'pop',
+ 'remove_first_option' => 'shift',
+ 'insert_options' => 'unshift',
+ 'get_option_at' => 'get',
+ 'set_option_at' => 'set',
+ 'num_options' => 'count',
+ 'has_options' => 'empty',
+ 'clear_options' => 'clear',
+ 'splice_options' => 'splice',
+ 'sort_options_in_place' => 'sort_in_place',
+ 'option_accessor' => 'accessor',
+ 'add_options_with_speed' =>
+ [ 'push' => ['funrolls', 'funbuns'] ],
+ 'prepend_prerequisites_along_with' =>
+ [ 'unshift' => ['first', 'second'] ],
+ 'descending_options' =>
+ [ 'sort_in_place' => [ $sort = sub { $_[1] <=> $_[0] } ] ],
+ }
+ );
+}
+
+my $stuff = Stuff->new(options => [ 10, 12 ]);
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ add_options
+ remove_last_option
+ remove_first_option
+ insert_options
+ get_option_at
+ set_option_at
+ num_options
+ clear_options
+ has_options
+ sort_options_in_place
+ option_accessor
+];
+
+is_deeply($stuff->options, [10, 12], '... got options');
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 2, '... got 2 options');
+
+is($stuff->remove_last_option, 12, '... removed the last option');
+is($stuff->remove_first_option, 10, '... removed the last option');
+
+is_deeply($stuff->options, [], '... no options anymore');
+
+ok(!$stuff->has_options, '... no options');
+is($stuff->num_options, 0, '... got no options');
+
+lives_ok {
+ $stuff->add_options(1, 2, 3);
+} '... set the option okay';
+
+is_deeply($stuff->options, [1, 2, 3], '... got options now');
+
+ok($stuff->has_options, '... no options');
+is($stuff->num_options, 3, '... got 3 options');
+
+is($stuff->get_option_at(0), 1, '... get option at index 0');
+is($stuff->get_option_at(1), 2, '... get option at index 1');
+is($stuff->get_option_at(2), 3, '... get option at index 2');
+
+lives_ok {
+ $stuff->set_option_at(1, 100);
+} '... set the option okay';
+
+is($stuff->get_option_at(1), 100, '... get option at index 1');
+
+lives_ok {
+ $stuff->add_options(10, 15);
+} '... set the option okay';
+
+is_deeply($stuff->options, [1, 100, 3, 10, 15], '... got more options now');
+
+is($stuff->num_options, 5, '... got 5 options');
+
+is($stuff->remove_last_option, 15, '... removed the last option');
+
+is($stuff->num_options, 4, '... got 4 options');
+is_deeply($stuff->options, [1, 100, 3, 10], '... got diff options now');
+
+lives_ok {
+ $stuff->insert_options(10, 20);
+} '... set the option okay';
+
+is($stuff->num_options, 6, '... got 6 options');
+is_deeply($stuff->options, [10, 20, 1, 100, 3, 10], '... got diff options now');
+
+is($stuff->get_option_at(0), 10, '... get option at index 0');
+is($stuff->get_option_at(1), 20, '... get option at index 1');
+is($stuff->get_option_at(3), 100, '... get option at index 3');
+
+is($stuff->remove_first_option, 10, '... getting the first option');
+
+is($stuff->num_options, 5, '... got 5 options');
+is($stuff->get_option_at(0), 20, '... get option at index 0');
+
+$stuff->clear_options;
+is_deeply( $stuff->options, [], "... clear options" );
+
+$stuff->add_options(5, 1, 2, 3);
+$stuff->sort_options_in_place;
+is_deeply( $stuff->options, [1, 2, 3, 5], "... sort options in place (default sort order)" );
+
+$stuff->sort_options_in_place( sub { $_[1] <=> $_[0] } );
+is_deeply( $stuff->options, [5, 3, 2, 1], "... sort options in place (descending order)" );
+
+$stuff->clear_options();
+$stuff->add_options(5, 1, 2, 3);
+lives_ok {
+ $stuff->descending_options();
+} '... curried sort in place lives ok';
+
+is_deeply( $stuff->options, [5, 3, 2, 1], "... sort currying" );
+
+throws_ok { $stuff->sort_options_in_place('foo') } qr/Argument must be a code reference/,
+ 'error when sort_in_place receives a non-coderef argument';
+
+$stuff->clear_options;
+
+lives_ok {
+ $stuff->add_options('tree');
+} '... set the options okay';
+
+lives_ok {
+ $stuff->add_options_with_speed('compatible', 'safe');
+} '... add options with speed okay';
+
+is_deeply($stuff->options, [qw/tree funrolls funbuns compatible safe/],
+ 'check options after add_options_with_speed');
+
+lives_ok {
+ $stuff->prepend_prerequisites_along_with();
+} '... add prerequisite options okay';
+
+$stuff->clear_options;
+$stuff->add_options( 1, 2 );
+
+lives_ok {
+ $stuff->splice_options( 1, 0, 'foo' );
+} '... splice_options works';
+
+is_deeply(
+ $stuff->options, [ 1, 'foo', 2 ],
+ 'splice added expected option'
+);
+
+is($stuff->option_accessor(1 => 'foo++'), 'foo++');
+is($stuff->option_accessor(1), 'foo++');
+
+## check some errors
+
+#dies_ok {
+# $stuff->insert_options(undef);
+#} '... could not add an undef where a string is expected';
+#
+#dies_ok {
+# $stuff->set_option(5, {});
+#} '... could not add a hash ref where a string is expected';
+
+dies_ok {
+ Stuff->new(options => [ undef, 10, undef, 20 ]);
+} '... bad constructor params';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->add_options(undef);
+} '... rejects push of an invalid type';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->insert_options(undef);
+} '... rejects unshift of an invalid type';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->set_option_at( 0, undef );
+} '... rejects set of an invalid type';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->sort_in_place_options( undef );
+} '... sort rejects arg of invalid type';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->option_accessor();
+} '... accessor rejects 0 args';
+
+dies_ok {
+ my $stuff = Stuff->new();
+ $stuff->option_accessor(1, 2, 3);
+} '... accessor rejects 3 args';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::Array');
+
+is_deeply($options->handles, {
+ 'add_options' => 'push',
+ 'remove_last_option' => 'pop',
+ 'remove_first_option' => 'shift',
+ 'insert_options' => 'unshift',
+ 'get_option_at' => 'get',
+ 'set_option_at' => 'set',
+ 'num_options' => 'count',
+ 'has_options' => 'empty',
+ 'clear_options' => 'clear',
+ 'splice_options' => 'splice',
+ 'sort_options_in_place' => 'sort_in_place',
+ 'option_accessor' => 'accessor',
+ 'add_options_with_speed' =>
+ [ 'push' => ['funrolls', 'funbuns'] ],
+ 'prepend_prerequisites_along_with' =>
+ [ 'unshift' => ['first', 'second'] ],
+ 'descending_options' =>
+ [ 'sort_in_place' => [ $sort ] ],
+}, '... got the right handles mapping');
+
+is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 47;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'options' => (
+ traits => [qw/Collection::Hash/],
+ is => 'ro',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ handles => {
+ 'set_option' => 'set',
+ 'get_option' => 'get',
+ 'has_options' => 'empty',
+ 'num_options' => 'count',
+ 'clear_options' => 'clear',
+ 'delete_option' => 'delete',
+ 'has_option' => 'exists',
+ 'is_defined' => 'defined',
+ 'option_accessor' => 'accessor',
+ 'key_value' => 'kv',
+ 'options_elements' => 'elements',
+ 'quantity' => [ accessor => ['quantity'] ],
+ },
+ );
+}
+
+my $stuff = Stuff->new();
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ set_option
+ get_option
+ has_options
+ num_options
+ delete_option
+ clear_options
+ is_defined
+ has_option
+ quantity
+ option_accessor
+];
+
+ok(!$stuff->has_options, '... we have no options');
+is($stuff->num_options, 0, '... we have no options');
+
+is_deeply($stuff->options, {}, '... no options yet');
+ok(!$stuff->has_option('foo'), '... we have no foo option');
+
+lives_ok {
+ $stuff->set_option(foo => 'bar');
+} '... set the option okay';
+
+ok($stuff->is_defined('foo'), '... foo is defined');
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 1, '... we have 1 option(s)');
+ok($stuff->has_option('foo'), '... we have a foo option');
+is_deeply($stuff->options, { foo => 'bar' }, '... got options now');
+
+lives_ok {
+ $stuff->set_option(bar => 'baz');
+} '... set the option okay';
+
+is($stuff->num_options, 2, '... we have 2 option(s)');
+is_deeply($stuff->options, { foo => 'bar', bar => 'baz' }, '... got more options now');
+
+is($stuff->get_option('foo'), 'bar', '... got the right option');
+
+is_deeply([ $stuff->get_option(qw(foo bar)) ], [qw(bar baz)], "get multiple options at once");
+
+lives_ok {
+ $stuff->set_option(oink => "blah", xxy => "flop");
+} '... set the option okay';
+
+is($stuff->num_options, 4, "4 options");
+is_deeply([ $stuff->get_option(qw(foo bar oink xxy)) ], [qw(bar baz blah flop)], "get multiple options at once");
+
+lives_ok {
+ $stuff->delete_option('bar');
+} '... deleted the option okay';
+
+lives_ok {
+ $stuff->delete_option('oink');
+} '... deleted the option okay';
+
+lives_ok {
+ $stuff->delete_option('xxy');
+} '... deleted the option okay';
+
+is($stuff->num_options, 1, '... we have 1 option(s)');
+is_deeply($stuff->options, { foo => 'bar' }, '... got more options now');
+
+$stuff->clear_options;
+
+is_deeply($stuff->options, { }, "... cleared options" );
+
+lives_ok {
+ $stuff->quantity(4);
+} '... options added okay with defaults';
+
+is($stuff->quantity, 4, 'reader part of curried accessor works');
+
+is_deeply($stuff->options, {quantity => 4}, '... returns what we expect');
+
+lives_ok {
+ Stuff->new(options => { foo => 'BAR' });
+} '... good constructor params';
+
+## check some errors
+
+dies_ok {
+ $stuff->set_option(bar => {});
+} '... could not add a hash ref where an string is expected';
+
+dies_ok {
+ Stuff->new(options => { foo => [] });
+} '... bad constructor params';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::Hash');
+
+is_deeply($options->handles, {
+ 'set_option' => 'set',
+ 'get_option' => 'get',
+ 'has_options' => 'empty',
+ 'num_options' => 'count',
+ 'clear_options' => 'clear',
+ 'delete_option' => 'delete',
+ 'has_option' => 'exists',
+ 'is_defined' => 'defined',
+ 'option_accessor' => 'accessor',
+ 'key_value' => 'kv',
+ 'options_elements' => 'elements',
+ 'quantity' => [ accessor => ['quantity'] ],
+}, '... got the right handles mapping');
+
+is($options->type_constraint->type_parameter, 'Str', '... got the right container type');
+
+$stuff->set_option( oink => "blah", xxy => "flop" );
+my @key_value = $stuff->key_value;
+is_deeply(
+ \@key_value,
+ [ [ 'xxy', 'flop' ], [ 'quantity', 4 ], [ 'oink', 'blah' ] ],
+ '... got the right key value pairs'
+);
+
+my %options_elements = $stuff->options_elements;
+is_deeply(
+ \%options_elements,
+ {
+ 'oink' => 'blah',
+ 'quantity' => 4,
+ 'xxy' => 'flop'
+ },
+ '... got the right hash elements'
+);
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 26;
+use Test::Moose;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Real;
+ use Moose;
+
+ has 'integer' => (
+ traits => [qw/Number/],
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 5 },
+ handles => {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+ inc => [ add => [ 1 ] ],
+ dec => [ sub => [ 1 ] ],
+ odd => [ mod => [ 2 ] ],
+ cut_in_half => [ div => [ 2 ] ],
+
+ },
+ );
+}
+
+my $real = Real->new;
+isa_ok($real, 'Real');
+
+can_ok($real, $_) for qw[
+ set add sub mul div mod abs inc dec odd cut_in_half
+];
+
+is $real->integer, 5, 'Default to five';
+
+$real->add(10);
+
+is $real->integer, 15, 'Add ten for fithteen';
+
+$real->sub(3);
+
+is $real->integer, 12, 'Subtract three for 12';
+
+$real->set(10);
+
+is $real->integer, 10, 'Set to ten';
+
+$real->div(2);
+
+is $real->integer, 5, 'divide by 2';
+
+$real->mul(2);
+
+is $real->integer, 10, 'multiplied by 2';
+
+$real->mod(2);
+
+is $real->integer, 0, 'Mod by 2';
+
+$real->set(7);
+
+$real->mod(5);
+
+is $real->integer, 2, 'Mod by 5';
+
+$real->set(-1);
+
+$real->abs;
+
+is $real->integer, 1, 'abs 1';
+
+$real->set(12);
+
+$real->inc;
+
+is $real->integer, 13, 'inc 12';
+
+$real->dec;
+
+is $real->integer, 12, 'dec 13';
+
+## test the meta
+
+my $attr = $real->meta->get_attribute('integer');
+does_ok($attr, 'Moose::AttributeHelpers::Trait::Number');
+
+is_deeply($attr->handles, {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+ inc => [ add => [ 1 ] ],
+ dec => [ sub => [ 1 ] ],
+ odd => [ mod => [ 2 ] ],
+ cut_in_half => [ div => [ 2 ] ],
+}, '... got the right handles mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 34;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+my $sort;
+my $less;
+my $up;
+{
+ package Stuff;
+ use Moose;
+
+ has '_options' => (
+ traits => [qw/Collection::List/],
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ init_arg => 'options',
+ default => sub { [] },
+ handles => {
+ 'num_options' => 'count',
+ 'has_options' => 'empty',
+ 'map_options', => 'map',
+ 'filter_options' => 'grep',
+ 'find_option' => 'find',
+ 'options' => 'elements',
+ 'join_options' => 'join',
+ 'get_option_at' => 'get',
+ 'get_first_option' => 'first',
+ 'get_last_option' => 'last',
+ 'sorted_options' => 'sort',
+ 'less_than_five' => [ grep => [ $less = sub { $_ < 5 } ] ],
+ 'up_by_one' => [ map => [ $up = sub { $_ + 1 } ] ],
+ 'dashify' => [ join => [ '-' ] ],
+ 'descending' => [ sort => [ $sort = sub { $_[1] <=> $_[0] } ] ],
+ },
+ );
+
+}
+
+my $stuff = Stuff->new(options => [ 1 .. 10 ]);
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ _options
+ num_options
+ has_options
+ map_options
+ filter_options
+ find_option
+ options
+ join_options
+ get_option_at
+ sorted_options
+];
+
+is_deeply($stuff->_options, [1 .. 10], '... got options');
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 10, '... got 2 options');
+cmp_ok($stuff->get_option_at(0), '==', 1, '... get option 0');
+cmp_ok($stuff->get_first_option, '==', 1, '... get first');
+cmp_ok($stuff->get_last_option, '==', 10, '... get last');
+
+is_deeply(
+[ $stuff->filter_options(sub { $_[0] % 2 == 0 }) ],
+[ 2, 4, 6, 8, 10 ],
+'... got the right filtered values'
+);
+
+is_deeply(
+[ $stuff->map_options(sub { $_[0] * 2 }) ],
+[ 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 ],
+'... got the right mapped values'
+);
+
+is($stuff->find_option(sub { $_[0] % 2 == 0 }), 2, '.. found the right option');
+
+is_deeply([ $stuff->options ], [1 .. 10], '... got the list of options');
+
+is($stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10', '... joined the list of options by :');
+
+is_deeply([ $stuff->sorted_options ], [sort (1..10)],
+ '... got sorted options (default sort order)');
+is_deeply([ $stuff->sorted_options( sub { $_[1] <=> $_[0] } ) ], [sort { $b <=> $a } (1..10)],
+ '... got sorted options (descending sort order) ');
+
+throws_ok { $stuff->sorted_options('foo') } qr/Argument must be a code reference/,
+ 'error when sort receives a non-coderef argument';
+
+# test the currying
+is_deeply([ $stuff->less_than_five() ], [1 .. 4]);
+
+is_deeply([ $stuff->up_by_one() ], [2 .. 11]);
+
+is($stuff->dashify, '1-2-3-4-5-6-7-8-9-10');
+
+is_deeply([$stuff->descending], [reverse 1 .. 10]);
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('_options');
+does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::List');
+
+is_deeply($options->handles, {
+ 'num_options' => 'count',
+ 'has_options' => 'empty',
+ 'map_options', => 'map',
+ 'filter_options' => 'grep',
+ 'find_option' => 'find',
+ 'options' => 'elements',
+ 'join_options' => 'join',
+ 'get_option_at' => 'get',
+ 'get_first_option' => 'first',
+ 'get_last_option' => 'last',
+ 'sorted_options' => 'sort',
+ 'less_than_five' => [ grep => [ $less ] ],
+ 'up_by_one' => [ map => [ $up ] ],
+ 'dashify' => [ join => [ '-' ] ],
+ 'descending' => [ sort => [ $sort ] ],
+}, '... got the right handles mapping');
+
+is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
+
+dies_ok {
+ $stuff->sort_in_place_options( undef );
+} '... sort rejects arg of invalid type';
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'word_histogram' => (
+ traits => [qw/Collection::Bag/],
+ is => 'ro',
+ handles => {
+ 'add_word' => 'add',
+ 'get_count_for' => 'get',
+ 'has_any_words' => 'empty',
+ 'num_words' => 'count',
+ 'delete_word' => 'delete',
+ }
+ );
+}
+
+my $stuff = Stuff->new();
+isa_ok($stuff, 'Stuff');
+
+can_ok($stuff, $_) for qw[
+ add_word
+ get_count_for
+ has_any_words
+ num_words
+ delete_word
+];
+
+ok(!$stuff->has_any_words, '... we have no words');
+is($stuff->num_words, 0, '... we have no words');
+
+lives_ok {
+ $stuff->add_word('bar');
+} '... set the words okay';
+
+ok($stuff->has_any_words, '... we have words');
+is($stuff->num_words, 1, '... we have 1 word(s)');
+is($stuff->get_count_for('bar'), 1, '... got words now');
+
+lives_ok {
+ $stuff->add_word('foo');
+ $stuff->add_word('bar') for 0 .. 3;
+ $stuff->add_word('baz') for 0 .. 10;
+} '... set the words okay';
+
+is($stuff->num_words, 3, '... we still have 1 word(s)');
+is($stuff->get_count_for('foo'), 1, '... got words now');
+is($stuff->get_count_for('bar'), 5, '... got words now');
+is($stuff->get_count_for('baz'), 11, '... got words now');
+
+## test the meta
+
+my $words = $stuff->meta->get_attribute('word_histogram');
+does_ok($words, 'Moose::AttributeHelpers::Trait::Collection::Bag');
+
+is_deeply($words->handles, {
+ 'add_word' => 'add',
+ 'get_count_for' => 'get',
+ 'has_any_words' => 'empty',
+ 'num_words' => 'count',
+ 'delete_word' => 'delete',
+}, '... got the right handles mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 21;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+my $uc;
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'string' => (
+ traits => [qw/String/],
+ is => 'rw',
+ isa => 'Str',
+ default => sub { '' },
+ handles => {
+ inc_string => 'inc',
+ append_string => 'append',
+ prepend_string => 'prepend',
+ match_string => 'match',
+ replace_string => 'replace',
+ chop_string => 'chop',
+ chomp_string => 'chomp',
+ clear_string => 'clear',
+ exclaim => [ append => [ '!' ] ],
+ capitalize_last => [ replace => [ qr/(.)$/, $uc = sub { uc $1 } ] ],
+ invalid_number => [ match => [ qr/\D/ ] ],
+ },
+ );
+}
+
+my $page = MyHomePage->new();
+isa_ok($page, 'MyHomePage');
+
+is($page->string, '', '... got the default value');
+
+$page->string('a');
+
+$page->inc_string;
+is($page->string, 'b', '... got the incremented value');
+
+$page->inc_string;
+is($page->string, 'c', '... got the incremented value (again)');
+
+$page->append_string("foo$/");
+is($page->string, "cfoo$/", 'appended to string');
+
+$page->chomp_string;
+is($page->string, "cfoo", 'chomped string');
+
+$page->chomp_string;
+is($page->string, "cfoo", 'chomped is noop');
+
+$page->chop_string;
+is($page->string, "cfo", 'chopped string');
+
+$page->prepend_string("bar");
+is($page->string, 'barcfo', 'prepended to string');
+
+is_deeply( [ $page->match_string(qr/([ao])/) ], [ "a" ], "match" );
+
+$page->replace_string(qr/([ao])/, sub { uc($1) });
+is($page->string, 'bArcfo', "substitution");
+
+$page->exclaim;
+is($page->string, 'bArcfo!', 'exclaim!');
+
+$page->string('Moosex');
+$page->capitalize_last;
+is($page->string, 'MooseX', 'capitalize last');
+
+$page->string('1234');
+ok(!$page->invalid_number, 'string "isn\'t an invalid number');
+
+$page->string('one two three four');
+ok($page->invalid_number, 'string an invalid number');
+
+$page->clear_string;
+is($page->string, '', "clear");
+
+# check the meta ..
+
+my $string = $page->meta->get_attribute('string');
+does_ok($string, 'Moose::AttributeHelpers::Trait::String');
+
+is($string->helper_type, 'Str', '... got the expected helper type');
+
+is($string->type_constraint->name, 'Str', '... got the expected type constraint');
+
+is_deeply($string->handles, {
+ inc_string => 'inc',
+ append_string => 'append',
+ prepend_string => 'prepend',
+ match_string => 'match',
+ replace_string => 'replace',
+ chop_string => 'chop',
+ chomp_string => 'chomp',
+ clear_string => 'clear',
+ exclaim => [ append => [ '!' ] ],
+ capitalize_last => [ replace => [ qr/(.)$/, $uc ] ],
+ invalid_number => [ match => [ qr/\D/ ] ],
+}, '... got the right handles methods');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Moose::AttributeHelpers;
+
+{
+ package Room;
+ use Moose;
+ has 'is_lit' => (
+ traits => ['Bool'],
+ is => 'rw',
+ isa => 'Bool',
+ default => sub { 0 },
+ handles => {
+ illuminate => 'set',
+ darken => 'unset',
+ flip_switch => 'toggle',
+ is_dark => 'not',
+ },
+ )
+}
+
+my $room = Room->new;
+$room->illuminate;
+ok $room->is_lit, 'set is_lit to 1 using ->illuminate';
+ok !$room->is_dark, 'check if is_dark does the right thing';
+
+$room->darken;
+ok !$room->is_lit, 'set is_lit to 0 using ->darken';
+ok $room->is_dark, 'check if is_dark does the right thing';
+
+$room->flip_switch;
+ok $room->is_lit, 'toggle is_lit back to 1 using ->flip_switch';
+ok !$room->is_dark, 'check if is_dark does the right thing';
+
+$room->flip_switch;
+ok !$room->is_lit, 'toggle is_lit back to 0 again using ->flip_switch';
+ok $room->is_dark, 'check if is_dark does the right thing';
+
Debolaz
Deltac
dexter
+doy
ewilhelm
+frodwith
Goulah
gphat
groditi
Kogman
kolibrie
konobi
+Lanyon
lbr
+Luehrs
McWhirter
merlyn
mst
Prather
Ragwitz
Reis
+rafl
rindolf
rlb
Rockway
Changelog
compat
datetimes
+dec
definedness
destructor
destructors
irc
IRC
isa
+kv
login
+mul
namespace
namespaced
namespaces
projects / gitmo/Moose.git / commitdiff