From: Paul Driver Date: Mon, 7 Apr 2008 14:34:17 +0000 (+0000) Subject: Just haven't commited this yet, and it has a lot of work in it. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8683383a5764f3417a6c5282e4303315f1171c4e;p=gitmo%2FMooseX-AttributeHelpers.git Just haven't commited this yet, and it has a lot of work in it. --- diff --git a/lib/MooseX/AttributeHelpers/Base.pm b/lib/MooseX/AttributeHelpers/Base.pm index 4a87a8c..9938528 100644 --- a/lib/MooseX/AttributeHelpers/Base.pm +++ b/lib/MooseX/AttributeHelpers/Base.pm @@ -2,6 +2,7 @@ package MooseX::AttributeHelpers::Base; use Moose; use Moose::Util::TypeConstraints; +use MooseX::AttributeHelpers::Meta::Method::Provided; our $VERSION = '0.04'; our $AUTHORITY = 'cpan:STEVAN'; @@ -15,7 +16,6 @@ has 'provides' => ( default => sub {{}} ); - # these next two are the possible methods # you can use in the 'provides' map. @@ -54,14 +54,23 @@ has '+type_constraint' => (required => 1); ## Methods called prior to instantiation -sub helper_type { () } +# (overridden by Sugar or plain subclasses) +sub helper_type {()} +sub default_options {} +sub auto_provide {0} sub process_options_for_provides { my ($self, $options) = @_; + if (my $defaults = $self->default_options) { + foreach my $key (keys %$defaults) { + $options->{$key} = $defaults->{$key} + unless exists $options->{$key}; + } + } + if (my $type = $self->helper_type) { - (exists $options->{isa}) - || confess "You must define a type with the $type metaclass"; + $options->{isa} = $type unless exists $options->{isa}; my $isa = $options->{isa}; @@ -92,6 +101,15 @@ sub check_provides_values { (exists $method_constructors->{$key}) || confess "$key is an unsupported method type"; } + + my $provides = $self->provides; + if (keys %$provides == 0 and $self->auto_provide) { + my $attr_name = $self->name; + + foreach my $method (keys %$method_constructors) { + $provides->{$method} = "${method}_${attr_name}"; + } + } } after 'install_accessors' => sub { @@ -159,7 +177,10 @@ MooseX::AttributeHelpers::Base - Base class for attribute helpers =head1 DESCRIPTION -Documentation to come. +This class is what you inherit from when you want to make a new +AttributeHelper. Unless you are doing something quite fancy, your needs +should be met by L, which has a nice, terse +syntax and some convenience, but you should still subclass this class. =head1 ATTRIBUTES @@ -167,10 +188,21 @@ Documentation to come. =item B +This is the map of metaclass methods to methods that will be installed in your +class, e.g. add => 'add_to_number'. + =item B +The name of a class or role to be used as source material for the above map. +In the above example, the method provider's "add" method would be used to +construct a method to install into the attribute holder's class. + =item B +You can optionally supply a hashref of names to subs instead of a class to be +used as method constructors, but by default this is pulled from +method_provider. + =back =head1 EXTENDED ATTRIBUTES @@ -193,16 +225,27 @@ C is now required. =item B +=item B + +If this method returns a true value, all available method constructors will be +provided in the format $method_$attribute_name e.g. inc_counter. This is +intended to be overridden in subclasses. + +=item B + +Returns a Maybe[Hashref] of attribution specifications to fill in if they are +not overridden by the implementing attribute. This is intended to be +overridden in subclasses. + =item B -=item B +This forces all attributes using this metaclass to be a subtype of +helper_type. This is intended to be overridden in subclasses. -=item B +=item B =item B -=item B - =item B =item B diff --git a/lib/MooseX/AttributeHelpers/Counter.pm b/lib/MooseX/AttributeHelpers/Counter.pm index 2da3971..d1d42f1 100644 --- a/lib/MooseX/AttributeHelpers/Counter.pm +++ b/lib/MooseX/AttributeHelpers/Counter.pm @@ -1,52 +1,27 @@ package MooseX::AttributeHelpers::Counter; use Moose; +use MooseX::AttributeHelpers::Sugar; + +extends 'MooseX::AttributeHelpers::Base'; our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::Counter; - -extends 'MooseX::AttributeHelpers::Base'; +define_attribute_helper ( + default_options => { + is => 'ro', + default => 0, + }, -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Counter' + helper_type => 'Num', + method_provider => 'MooseX::AttributeHelpers::MethodProvider::Counter', + auto_provide => 1, + shortcut => '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; - -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::Counter; -sub register_implementation { 'MooseX::AttributeHelpers::Counter' } +no MooseX::AttributeHelpers::Sugar; 1; @@ -99,22 +74,6 @@ above. This allows for a very basic counter definition: =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 diff --git a/lib/MooseX/AttributeHelpers/Number.pm b/lib/MooseX/AttributeHelpers/Number.pm index 33bc393..cc90c41 100644 --- a/lib/MooseX/AttributeHelpers/Number.pm +++ b/lib/MooseX/AttributeHelpers/Number.pm @@ -1,63 +1,25 @@ package MooseX::AttributeHelpers::Number; use Moose; +use MooseX::AttributeHelpers::Sugar; + +extends 'MooseX::AttributeHelpers::Base'; our $VERSION = '0.02'; 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])) ) }; - }, - } - } +define_attribute_helper ( + helper_type => 'Num', + method_provider => 'MooseX::AttributeHelpers::MethodProvider::Number', + shortcut => 'Number', ); - -no Moose; -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::Number; -sub register_implementation { 'MooseX::AttributeHelpers::Number' } +no Moose; +no MooseX::AttributeHelpers::Sugar; 1; +__END__ + =pod =head1 NAME @@ -95,54 +57,10 @@ MooseX::AttributeHelpers::Number 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. +=head1 METHOD PROVIDER -=back +The methods for this metaclass are provided by +L. =head1 BUGS diff --git a/lib/MooseX/AttributeHelpers/String.pm b/lib/MooseX/AttributeHelpers/String.pm index 3290e2d..b966697 100644 --- a/lib/MooseX/AttributeHelpers/String.pm +++ b/lib/MooseX/AttributeHelpers/String.pm @@ -1,52 +1,27 @@ package MooseX::AttributeHelpers::String; use Moose; +use MooseX::AttributeHelpers::Sugar; + +extends 'MooseX::AttributeHelpers::Base'; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; -use MooseX::AttributeHelpers::MethodProvider::String; - -extends 'MooseX::AttributeHelpers::Base'; +define_attribute_helper ( + default_options => { + is => 'rw', + default => '', + }, -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::String' + helper_type => 'Str', + method_provider => 'MooseX::AttributeHelpers::MethodProvider::String', + auto_provide => 1, + shortcut => '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; - -# register the alias ... -package # hide me from search.cpan.org - Moose::Meta::Attribute::Custom::String; -sub register_implementation { 'MooseX::AttributeHelpers::String' } +no MooseX::AttributeHelpers::Sugar; 1; @@ -88,7 +63,7 @@ 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: +above. This allows for a very basic attribute definition: has 'foo' => (metaclass => 'String'); $obj->append_foo; @@ -99,20 +74,6 @@ above. This allows for a very basic counter definition: =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