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;
$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;
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
$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;
$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;
$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;
$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;
$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 ...
$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;
-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' => (
# 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
## Methods called prior to instantiation
-sub helper_type { () }
-
sub process_options_for_provides {
my ($self, $options) = @_;
}
};
-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<provides>
-
-=item B<curries>
-
-=item B<method_provider>
-
-=item B<method_constructors>
-
-=back
-
-=head1 EXTENDED ATTRIBUTES
-
-=over 4
-
-=item B<default>
-
-C<default> is now required.
-
-=item B<type_constraint>
-
-C<type_constraint> is now required.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=item B<helper_type>
-
-=item B<check_provides_values>
-
-=item B<has_default>
-
-=item B<has_method_provider>
-
-=item B<has_type_constraint>
-
-=item B<install_accessors>
-
-=item B<remove_accessors>
-
-=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-2008 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
-package MooseX::AttributeHelpers::Collection;
-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;
it under the same terms as Perl itself.
=cut
+
--- /dev/null
+
+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<MooseX::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-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+
+package MooseX::AttributeHelpers::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<MooseX::AttributeHelpers::MethodProvider::Bag>
+for more details.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<method_provider>
+
+=item B<has_method_provider>
+
+=item B<helper_type>
+
+=item B<process_options_for_provides>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+
+package MooseX::AttributeHelpers::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<MooseX::AttributeHelpers::MethodProvider::Hash>
+for more details.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<method_provider>
+
+=item B<has_method_provider>
+
+=item B<helper_type>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+
+package MooseX::AttributeHelpers::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<MooseX::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-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+
+package MooseX::AttributeHelpers::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<MooseX::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-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+
+package MooseX::AttributeHelpers::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;
+
--- /dev/null
+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<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-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+
+package MooseX::AttributeHelpers::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<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-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+#!/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');
+
--- /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('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');
--- /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('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');
--- /dev/null
+#!/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');
+
--- /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('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');
--- /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('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');
+
--- /dev/null
+#!/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');
+
projects / gitmo/MooseX-AttributeHelpers.git / commitdiff