From: Shawn M Moore Date: Sun, 25 May 2008 01:04:17 +0000 (+0000) Subject: Grab that adjusted test script X-Git-Tag: 0.18_01~26 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ac6e31fefbf38e125f3c29251eb3c6115e1115a;hp=321ab9fe187960ca974c3a76f87b7b08270c032b;p=gitmo%2FMooseX-AttributeHelpers.git Grab that adjusted test script --- diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm index 094248f..2ebc28c 100644 --- a/lib/MooseX/AttributeHelpers.pm +++ b/lib/MooseX/AttributeHelpers.pm @@ -6,6 +6,8 @@ our $AUTHORITY = 'cpan:STEVAN'; use MooseX::AttributeHelpers::Meta::Method::Provided; +use MooseX::AttributeHelpers::Trait::Counter; + use MooseX::AttributeHelpers::Counter; use MooseX::AttributeHelpers::Number; use MooseX::AttributeHelpers::String; diff --git a/lib/MooseX/AttributeHelpers/Trait/Base.pm b/lib/MooseX/AttributeHelpers/Trait/Base.pm new file mode 100644 index 0000000..9ab3f6e --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Base.pm @@ -0,0 +1,153 @@ + +package MooseX::AttributeHelpers::Trait::Base; +use Moose::Role; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.04'; +our $AUTHORITY = 'cpan:STEVAN'; + +requires 'helper_type'; + +# this is the method map you define ... +has 'provides' => ( + is => 'ro', + isa => 'HashRef', + default => sub {{}} +); + + +# these next two are the possible methods +# you can use in the 'provides' map. + +# provide a Class or Role which we can +# collect the method providers from +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', +); + +# or you can provide a HASH ref of anon subs +# yourself. This will also collect and store +# the methods from a method_provider as well +has 'method_constructors' => ( + is => 'ro', + isa => 'HashRef', + lazy => 1, + default => sub { + my $self = shift; + return +{} unless $self->has_method_provider; + # or grab them from the role/class + my $method_provider = $self->method_provider->meta; + return +{ + map { + $_ => $method_provider->get_method($_) + } $method_provider->get_method_list + }; + }, +); + +# extend the parents stuff to make sure +# certain bits are now required ... +has '+$!default' => (required => 1); +has '+type_constraint' => (required => 1); + +## Methods called prior to instantiation + +sub process_options_for_provides { + my ($self, $options) = @_; + + if (my $type = $self->helper_type) { + (exists $options->{isa}) + || confess "You must define a type with the $type metaclass"; + + my $isa = $options->{isa}; + + unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) { + $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint($isa); + } + + ($isa->is_a_type_of($type)) + || confess "The type constraint for a $type ($options->{isa}) must be a subtype of $type"; + } +} + +before '_process_options' => sub { + my ($self, $name, $options) = @_; + $self->process_options_for_provides($options, $name); +}; + +## methods called after instantiation + +# this confirms that provides has +# all valid possibilities in it +sub check_provides_values { + my $self = shift; + + my $method_constructors = $self->method_constructors; + + foreach my $key (keys %{$self->provides}) { + (exists $method_constructors->{$key}) + || confess "$key is an unsupported method type"; + } +} + +after 'install_accessors' => sub { + my $attr = shift; + my $class = $attr->associated_class; + + # grab the reader and writer methods + # as well, this will be useful for + # our method provider constructors + my $attr_reader = $attr->get_read_method_ref; + my $attr_writer = $attr->get_write_method_ref; + + + # before we install them, lets + # make sure they are valid + $attr->check_provides_values; + + my $method_constructors = $attr->method_constructors; + + my $class_name = $class->name; + + foreach my $key (keys %{$attr->provides}) { + + my $method_name = $attr->provides->{$key}; + + if ($class->has_method($method_name)) { + confess "The method ($method_name) already exists in class (" . $class->name . ")"; + } + + my $method = MooseX::AttributeHelpers::Meta::Method::Provided->wrap( + $method_constructors->{$key}->( + $attr, + $attr_reader, + $attr_writer, + ), + package_name => $class_name, + name => $method_name, + ); + + $attr->associate_method($method); + $class->add_method($method_name => $method); + } +}; + +after 'remove_accessors' => sub { + my $attr = shift; + my $class = $attr->associated_class; + foreach my $key (keys %{$attr->provides}) { + my $method_name = $attr->provides->{$key}; + my $method = $class->get_method($method_name); + $class->remove_method($method_name) + if blessed($method) && + $method->isa('MooseX::AttributeHelpers::Meta::Method::Provided'); + } +}; + +no Moose::Role; +no Moose::Util::TypeConstraints; + +1; + 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/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'); +