-
package MooseX::AttributeHelpers;
our $VERSION = '0.08';
our $AUTHORITY = 'cpan:STEVAN';
+use MooseX::AttributeHelpers::Composite;
+
use MooseX::AttributeHelpers::Meta::Method::Provided;
use MooseX::AttributeHelpers::Counter;
=back
+=head1 COMPOSITE
+
+The methods provided by the above methods can be selectively composed with the
+metaclass L<Composite|MooseX::AttributeHelpers::Composite>, which is also
+available in L<Trait|MooseX::AttributeHelpers::Composite::Trait> form.
+
=head1 CAVEAT
This is an early release of this module. Right now it is in great need
-
package MooseX::AttributeHelpers::Base;
use Moose;
use Moose::Util::TypeConstraints;
+use MooseX::AttributeHelpers::MethodProvider;
use MooseX::AttributeHelpers::Meta::Method::Provided;
our $VERSION = '0.04';
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);
## Methods called prior to instantiation
-# (overridden by Sugar or plain subclasses)
-sub helper_type {()}
+# For overriding
sub default_options {}
sub auto_provide {0}
+# Do not override both of these things. You will be eaten.
+sub method_provider {}
+sub method_constructors {
+ get_provider_methods($_[0]->method_provider, ':all')
+}
+
sub process_options_for_provides {
my ($self, $options) = @_;
}
}
- if (my $type = $self->helper_type) {
- $options->{isa} = $type unless exists $options->{isa};
-
- 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";
+ return unless $self->method_provider;
+ my $type = get_provider_type($self->method_provider);
+ $options->{isa} = $type unless exists $options->{isa};
+ my $isa = $options->{isa};
+
+ unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) {
+ $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint(
+ $isa
+ );
}
+
+ confess "The type constraint for a $type ($options->{isa}) "
+ . "must be a subtype of $type"
+ unless $isa->is_a_type_of($type);
}
before '_process_options' => sub {
}
};
+sub sugar {
+ my ($class, %info) = @_;
+ my $meta = $class->meta;
+
+ $meta->add_method('default_options', sub {$info{default_options}});
+ $meta->add_method('auto_provide', sub {$info{auto_provide} || 0});
+
+ my $provider = $info{method_provider};
+ my $constructors = $info{method_constructors};
+
+ confess "Supply either method_provider or method_constructors"
+ if ($provider && $constructors) || !($provider || $constructors);
+
+ if(my $provider = $info{method_provider}) {
+ $meta->add_method('method_provider' => sub { $provider });
+ }
+ elsif (my $cons = $info{method_constructors}) {
+ $meta->add_method('method_constructors' => sub { $cons });
+ }
+
+ if (my $s = $info{shortcut}) {
+ $meta->create("Moose::Meta::Attribute::Custom::$s",
+ methods => {register_implementation => sub { $class }},
+ );
+ }
+}
+
no Moose;
no Moose::Util::TypeConstraints;
MooseX::AttributeHelpers::Base - Base class for attribute helpers
+SYNOPSIS
+
+ package MooseX::AttributeHelpers::Counter;
+ use Moose;
+ use MooseX::AttributeHelpers::MethodProvider::Counter;
+
+ extends 'MooseX::AttributeHelpers::Base';
+
+ __PACKAGE__->sugar(
+ default_options => {
+ is => 'ro',
+ default => 0,
+ },
+
+ auto_provide => 1,
+ method_provider => 'Counter',
+ shortcut => 'Counter',
+ );
+
+ no Moose;
+
+ 1;
+
=head1 DESCRIPTION
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<MooseX::AttributeHelpers::Sugar>, which has a nice, terse
-syntax and some convenience, but you should still subclass this class.
+AttributeHelper metaclass. Most of the work is done for you by the class
+method I<sugar> if you're doing something basic.
=head1 ATTRIBUTES
This is the map of metaclass methods to methods that will be installed in your
class, e.g. add => 'add_to_number'.
-=item B<method_provider>
-
-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<method_constructors>
-
-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
=over 4
-=item B<meta>
+=item B<method_provider>
+
+The name of a method provider. Usually one L<use|perlfunc/use>s a package
+that defines a method provider in the registry first, but you can just as well
+define one in your own code. See L<MooseX::AttributeHelpers::MethodProvider>
+for details.
+
+=item B<method_constructors>
+
+You can optionally supply a hashref of names to subs instead of a class to be
+used as method constructors. In that case, your methods won't be available
+for use by L<Composite|MooseX::AttributeHelpers::Composite>.
=item B<auto_provide>
not overridden by the implementing attribute. This is intended to be
overridden in subclasses.
-=item B<helper_type>
+=item B<sugar>
-This forces all attributes using this metaclass to be a subtype of
-helper_type. This is intended to be overridden in subclasses.
+A convenience method for subclassing declaratively. See L<"SYNOPSIS"> for an
+example. The shortcut option creates a package under
+Moose::Meta::Attribute::Custom to make it easier for users to find your
+metaclass, but you can do this manually if you desire.
=item B<check_provides_values>
-=item B<has_method_provider>
-
=item B<install_accessors>
=item B<remove_accessors>
=item B<process_options_for_provides>
+These are hooks you can use to change the behavior of the metaclass; read the
+source for inspiration.
+
=back
=head1 BUGS
-
package MooseX::AttributeHelpers::Collection::Array;
use Moose;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::Collection::Array;
extends 'MooseX::AttributeHelpers::Collection';
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
-define_attribute_helper (
- helper_type => 'ArrayRef',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::Array',
+__PACKAGE__->sugar(
+ method_provider => 'Collection::Array',
shortcut => 'Collection::Array',
);
no Moose;
-no MooseX::AttributeHelpers::Sugar;
1;
-
package MooseX::AttributeHelpers::Collection::Bag;
use Moose;
-use Moose::Util::TypeConstraints;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::Collection::Bag;
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
extends 'MooseX::AttributeHelpers::Collection';
-subtype 'Bag' => as 'HashRef[Int]';
-
-define_attribute_helper (
+__PACKAGE__->sugar(
default_options => { default => sub { {} } },
- helper_type => 'Bag',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::Bag',
+ method_provider => 'Collection::Bag',
shortcut => 'Collection::Bag',
);
no Moose;
-no Moose::Util::TypeConstraints;
-no MooseX::AttributeHelpers::Sugar;
1;
-
package MooseX::AttributeHelpers::Collection::Hash;
use Moose;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::Collection::Hash;
extends 'MooseX::AttributeHelpers::Collection';
our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
-define_attribute_helper (
- helper_type => 'HashRef',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::Hash',
+__PACKAGE__->sugar(
+ method_provider => 'Collection::Hash',
shortcut => 'Collection::Hash',
);
no Moose;
-no MooseX::AttributeHelpers::Sugar;
1;
-
package MooseX::AttributeHelpers::Collection::ImmutableHash;
use Moose;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::Collection::ImmutableHash;
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
extends 'MooseX::AttributeHelpers::Collection';
-define_attribute_helper (
- helper_type => 'HashRef',
- method_provider =>
- 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash',
+__PACKAGE__->sugar(
+ method_provider => 'Collection::ImmutableHash',
shortcut => 'Collection::ImmutableHash',
);
no Moose;
-no MooseX::AttributeHelpers::Sugar;
1;
-
package MooseX::AttributeHelpers::Collection::List;
use Moose;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::Collection::List;
extends 'MooseX::AttributeHelpers::Collection';
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
-define_attribute_helper (
- helper_type => 'ArrayRef',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::List',
+__PACKAGE__->sugar(
+ method_provider => 'Collection::List',
shortcut => 'Collection::List',
);
no Moose;
-no MooseX::AttributeHelpers::Sugar;
1;
-
package MooseX::AttributeHelpers::Counter;
use Moose;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::Counter;
extends 'MooseX::AttributeHelpers::Base';
our $VERSION = '0.03';
our $AUTHORITY = 'cpan:STEVAN';
-define_attribute_helper (
+__PACKAGE__->sugar(
default_options => {
is => 'ro',
default => 0,
},
- helper_type => 'Num',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::Counter',
auto_provide => 1,
+ method_provider => 'Counter',
shortcut => 'Counter',
);
no Moose;
-no MooseX::AttributeHelpers::Sugar;
1;
-
package MooseX::AttributeHelpers::MethodProvider::Counter;
-use Moose::Role;
+use MooseX::AttributeHelpers::MethodProvider;
our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
-sub reset : method {
- my ($attr, $reader, $writer) = @_;
- return sub { $writer->($_[0], $attr->default($_[0])) };
-}
-
-sub inc {
- my ($attr, $reader, $writer) = @_;
- return sub { $writer->($_[0], $reader->($_[0]) + 1) };
-}
-
-sub dec {
- my ($attr, $reader, $writer) = @_;
- return sub { $writer->($_[0], $reader->($_[0]) - 1) };
-}
+add_method_provider 'Counter' => (
+ type => 'Int',
+ provides => {
+ reset => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $attr->default($_[0])) };
+ },
+
+ inc => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) + 1) };
+ },
+
+ dec => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->($_[0], $reader->($_[0]) - 1) };
+ },
+ },
+);
1;
=head1 NAME
MooseX::AttributeHelpers::MethodProvider::Counter
-
+
=head1 DESCRIPTION
-This is a role which provides the method generators for
+This is a role which provides the method generators for
L<MooseX::AttributeHelpers::Counter>.
=head1 PROVIDED METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
-
package MooseX::AttributeHelpers::MethodProvider::Number;
-use Moose::Role;
+use MooseX::AttributeHelpers::MethodProvider;
our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
-my %ops = (
- add => '+',
- sub => '-',
- mul => '*',
- div => '/',
- mod => '%',
-);
-
-foreach my $method (keys %ops)
-{
- my $s = $ops{$method};
- __PACKAGE__->meta->alias_method($method, sub {
- my ($attr, $reader, $writer) = @_;
- return eval "sub { \$writer->(\$_[0], \$reader->(\$_[0]) $s \$_[1]) }";
- });
-}
+my %o = (add => '+', sub => '-', mul => '*', div => '/', mod => '%');
+my %methods = map {my $m = $_; $m => sub {
+ my ($attr, $reader, $writer) = @_;
+ return eval "sub { \$writer->(\$_[0], \$reader->(\$_[0]) $o{$m} \$_[1]) }";
+}} (keys %o);
-sub abs : method {
+$methods{abs} = sub {
my ($attr, $reader, $writer) = @_;
return sub { $writer->($_[0], CORE::abs($reader->($_[0]))) };
-}
+};
-sub set : method {
+$methods{set} = sub {
my ($attr, $reader, $writer) = @_;
return sub { $writer->($_[0], $_[1]) };
-}
+};
+
+add_method_provider Number => (
+ type => 'Num',
+ provides => \%methods,
+);
1;
=head1 NAME
MooseX::AttributeHelpers::MethodProvider::Number
-
+
=head1 DESCRIPTION
-This is a role which provides the method generators for
+This is a role which provides the method generators for
L<MooseX::AttributeHelpers::Number>.
=head1 PROVIDED METHODS
-All methods but 'set' are plain mathematical operators, as in
+All methods but 'set' are plain mathematical operators, as in
C<$current_value = $current_value OP $argument>
where OP is the operator listed next to the method name.
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
-
package MooseX::AttributeHelpers::MethodProvider::String;
-use Moose::Role;
+use MooseX::AttributeHelpers::MethodProvider;
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
-sub append : method {
- my ($attr, $reader, $writer) = @_;
-
- return sub { $writer->( $_[0], $reader->($_[0]) . $_[1] ) };
-}
-
-sub prepend : method {
- my ($attr, $reader, $writer) = @_;
-
- return sub { $writer->( $_[0], $_[1] . $reader->($_[0]) ) };
-}
-
-sub replace : method {
- my ($attr, $reader, $writer) = @_;
-
- return sub {
- my ( $self, $regex, $replacement ) = @_;
- my $v = $reader->($_[0]);
-
- if ( (ref($replacement)||'') eq 'CODE' ) {
- $v =~ s/$regex/$replacement->()/e;
- } else {
- $v =~ s/$regex/$replacement/;
- }
-
- $writer->( $_[0], $v);
- };
-}
-
-sub match : method {
- my ($attr, $reader, $writer) = @_;
- return sub { $reader->($_[0]) =~ $_[1] };
-}
-
-sub chop : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my $v = $reader->($_[0]);
- CORE::chop($v);
- $writer->( $_[0], $v);
- };
-}
-
-sub chomp : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my $v = $reader->($_[0]);
- chomp($v);
- $writer->( $_[0], $v);
- };
-}
-
-sub inc : method {
- my ($attr, $reader, $writer) = @_;
- return sub {
- my $v = $reader->($_[0]);
- $v++;
- $writer->( $_[0], $v);
- };
-}
-
-sub clear : method {
- my ($attr, $reader, $writer ) = @_;
- return sub { $writer->( $_[0], '' ) }
-}
+add_method_provider String => (
+ type => 'Str',
+ provides => {
+ append => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->( $_[0], $reader->($_[0]) . $_[1] ) };
+ },
+
+ prepend => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $writer->( $_[0], $_[1] . $reader->($_[0]) ) };
+ },
+
+ replace => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my ( $self, $regex, $replacement ) = @_;
+ my $v = $reader->($_[0]);
+
+ if ( (ref($replacement)||'') eq 'CODE' ) {
+ $v =~ s/$regex/$replacement->()/e;
+ } else {
+ $v =~ s/$regex/$replacement/;
+ }
+
+ $writer->( $_[0], $v);
+ };
+ },
+
+ match => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub { $reader->($_[0]) =~ $_[1] };
+ },
+
+ chop => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $v = $reader->($_[0]);
+ CORE::chop($v);
+ $writer->( $_[0], $v);
+ };
+ },
+
+ chomp => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $v = $reader->($_[0]);
+ chomp($v);
+ $writer->( $_[0], $v);
+ };
+ },
+
+ inc => sub {
+ my ($attr, $reader, $writer) = @_;
+ return sub {
+ my $v = $reader->($_[0]);
+ $v++;
+ $writer->( $_[0], $v);
+ };
+ },
+
+ clear => sub {
+ my ($attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], '' ) }
+ },
+ },
+);
1;
=head1 NAME
MooseX::AttributeHelpers::MethodProvider::String
-
+
=head1 DESCRIPTION
-This is a role which provides the method generators for
+This is a role which provides the method generators for
L<MooseX::AttributeHelpers::String>.
=head1 PROVIDED METHODS
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+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.
package MooseX::AttributeHelpers::Number;
use Moose;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::Number;
extends 'MooseX::AttributeHelpers::Base';
our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
-define_attribute_helper (
- helper_type => 'Num',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::Number',
+__PACKAGE__->sugar(
+ method_provider => 'Number',
shortcut => 'Number',
);
no Moose;
-no MooseX::AttributeHelpers::Sugar;
1;
-
package MooseX::AttributeHelpers::String;
use Moose;
-use MooseX::AttributeHelpers::Sugar;
+use MooseX::AttributeHelpers::MethodProvider::String;
extends 'MooseX::AttributeHelpers::Base';
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
-define_attribute_helper (
+__PACKAGE__->sugar(
default_options => {
is => 'rw',
default => '',
},
- helper_type => 'Str',
- method_provider => 'MooseX::AttributeHelpers::MethodProvider::String',
auto_provide => 1,
+ method_provider => 'String',
shortcut => 'String',
);
no Moose;
-no MooseX::AttributeHelpers::Sugar;
1;
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More tests => 13;
BEGIN {
use_ok('MooseX::AttributeHelpers');
my $counter = $page->meta->get_attribute('counter');
isa_ok($counter, 'MooseX::AttributeHelpers::Counter');
-is($counter->helper_type, 'Num', '... got the expected helper type');
-
is($counter->type_constraint->name, 'Int', '... got the expected type constraint');
is_deeply($counter->provides, {
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More tests => 16;
BEGIN {
use_ok('MooseX::AttributeHelpers');
my $string = $page->meta->get_attribute('string');
isa_ok($string, 'MooseX::AttributeHelpers::String');
-is($string->helper_type, 'Str', '... got the expected helper type');
-
is($string->type_constraint->name, 'Str', '... got the expected type constraint');
is_deeply($string->provides, {
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More tests => 13;
BEGIN {
use_ok('MooseX::AttributeHelpers');
my $counter = $page->meta->get_attribute('counter');
isa_ok($counter, 'MooseX::AttributeHelpers::Counter');
-is($counter->helper_type, 'Num', '... got the expected helper type');
-
-is($counter->type_constraint->name, 'Num', '... got the expected default type constraint');
+is($counter->type_constraint->name, 'Int', '... got the expected default type constraint');
is_deeply($counter->provides, {
inc => 'inc_counter',
projects / gitmo/MooseX-AttributeHelpers.git / commitdiff