--- /dev/null
+
+package Moose::AttributeHelpers;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose 0.56 ();
+
+use Moose::AttributeHelpers::Meta::Method::Provided;
+use Moose::AttributeHelpers::Meta::Method::Curried;
+
+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;
+
+use Moose::AttributeHelpers::Counter;
+use Moose::AttributeHelpers::Number;
+use Moose::AttributeHelpers::String;
+use Moose::AttributeHelpers::Bool;
+use Moose::AttributeHelpers::Collection::List;
+use Moose::AttributeHelpers::Collection::Array;
+use Moose::AttributeHelpers::Collection::Hash;
+use Moose::AttributeHelpers::Collection::ImmutableHash;
+use Moose::AttributeHelpers::Collection::Bag;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers - Extend your attribute interfaces
+
+=head1 SYNOPSIS
+
+ package MyClass;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'mapping' => (
+ metaclass => '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<metaclass> parameter. Available meta classes are:
+
+=head1 PARAMETERS
+
+=head2 handles
+
+This points to a hashref that uses C<method> for the keys and
+C<stuff> for the values. The method will be added to
+the object itself and do what you want.
+
+=head2 curries
+
+This points to a hashref that uses C<provider> for the keys and
+has two choices for the value:
+
+You can supply C<< {method => [ @args ]} >> for the values. The method will be
+added to the object itself (always using C<@args> as the beginning arguments).
+
+Another approach to curry a method provider is to supply a coderef instead of an
+arrayref. The code ref takes C<$self>, C<$body>, and any additional arguments
+passed to the final method.
+
+ # ...
+
+ curries => {
+ grep => {
+ times_with_day => sub {
+ my ($self, $body, $datetime) = @_;
+ $body->($self, sub { $_->ymd eq $datetime->ymd });
+ }
+ }
+ }
+
+ # ...
+
+ $obj->times_with_day(DateTime->now); # takes datetime argument, checks day
+
+
+=head1 METHOD PROVIDERS
+
+=over
+
+=item L<Number|Moose::AttributeHelpers::Number>
+
+Common numerical operations.
+
+=item L<String|Moose::AttributeHelpers::String>
+
+Common methods for string operations.
+
+=item L<Counter|Moose::AttributeHelpers::Counter>
+
+Methods for incrementing and decrementing a counter attribute.
+
+=item L<Bool|Moose::AttributeHelpers::Bool>
+
+Common methods for boolean values.
+
+=item L<Collection::Hash|Moose::AttributeHelpers::Collection::Hash>
+
+Common methods for hash references.
+
+=item L<Collection::ImmutableHash|Moose::AttributeHelpers::Collection::ImmutableHash>
+
+Common methods for inspecting hash references.
+
+=item L<Collection::Array|Moose::AttributeHelpers::Collection::Array>
+
+Common methods for array references.
+
+=item L<Collection::List|Moose::AttributeHelpers::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::Bool;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Bool';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Bool;
+sub register_implementation { 'Moose::AttributeHelpers::Bool' }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Bool
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<method_provider>
+
+=item B<has_method_provider>
+
+=item B<helper_type>
+
+=item B<process_options_for_provides>
+
+Run before its superclass method.
+
+=item B<check_provides_values>
+
+Run after its superclass method.
+
+=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::Collection::Array;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Collection::Array';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Collection::Array;
+sub register_implementation { 'Moose::AttributeHelpers::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 { [] },
+ provides => {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ }
+ );
+
+=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::Collection::Bag;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Collection::Bag';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Collection::Bag;
+sub register_implementation { 'Moose::AttributeHelpers::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
+ provides => {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+ }
+ );
+
+=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_provides>
+
+=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::Collection::Hash;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Collection::Hash';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Collection::Hash;
+sub register_implementation { 'Moose::AttributeHelpers::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 { {} },
+ provides => {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'delete' => 'delete_option',
+ }
+ );
+
+=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::Collection::ImmutableHash;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Collection::ImmutableHash';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Collection::ImmutableHash;
+sub register_implementation { 'Moose::AttributeHelpers::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 { {} },
+ provides => {
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'keys' => 'get_option_list',
+ }
+ );
+
+=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::Collection::List;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Collection::List';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Collection::List;
+sub register_implementation { 'Moose::AttributeHelpers::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 { [] },
+ provides => {
+ map => 'map_options',
+ grep => 'filter_options',
+ }
+ );
+
+=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::Counter;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Counter';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Counter;
+sub register_implementation { 'Moose::AttributeHelpers::Counter' }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Counter
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<method_provider>
+
+=item B<has_method_provider>
+
+=item B<helper_type>
+
+=item B<process_options_for_provides>
+
+Run before its superclass method.
+
+=item B<check_provides_values>
+
+Run after its superclass method.
+
+=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::Meta::Method::Curried;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Method';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Meta::Method::Curried
+
+=head1 DESCRIPTION
+
+This is an extension of Moose::Meta::Method to mark I<curried> methods.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=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::Meta::Method::Provided;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Method';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::AttributeHelpers::Meta::Method::Provided
+
+=head1 DESCRIPTION
+
+This is an extension of Moose::Meta::Method to mark I<provided> methods.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=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::Array;
+use Moose::Role;
+
+our $VERSION = '0.19';
+$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 provied 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.19';
+$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.19';
+$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.19';
+$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.19';
+$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.19';
+$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.19';
+$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,
+ provides => {
+ elements => 'all_options',
+ map => 'map_options',
+ grep => 'filter_options',
+ find => 'find_option',
+ first => 'first_option',
+ last => 'last_option',
+ get => 'get_option',
+ join => 'join_options',
+ count => 'count_options',
+ empty => 'do_i_have_options',
+ sort => 'sorted_options',
+ }
+ );
+
+ 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.19';
+$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::Number;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::Number';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::Number;
+sub register_implementation { 'Moose::AttributeHelpers::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 },
+ provides => {
+ 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::String;
+use Moose;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'Moose::Meta::Attribute';
+with 'Moose::AttributeHelpers::Trait::String';
+
+no Moose;
+
+# register the alias ...
+package # hide me from search.cpan.org
+ Moose::Meta::Attribute::Custom::String;
+sub register_implementation { 'Moose::AttributeHelpers::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 { '' },
+ provides => {
+ append => "add_text",
+ replace => "replace_text",
+ }
+ );
+
+ 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<provides> 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_provides>
+
+Run before its superclass method.
+
+=item B<check_provides_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 analogeous 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
--- /dev/null
+
+package Moose::AttributeHelpers::Trait::Base;
+use Moose::Role;
+use Moose::Util::TypeConstraints;
+
+our $VERSION = '0.19';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+requires 'helper_type';
+
+# this is the method map you define ...
+has 'provides' => (
+ is => 'ro',
+ isa => 'HashRef',
+ default => sub {{}}
+);
+
+has 'curries' => (
+ is => 'ro',
+ isa => 'HashRef',
+ default => sub {{}}
+);
+
+# these next two are the possible methods
+# you can use in the 'provides' 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_provides {
+ 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_provides($options, $name);
+};
+
+## methods called after instantiation
+
+sub check_provides_values {
+ my $self = shift;
+
+ my $method_constructors = $self->method_constructors;
+
+ foreach my $key (keys %{$self->provides}) {
+ (exists $method_constructors->{$key})
+ || confess "$key is an unsupported method type";
+ }
+
+ foreach my $key (keys %{$self->curries}) {
+ (exists $method_constructors->{$key})
+ || confess "$key is an unsupported method type";
+ }
+}
+
+sub _curry {
+ my $self = shift;
+ my $code = shift;
+
+ my @args = @_;
+ return sub {
+ my $self = shift;
+ $code->($self, @args, @_)
+ };
+}
+
+sub _curry_sub {
+ my $self = shift;
+ my $body = shift;
+ my $code = shift;
+
+ return sub {
+ my $self = shift;
+ $code->($self, $body, @_)
+ };
+}
+
+after 'install_accessors' => sub {
+ my $attr = shift;
+ my $class = $attr->associated_class;
+
+ # grab the reader and writer methods
+ # as well, this will be useful for
+ # our method provider constructors
+ my $attr_reader = $attr->get_read_method_ref;
+ my $attr_writer = $attr->get_write_method_ref;
+
+
+ # before we install them, lets
+ # make sure they are valid
+ $attr->check_provides_values;
+
+ my $method_constructors = $attr->method_constructors;
+
+ my $class_name = $class->name;
+
+ while (my ($constructor, $constructed) = each %{$attr->curries}) {
+ my $method_code;
+ while (my ($curried_name, $curried_arg) = each(%$constructed)) {
+ if ($class->has_method($curried_name)) {
+ confess
+ "The method ($curried_name) already ".
+ "exists in class (" . $class->name . ")";
+ }
+ my $body = $method_constructors->{$constructor}->(
+ $attr,
+ $attr_reader,
+ $attr_writer,
+ );
+
+ if (ref $curried_arg eq 'ARRAY') {
+ $method_code = $attr->_curry($body, @$curried_arg);
+ }
+ elsif (ref $curried_arg eq 'CODE') {
+ $method_code = $attr->_curry_sub($body, $curried_arg);
+ }
+ else {
+ confess "curries parameter must be ref type HASH or CODE";
+ }
+
+ my $method = Moose::AttributeHelpers::Meta::Method::Curried->wrap(
+ $method_code,
+ package_name => $class_name,
+ name => $curried_name,
+ );
+
+ $attr->associate_method($method);
+ $class->add_method($curried_name => $method);
+ }
+ }
+
+ foreach my $key (keys %{$attr->provides}) {
+
+ my $method_name = $attr->provides->{$key};
+
+ if ($class->has_method($method_name)) {
+ confess "The method ($method_name) already exists in class (" . $class->name . ")";
+ }
+
+ my $method = Moose::AttributeHelpers::Meta::Method::Provided->wrap(
+ $method_constructors->{$key}->(
+ $attr,
+ $attr_reader,
+ $attr_writer,
+ ),
+ package_name => $class_name,
+ name => $method_name,
+ );
+
+ $attr->associate_method($method);
+ $class->add_method($method_name => $method);
+ }
+};
+
+after 'remove_accessors' => sub {
+ my $attr = shift;
+ my $class = $attr->associated_class;
+
+ # provides accessors
+ foreach my $key (keys %{$attr->provides}) {
+ my $method_name = $attr->provides->{$key};
+ my $method = $class->get_method($method_name);
+ $class->remove_method($method_name)
+ if blessed($method) &&
+ $method->isa('Moose::AttributeHelpers::Meta::Method::Provided');
+ }
+
+ # curries accessors
+ foreach my $key (keys %{$attr->curries}) {
+ my $method_name = $attr->curries->{$key};
+ my $method = $class->get_method($method_name);
+ $class->remove_method($method_name)
+ if blessed($method) &&
+ $method->isa('Moose::AttributeHelpers::Meta::Method::Provided');
+ }
+};
+
+no Moose::Role;
+no Moose::Util::TypeConstraints;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Moose::AttributeHelpers::Trait::Base - base role for helpers
+
+=head1 METHODS
+
+=head2 check_provides_values
+
+Confirms that provides (and curries) has all valid possibilities in it.
+
+=head2 process_options_for_provides
+
+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.19';
+$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_provides' => sub {
+ my ($self, $options, $name) = @_;
+
+ # Set some default attribute options here unless already defined
+ if ((my $type = $self->helper_type) && !exists $options->{isa}){
+ $options->{isa} = $type;
+ }
+};
+
+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 },
+ provides => {
+ set => 'illuminate',
+ unset => 'darken',
+ toggle => 'flip_switch',
+ not => 'is_dark'
+ }
+ );
+
+ 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.19';
+$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_provides>
+
+=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.19';
+$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 { [] },
+ provides => {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ }
+ );
+
+=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.19';
+$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_provides' => sub {
+ my ($self, $options, $name) = @_;
+
+ # Set some default attribute options here unless already defined
+ if ((my $type = $self->helper_type) && !exists $options->{isa}){
+ $options->{isa} = $type;
+ }
+
+ $options->{default} = sub { +{} } unless exists $options->{default};
+};
+
+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
+ provides => {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+ }
+ );
+
+=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_provides>
+
+=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.19';
+$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 { {} },
+ provides => {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'delete' => 'delete_option',
+ }
+ );
+
+=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.19';
+$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 { {} },
+ provides => {
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'keys' => 'get_option_list',
+ }
+ );
+
+=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.19';
+$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 { [] },
+ provides => {
+ map => 'map_options',
+ grep => 'filter_options',
+ }
+ );
+
+=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.19';
+$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_provides' => sub {
+ my ($self, $options, $name) = @_;
+
+ # Set some default attribute options here unless already defined
+ if ((my $type = $self->helper_type) && !exists $options->{isa}){
+ $options->{isa} = $type;
+ }
+
+ $options->{is} = 'ro' unless exists $options->{is};
+ $options->{default} = 0 unless exists $options->{default};
+};
+
+after 'check_provides_values' => sub {
+ my $self = shift;
+ my $provides = $self->provides;
+
+ unless (scalar keys %$provides) {
+ my $method_constructors = $self->method_constructors;
+ my $attr_name = $self->name;
+
+ foreach my $method (keys %$method_constructors) {
+ $provides->{$method} = ($method . '_' . $attr_name);
+ }
+ }
+};
+
+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 },
+ provides => {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ reset => 'reset_counter',
+ }
+ );
+
+ 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 decremeneted.
+
+If your attribute definition does not include any of I<is>, I<isa>,
+I<default> or I<provides> 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_provides>
+
+Run before its superclass method.
+
+=item B<check_provides_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.19';
+$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 },
+ provides => {
+ 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.19';
+$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_provides' => sub {
+ my ($self, $options, $name) = @_;
+
+ # Set some default attribute options here unless already defined
+ if ((my $type = $self->helper_type) && !exists $options->{isa}){
+ $options->{isa} = $type;
+ }
+
+ $options->{is} = 'rw' unless exists $options->{is};
+ $options->{default} = '' unless exists $options->{default};
+};
+
+after 'check_provides_values' => sub {
+ my $self = shift;
+ my $provides = $self->provides;
+
+ unless (scalar keys %$provides) {
+ my $method_constructors = $self->method_constructors;
+ my $attr_name = $self->name;
+
+ foreach my $method (keys %$method_constructors) {
+ $provides->{$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 { '' },
+ provides => {
+ append => "add_text",
+ replace => "replace_text",
+ }
+ );
+
+ 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<provides> 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_provides>
+
+Run before its superclass method.
+
+=item B<check_provides_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 analogeous 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
--- /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 => 18;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'counter' => (
+ metaclass => 'Counter',
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 0 },
+ provides => {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ reset => 'reset_counter',
+ set => 'set_counter'
+ }
+ );
+}
+
+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');
+isa_ok($counter, 'Moose::AttributeHelpers::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->provides, {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ reset => 'reset_counter',
+ set => 'set_counter'
+}, '... got the right provides methods');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 69;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+
+ has 'options' => (
+ metaclass => 'Collection::Array',
+ is => 'ro',
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ provides => {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ 'shift' => 'remove_first_option',
+ 'unshift' => 'insert_options',
+ 'get' => 'get_option_at',
+ 'set' => 'set_option_at',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'clear' => 'clear_options',
+ 'splice' => 'splice_options',
+ 'sort_in_place' => 'sort_options_in_place',
+ 'accessor' => 'option_accessor',
+ },
+ curries => {
+ 'push' => {
+ add_options_with_speed => ['funrolls', 'funbuns']
+ },
+ 'unshift' => {
+ prepend_prerequisites_along_with => ['first', 'second']
+ },
+ 'sort_in_place' => { descending_options => [ 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');
+isa_ok($options, 'Moose::AttributeHelpers::Collection::Array');
+
+is_deeply($options->provides, {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ 'shift' => 'remove_first_option',
+ 'unshift' => 'insert_options',
+ 'get' => 'get_option_at',
+ 'set' => 'set_option_at',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'clear' => 'clear_options',
+ 'splice' => 'splice_options',
+ 'sort_in_place' => 'sort_options_in_place',
+ 'accessor' => 'option_accessor',
+}, '... got the right provides 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 => 50;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'options' => (
+ metaclass => 'Collection::Hash',
+ is => 'ro',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ provides => {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+ 'exists' => 'has_option',
+ 'defined' => 'is_defined',
+ 'accessor' => 'option_accessor',
+ 'kv' => 'key_value',
+ 'elements' => 'options_elements',
+ },
+ curries => {
+ 'accessor' => {
+ quantity => ['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';
+
+dies_ok {
+ my $stuff = Stuff->new;
+ $stuff->option_accessor();
+} '... accessor dies on 0 args';
+
+dies_ok {
+ my $stuff = Stuff->new;
+ $stuff->option_accessor(1 => 2, 3);
+} '... accessor dies on 3 args';
+
+dies_ok {
+ my $stuff = Stuff->new;
+ $stuff->option_accessor(1 => 2, 3 => 4);
+} '... accessor dies on 4 args';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+isa_ok($options, 'Moose::AttributeHelpers::Collection::Hash');
+
+is_deeply($options->provides, {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+ 'defined' => 'is_defined',
+ 'exists' => 'has_option',
+ 'accessor' => 'option_accessor',
+ 'kv' => 'key_value',
+ 'elements' => 'options_elements',
+}, '... got the right provides 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;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Real;
+ use Moose;
+
+ has 'integer' => (
+ metaclass => 'Number',
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 5 },
+ provides => {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+ },
+ curries => {
+ add => {inc => [ 1 ]},
+ sub => {dec => [ 1 ]},
+ mod => {odd => [ 2 ]},
+ div => {cut_in_half => [ 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');
+isa_ok($attr, 'Moose::AttributeHelpers::Number');
+
+is_deeply($attr->provides, {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+}, '... got the right provides mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 35;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+
+ has '_options' => (
+ metaclass => 'Collection::List',
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ init_arg => 'options',
+ default => sub { [] },
+ provides => {
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'map' => 'map_options',
+ 'grep' => 'filter_options',
+ 'find' => 'find_option',
+ 'elements' => 'options',
+ 'join' => 'join_options',
+ 'get' => 'get_option_at',
+ 'first' => 'get_first_option',
+ 'last' => 'get_last_option',
+ 'sort' => 'sorted_options',
+ },
+ curries => {
+ 'grep' => {less_than_five => [ sub { $_ < 5 } ]},
+ 'map' => {up_by_one => [ sub { $_ + 1 } ]},
+ 'join' => {dashify => [ '-' ]},
+ 'sort' => {descending => [ sub { $_[1] <=> $_[0] } ]},
+ }
+ );
+
+ has animals => (
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ metaclass => 'Collection::List',
+ curries => {
+ grep => {
+ double_length_of => sub {
+ my ($self, $body, $arg) = @_;
+
+ $body->($self, sub { length($_) == length($arg) * 2 });
+ }
+ }
+ }
+ )
+}
+
+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');
+
+$stuff->animals([ qw/cat duck horse cattle gorilla elephant flamingo kangaroo/ ]);
+
+# 4 * 2 = 8
+is_deeply(
+ [ sort $stuff->double_length_of('fish') ],
+ [ sort qw/elephant flamingo kangaroo/ ],
+ 'returns all elements with double length of string "fish"'
+);
+
+is_deeply([$stuff->descending], [reverse 1 .. 10]);
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('_options');
+isa_ok($options, 'Moose::AttributeHelpers::Collection::List');
+
+is_deeply($options->provides, {
+ 'map' => 'map_options',
+ 'grep' => 'filter_options',
+ 'find' => 'find_option',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'elements' => 'options',
+ 'join' => 'join_options',
+ 'get' => 'get_option_at',
+ 'first' => 'get_first_option',
+ 'last' => 'get_last_option',
+ 'sort' => 'sorted_options',
+}, '... got the right provides 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;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+ use Moose::AttributeHelpers;
+
+ has 'word_histogram' => (
+ metaclass => 'Collection::Bag',
+ is => 'ro',
+ provides => {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+ }
+ );
+}
+
+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');
+isa_ok($words, 'Moose::AttributeHelpers::Collection::Bag');
+
+is_deeply($words->provides, {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+}, '... got the right provides mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 27;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'string' => (
+ metaclass => 'String',
+ is => 'rw',
+ isa => 'Str',
+ default => sub { '' },
+ provides => {
+ inc => 'inc_string',
+ append => 'append_string',
+ prepend => 'prepend_string',
+ match => 'match_string',
+ replace => 'replace_string',
+ chop => 'chop_string',
+ chomp => 'chomp_string',
+ clear => 'clear_string',
+ substr => 'sub_string',
+ },
+ curries => {
+ append => {exclaim => [ '!' ]},
+ replace => {capitalize_last => [ qr/(.)$/, sub { uc $1 } ]},
+ match => {invalid_number => [ qr/\D/ ]},
+ substr => {shift_chars => sub { $_[1]->($_[0], 0, $_[2], '') } },
+ }
+ );
+}
+
+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!');
+
+is($page->sub_string(2), 'rcfo!', 'substr(offset)');
+is($page->sub_string(2, 2), 'rc', 'substr(offset, length)');
+is($page->sub_string(2, 2, ''), 'rc', 'substr(offset, length, replacement)');
+is($page->string, 'bAfo!', 'replacement got inserted');
+
+is($page->shift_chars(2), 'bA', 'curried substr');
+is($page->string, 'fo!', 'replacement got inserted');
+
+$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');
+isa_ok($string, 'Moose::AttributeHelpers::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->provides, {
+ inc => 'inc_string',
+ append => 'append_string',
+ prepend => 'prepend_string',
+ match => 'match_string',
+ replace => 'replace_string',
+ chop => 'chop_string',
+ chomp => 'chomp_string',
+ clear => 'clear_string',
+ substr => 'sub_string',
+}, '... got the right provides methods');
+
--- /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' => (
+ metaclass => 'Collection::Array',
+ is => 'ro',
+ isa => 'ArrayRef[Foo]',
+ );
+
+ package Bulkie::Role;
+ use Moose::Role;
+
+ has 'stuff' => (
+ metaclass => 'Collection::Array',
+ is => 'ro',
+ isa => 'ArrayRef',
+ provides => {
+ 'get' => 'get_stuff'
+ }
+ );
+
+ 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;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'counter' => (metaclass => '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');
+isa_ok($counter, 'Moose::AttributeHelpers::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->provides, {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ reset => 'reset_counter',
+ set => 'set_counter',
+}, '... got the right default provides 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' => (
+ metaclass => 'Bool',
+ is => 'rw',
+ isa => 'Bool',
+ default => sub { 0 },
+ provides => {
+ set => 'illuminate',
+ unset => 'darken',
+ toggle => 'flip_switch',
+ not => 'is_dark'
+ }
+ )
+}
+
+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';
+
--- /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' => (
+ metaclass => 'Counter',
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 0 },
+ provides => {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ reset => 'reset_counter',
+ }
+ );
+}
+
+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 => (
+ metaclass => 'Collection::Array',
+ is => 'ro',
+ isa => 'ArrayRef[Observer]',
+ auto_deref => 1,
+ default => sub { [] },
+ provides => { 'push' => 'add_observer', count => 'count_observers' }
+);
+
+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 => (
+ metaclass => 'Counter',
+ is => 'ro',
+ isa => 'Int',
+ default => 0,
+ provides => {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ }
+);
+
+after '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');
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 14;
+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 },
+ provides => {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ reset => 'reset_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, 'Int', '... got the expected type constraint');
+
+is_deeply($counter->provides, {
+ inc => 'inc_counter',
+ dec => 'dec_counter',
+ reset => 'reset_counter',
+}, '... got the right provides methods');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 51;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+
+ has 'options' => (
+ traits => [qw/Collection::Array/],
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ default => sub { [] },
+ provides => {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ 'shift' => 'remove_first_option',
+ 'unshift' => 'insert_options',
+ 'get' => 'get_option_at',
+ 'set' => 'set_option_at',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'clear' => 'clear_options',
+ }
+ );
+}
+
+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
+];
+
+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" );
+
+## check some errors
+
+dies_ok {
+ $stuff->add_options([]);
+} '... could not add an array ref where an int is expected';
+
+dies_ok {
+ $stuff->insert_options(undef);
+} '... could not add an undef where an int is expected';
+
+dies_ok {
+ $stuff->set_option(5, {});
+} '... could not add a hash ref where an int is expected';
+
+dies_ok {
+ Stuff->new(options => [ 'Foo', 10, 'Bar', 20 ]);
+} '... bad constructor params';
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('options');
+does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::Array');
+
+is_deeply($options->provides, {
+ 'push' => 'add_options',
+ 'pop' => 'remove_last_option',
+ 'shift' => 'remove_first_option',
+ 'unshift' => 'insert_options',
+ 'get' => 'get_option_at',
+ 'set' => 'set_option_at',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'clear' => 'clear_options',
+}, '... got the right provies mapping');
+
+is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 35;
+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 { {} },
+ provides => {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+ }
+ );
+}
+
+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
+];
+
+ok(!$stuff->has_options, '... we have no options');
+is($stuff->num_options, 0, '... we have no options');
+
+is_deeply($stuff->options, {}, '... no options yet');
+
+lives_ok {
+ $stuff->set_option(foo => 'bar');
+} '... set the option okay';
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 1, '... we have 1 option(s)');
+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->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->provides, {
+ 'set' => 'set_option',
+ 'get' => 'get_option',
+ 'empty' => 'has_options',
+ 'count' => 'num_options',
+ 'clear' => 'clear_options',
+ 'delete' => 'delete_option',
+}, '... got the right provies 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 => 20;
+use Test::Moose;
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Real;
+ use Moose;
+
+ has 'integer' => (
+ traits => [qw/Number/],
+ is => 'ro',
+ isa => 'Int',
+ default => sub { 5 },
+ provides => {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+ }
+ );
+}
+
+my $real = Real->new;
+isa_ok($real, 'Real');
+
+can_ok($real, $_) for qw[
+ set add sub mul div mod abs
+];
+
+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';
+
+## test the meta
+
+my $attr = $real->meta->get_attribute('integer');
+does_ok($attr, 'Moose::AttributeHelpers::Trait::Number');
+
+is_deeply($attr->provides, {
+ set => 'set',
+ add => 'add',
+ sub => 'sub',
+ mul => 'mul',
+ div => 'div',
+ mod => 'mod',
+ abs => 'abs',
+}, '... got the right provides mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 21;
+use Test::Exception;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package Stuff;
+ use Moose;
+
+ has '_options' => (
+ traits => [qw/Collection::List/],
+ is => 'ro',
+ isa => 'ArrayRef[Int]',
+ init_arg => 'options',
+ default => sub { [] },
+ provides => {
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'map' => 'map_options',
+ 'grep' => 'filter_options',
+ 'find' => 'find_option',
+ 'elements' => 'options',
+ 'join' => 'join_options',
+ }
+ );
+}
+
+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
+];
+
+is_deeply($stuff->_options, [1 .. 10], '... got options');
+
+ok($stuff->has_options, '... we have options');
+is($stuff->num_options, 10, '... got 2 options');
+
+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 :');
+
+## test the meta
+
+my $options = $stuff->meta->get_attribute('_options');
+does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::List');
+
+is_deeply($options->provides, {
+ 'map' => 'map_options',
+ 'grep' => 'filter_options',
+ 'find' => 'find_option',
+ 'count' => 'num_options',
+ 'empty' => 'has_options',
+ 'elements' => 'options',
+ 'join' => 'join_options',
+}, '... got the right provies mapping');
+
+is($options->type_constraint->type_parameter, 'Int', '... got the right container 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',
+ provides => {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+ }
+ );
+}
+
+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->provides, {
+ 'add' => 'add_word',
+ 'get' => 'get_count_for',
+ 'empty' => 'has_any_words',
+ 'count' => 'num_words',
+ 'delete' => 'delete_word',
+}, '... got the right provides mapping');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 17;
+use Test::Moose 'does_ok';
+
+BEGIN {
+ use_ok('Moose::AttributeHelpers');
+}
+
+{
+ package MyHomePage;
+ use Moose;
+
+ has 'string' => (
+ traits => [qw/String/],
+ is => 'rw',
+ isa => 'Str',
+ default => sub { '' },
+ provides => {
+ inc => 'inc_string',
+ append => 'append_string',
+ prepend => 'prepend_string',
+ match => 'match_string',
+ replace => 'replace_string',
+ chop => 'chop_string',
+ chomp => 'chomp_string',
+ clear => 'clear_string',
+ }
+ );
+}
+
+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->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->provides, {
+ inc => 'inc_string',
+ append => 'append_string',
+ prepend => 'prepend_string',
+ match => 'match_string',
+ replace => 'replace_string',
+ chop => 'chop_string',
+ chomp => 'chomp_string',
+ clear => 'clear_string',
+}, '... got the right provides 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 },
+ provides => {
+ set => 'illuminate',
+ unset => 'darken',
+ toggle => 'flip_switch',
+ not => 'is_dark'
+ }
+ )
+}
+
+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';
+
projects / gitmo/Moose.git / commitdiff