From: Jesse Luehrs Date: Mon, 1 Jun 2009 23:52:01 +0000 (-0500) Subject: Merge branch 'master' into traits X-Git-Tag: 0.18_01~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4a35a0ad2542b236a6ea02022d55c4193a58a321;hp=d071f896e163e4f4d15cc79e08a62d68cdfb05b9;p=gitmo%2FMooseX-AttributeHelpers.git Merge branch 'master' into traits Conflicts: lib/MooseX/AttributeHelpers/Trait/Base.pm --- diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm index ea61f20..69331b0 100644 --- a/lib/MooseX/AttributeHelpers.pm +++ b/lib/MooseX/AttributeHelpers.pm @@ -10,6 +10,15 @@ use Moose 0.56 (); use MooseX::AttributeHelpers::Meta::Method::Provided; use MooseX::AttributeHelpers::Meta::Method::Curried; +use MooseX::AttributeHelpers::Trait::Counter; +use MooseX::AttributeHelpers::Trait::Number; +use MooseX::AttributeHelpers::Trait::String; +use MooseX::AttributeHelpers::Trait::Collection::List; +use MooseX::AttributeHelpers::Trait::Collection::Array; +use MooseX::AttributeHelpers::Trait::Collection::Hash; +use MooseX::AttributeHelpers::Trait::Collection::ImmutableHash; +use MooseX::AttributeHelpers::Trait::Collection::Bag; + use MooseX::AttributeHelpers::Counter; use MooseX::AttributeHelpers::Number; use MooseX::AttributeHelpers::String; diff --git a/lib/MooseX/AttributeHelpers/Collection/Array.pm b/lib/MooseX/AttributeHelpers/Collection/Array.pm index e1090fe..44a587a 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Array.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Array.pm @@ -6,15 +6,8 @@ our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Array; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Array' -); - -sub helper_type { 'ArrayRef' } +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Collection::Array'; no Moose; diff --git a/lib/MooseX/AttributeHelpers/Collection/Bag.pm b/lib/MooseX/AttributeHelpers/Collection/Bag.pm index 7456dab..3588a3d 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Bag.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Bag.pm @@ -1,37 +1,15 @@ package MooseX::AttributeHelpers::Collection::Bag; use Moose; -use Moose::Util::TypeConstraints; our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Bag; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Bag' -); - -subtype 'Bag' => as 'HashRef[Int]'; - -sub helper_type { 'Bag' } - -before 'process_options_for_provides' => sub { - my ($self, $options, $name) = @_; - - # Set some default attribute options here unless already defined - if ((my $type = $self->helper_type) && !exists $options->{isa}){ - $options->{isa} = $type; - } - - $options->{default} = sub { +{} } unless exists $options->{default}; -}; +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Collection::Bag'; no Moose; -no Moose::Util::TypeConstraints; # register the alias ... package # hide me from search.cpan.org diff --git a/lib/MooseX/AttributeHelpers/Collection/Hash.pm b/lib/MooseX/AttributeHelpers/Collection/Hash.pm index 34203c9..f52e61f 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Hash.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Hash.pm @@ -6,15 +6,8 @@ our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Hash; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Hash' -); - -sub helper_type { 'HashRef' } +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Collection::Hash'; no Moose; diff --git a/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm b/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm index e1dca3f..dfba523 100644 --- a/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm +++ b/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm @@ -6,15 +6,8 @@ our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::ImmutableHash; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash' -); - -sub helper_type { 'HashRef' } +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Collection::ImmutableHash'; no Moose; diff --git a/lib/MooseX/AttributeHelpers/Collection/List.pm b/lib/MooseX/AttributeHelpers/Collection/List.pm index b81e56d..d6fc0bb 100644 --- a/lib/MooseX/AttributeHelpers/Collection/List.pm +++ b/lib/MooseX/AttributeHelpers/Collection/List.pm @@ -6,15 +6,8 @@ our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::List; - -extends 'MooseX::AttributeHelpers::Collection'; - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::List' -); - -sub helper_type { 'ArrayRef' } +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Collection::List'; no Moose; diff --git a/lib/MooseX/AttributeHelpers/Counter.pm b/lib/MooseX/AttributeHelpers/Counter.pm index 38d9875..9a2cea2 100644 --- a/lib/MooseX/AttributeHelpers/Counter.pm +++ b/lib/MooseX/AttributeHelpers/Counter.pm @@ -6,41 +6,8 @@ our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Counter; - -extends 'MooseX::AttributeHelpers::Base'; - -has '+method_provider' => ( - default => 'MooseX::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); - } - } -}; +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Counter'; no Moose; diff --git a/lib/MooseX/AttributeHelpers/Number.pm b/lib/MooseX/AttributeHelpers/Number.pm index c19ca3f..aefb9a7 100644 --- a/lib/MooseX/AttributeHelpers/Number.pm +++ b/lib/MooseX/AttributeHelpers/Number.pm @@ -5,51 +5,9 @@ our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -extends 'MooseX::AttributeHelpers::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' => ( - 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])) ) }; - }, - } - } -); - +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Number'; + no Moose; # register the alias ... diff --git a/lib/MooseX/AttributeHelpers/String.pm b/lib/MooseX/AttributeHelpers/String.pm index facca62..366c74c 100644 --- a/lib/MooseX/AttributeHelpers/String.pm +++ b/lib/MooseX/AttributeHelpers/String.pm @@ -6,41 +6,8 @@ our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::String; - -extends 'MooseX::AttributeHelpers::Base'; - -has '+method_provider' => ( - default => 'MooseX::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); - } - } -}; +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::String'; no Moose; diff --git a/lib/MooseX/AttributeHelpers/Base.pm b/lib/MooseX/AttributeHelpers/Trait/Base.pm similarity index 81% rename from lib/MooseX/AttributeHelpers/Base.pm rename to lib/MooseX/AttributeHelpers/Trait/Base.pm index 96217a8..44bb4f9 100644 --- a/lib/MooseX/AttributeHelpers/Base.pm +++ b/lib/MooseX/AttributeHelpers/Trait/Base.pm @@ -1,13 +1,13 @@ -package MooseX::AttributeHelpers::Base; -use Moose; +package MooseX::AttributeHelpers::Trait::Base; +use Moose::Role; use Moose::Util::TypeConstraints; our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -extends 'Moose::Meta::Attribute'; +requires 'helper_type'; # this is the method map you define ... has 'provides' => ( @@ -27,11 +27,8 @@ has 'curries' => ( # provide a Class or Role which we can # collect the method providers from -has 'method_provider' => ( - is => 'ro', - isa => 'ClassName', - predicate => 'has_method_provider', -); + +# requires_attr 'method_provider' # or you can provide a HASH ref of anon subs # yourself. This will also collect and store @@ -60,8 +57,6 @@ has '+type_constraint' => (required => 1); ## Methods called prior to instantiation -sub helper_type { () } - sub process_options_for_provides { my ($self, $options) = @_; @@ -227,92 +222,8 @@ after 'remove_accessors' => sub { } }; -no Moose; +no Moose::Role; no Moose::Util::TypeConstraints; 1; -__END__ - -=pod - -=head1 NAME - -MooseX::AttributeHelpers::Base - Base class for attribute helpers - -=head1 DESCRIPTION - -Documentation to come. - -=head1 ATTRIBUTES - -=over 4 - -=item B - -=item B - -=item B - -=item B - -=back - -=head1 EXTENDED ATTRIBUTES - -=over 4 - -=item B - -C is now required. - -=item B - -C is now required. - -=back - -=head1 METHODS - -=over 4 - -=item B - -=item B - -=item B - -=item B - -=item B - -=item B - -=item B - -=item B - -=item B - -=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 Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2007-2008 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/MooseX/AttributeHelpers/Collection.pm b/lib/MooseX/AttributeHelpers/Trait/Collection.pm similarity index 86% rename from lib/MooseX/AttributeHelpers/Collection.pm rename to lib/MooseX/AttributeHelpers/Trait/Collection.pm index 64ed47d..44c8081 100644 --- a/lib/MooseX/AttributeHelpers/Collection.pm +++ b/lib/MooseX/AttributeHelpers/Trait/Collection.pm @@ -1,14 +1,14 @@ -package MooseX::AttributeHelpers::Collection; -use Moose; +package MooseX::AttributeHelpers::Trait::Collection; +use Moose::Role; our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -extends 'MooseX::AttributeHelpers::Base'; +with 'MooseX::AttributeHelpers::Trait::Base'; -no Moose; +no Moose::Role; 1; @@ -60,3 +60,4 @@ This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut + diff --git a/lib/MooseX/AttributeHelpers/Trait/Collection/Array.pm b/lib/MooseX/AttributeHelpers/Trait/Collection/Array.pm new file mode 100644 index 0000000..d1c57e0 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Collection/Array.pm @@ -0,0 +1,98 @@ + +package MooseX::AttributeHelpers::Trait::Collection::Array; +use Moose::Role; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::Array; + +with 'MooseX::AttributeHelpers::Trait::Collection'; + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::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 { + 'MooseX::AttributeHelpers::Trait::Collection::Array' +} + + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::Array + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::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 +for more details. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/lib/MooseX/AttributeHelpers/Trait/Collection/Bag.pm b/lib/MooseX/AttributeHelpers/Trait/Collection/Bag.pm new file mode 100644 index 0000000..96a7bbe --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Collection/Bag.pm @@ -0,0 +1,116 @@ + +package MooseX::AttributeHelpers::Trait::Collection::Bag; +use Moose::Role; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::Bag; + +with 'MooseX::AttributeHelpers::Trait::Collection'; + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::AttributeHelpers::MethodProvider::Bag' +); + +subtype 'Bag' => as 'HashRef[Int]'; + +sub helper_type { 'Bag' } + +before 'process_options_for_provides' => sub { + my ($self, $options, $name) = @_; + + # Set some default attribute options here unless already defined + if ((my $type = $self->helper_type) && !exists $options->{isa}){ + $options->{isa} = $type; + } + + $options->{default} = sub { +{} } unless exists $options->{default}; +}; + +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 { + 'MooseX::AttributeHelpers::Trait::Collection::Bag' +} + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::Bag + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::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 +for more details. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/lib/MooseX/AttributeHelpers/Trait/Collection/Hash.pm b/lib/MooseX/AttributeHelpers/Trait/Collection/Hash.pm new file mode 100644 index 0000000..73070d3 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Collection/Hash.pm @@ -0,0 +1,101 @@ + +package MooseX::AttributeHelpers::Trait::Collection::Hash; +use Moose::Role; + +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::Hash; + +with 'MooseX::AttributeHelpers::Trait::Collection'; + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::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 { + 'MooseX::AttributeHelpers::Trait::Collection::Hash' +} + + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::Hash + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::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 an Hash attribute which provides a number of +hash-like operations. See L +for more details. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/lib/MooseX/AttributeHelpers/Trait/Collection/ImmutableHash.pm b/lib/MooseX/AttributeHelpers/Trait/Collection/ImmutableHash.pm new file mode 100644 index 0000000..b963404 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Collection/ImmutableHash.pm @@ -0,0 +1,99 @@ + +package MooseX::AttributeHelpers::Trait::Collection::ImmutableHash; +use Moose::Role; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::ImmutableHash; + +with 'MooseX::AttributeHelpers::Trait::Collection'; + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::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 { + 'MooseX::AttributeHelpers::Trait::Collection::ImmutableHash' +} + + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::ImmutableHash + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::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 +for more details. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/lib/MooseX/AttributeHelpers/Trait/Collection/List.pm b/lib/MooseX/AttributeHelpers/Trait/Collection/List.pm new file mode 100644 index 0000000..a62bf5d --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Collection/List.pm @@ -0,0 +1,98 @@ + +package MooseX::AttributeHelpers::Trait::Collection::List; +use Moose::Role; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::List; + +with 'MooseX::AttributeHelpers::Trait::Collection'; + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::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 { + 'MooseX::AttributeHelpers::Trait::Collection::List' +} + + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::List + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::AttributeHelpers; + + has 'options' => ( + metaclass => 'Collection::List', + is => 'ro', + isa => 'ArrayRef[Int]', + default => sub { [] }, + provides => { + map => 'map_options', + grep => 'fitler_options', + } + ); + +=head1 DESCRIPTION + +This module provides an List attribute which provides a number of +list operations. See L +for more details. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/lib/MooseX/AttributeHelpers/Trait/Counter.pm b/lib/MooseX/AttributeHelpers/Trait/Counter.pm new file mode 100644 index 0000000..d402f13 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Counter.pm @@ -0,0 +1,56 @@ + +package MooseX::AttributeHelpers::Trait::Counter; +use Moose::Role; + +with 'MooseX::AttributeHelpers::Trait::Base' + => { excludes => ['method_provider'] }; + +our $VERSION = '0.03'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::Counter; + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::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 { 'MooseX::AttributeHelpers::Trait::Counter' } + +1; + diff --git a/lib/MooseX/AttributeHelpers/Trait/Number.pm b/lib/MooseX/AttributeHelpers/Trait/Number.pm new file mode 100644 index 0000000..85bd6fd --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Number.pm @@ -0,0 +1,170 @@ +package MooseX::AttributeHelpers::Trait::Number; +use Moose::Role; + +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; + +with 'MooseX::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 { 'MooseX::AttributeHelpers::Trait::Number' } + +1; + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Number + +=head1 SYNOPSIS + + package Real; + use Moose; + use MooseX::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 + +=item B + +=item B + +=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 + +Alternate way to set the value. + +=item I + +Adds the current value of the attribute to C<$value>. + +=item I + +Subtracts the current value of the attribute to C<$value>. + +=item I + +Multiplies the current value of the attribute to C<$value>. + +=item I
+ +Divides the current value of the attribute to C<$value>. + +=item I + +Modulus the current value of the attribute to C<$value>. + +=item I + +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-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/lib/MooseX/AttributeHelpers/Trait/String.pm b/lib/MooseX/AttributeHelpers/Trait/String.pm new file mode 100644 index 0000000..b48aec2 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/String.pm @@ -0,0 +1,187 @@ + +package MooseX::AttributeHelpers::Trait::String; +use Moose::Role; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::String; + +with 'MooseX::AttributeHelpers::Trait::Base'; + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::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 { 'MooseX::AttributeHelpers::Trait::String' } + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::String + +=head1 SYNOPSIS + + package MyHomePage; + use Moose; + use MooseX::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, I, +I or I but does use the C metaclass, +then this module applies defaults as in the L +above. This allows for a very basic counter definition: + + has 'foo' => (metaclass => 'String'); + $obj->append_foo; + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +Run before its superclass method. + +=item B + +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 + +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 is not available. + +=item I C<$string> + +Append a string, like C<.=>. + +=item I C<$string> + +Prepend a string. + +=item I C<$pattern> C<$replacement> + +Performs a regexp substitution (L). There is no way to provide the +C flag, but code references will be accepted for the replacement, causing +the regex to be modified with a single C. C can be applied using the +C operator. + +=item I C<$pattern> + +Like I but without the replacement. Provided mostly for completeness. + +=item C + +L + +=item C + +L + +=item C + +Sets the string to the empty string (not the value passed to C). + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/t/201_trait_counter.t b/t/201_trait_counter.t new file mode 100644 index 0000000..c91ae92 --- /dev/null +++ b/t/201_trait_counter.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 14; +use Test::Moose 'does_ok'; + +BEGIN { + use_ok('MooseX::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, 'MooseX::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'); + diff --git a/t/202_trait_array.t b/t/202_trait_array.t new file mode 100644 index 0000000..e7cffc6 --- /dev/null +++ b/t/202_trait_array.t @@ -0,0 +1,151 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 51; +use Test::Exception; +use Test::Moose 'does_ok'; + +BEGIN { + use_ok('MooseX::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, 'MooseX::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'); diff --git a/t/203_trait_hash.t b/t/203_trait_hash.t new file mode 100644 index 0000000..4f016e5 --- /dev/null +++ b/t/203_trait_hash.t @@ -0,0 +1,125 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 35; +use Test::Exception; +use Test::Moose 'does_ok'; + +BEGIN { + use_ok('MooseX::AttributeHelpers'); +} + +{ + package Stuff; + use Moose; + use MooseX::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, 'MooseX::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'); diff --git a/t/204_trait_number.t b/t/204_trait_number.t new file mode 100644 index 0000000..2ae6105 --- /dev/null +++ b/t/204_trait_number.t @@ -0,0 +1,93 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 20; +use Test::Moose; + +BEGIN { + use_ok('MooseX::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, 'MooseX::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'); + diff --git a/t/205_trait_list.t b/t/205_trait_list.t new file mode 100644 index 0000000..cd622d8 --- /dev/null +++ b/t/205_trait_list.t @@ -0,0 +1,88 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 21; +use Test::Exception; +use Test::Moose 'does_ok'; + +BEGIN { + use_ok('MooseX::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, 'MooseX::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'); diff --git a/t/206_trait_bag.t b/t/206_trait_bag.t new file mode 100644 index 0000000..105bb78 --- /dev/null +++ b/t/206_trait_bag.t @@ -0,0 +1,77 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 20; +use Test::Exception; +use Test::Moose 'does_ok'; + +BEGIN { + use_ok('MooseX::AttributeHelpers'); +} + +{ + package Stuff; + use Moose; + use MooseX::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, 'MooseX::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'); + diff --git a/t/207_trait_string.t b/t/207_trait_string.t new file mode 100644 index 0000000..0383870 --- /dev/null +++ b/t/207_trait_string.t @@ -0,0 +1,90 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 17; +use Test::Moose 'does_ok'; + +BEGIN { + use_ok('MooseX::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, 'MooseX::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'); +