Browse files

Use Moose's meta traits more effectively so that single args may be d…

…eclared in roles.
  • Loading branch information...
1 parent 9543fc8 commit 5626557f038bd245a4b1f76b708b3eeeab93c9aa @bluefeet committed Apr 16, 2012
View
2 Changes
@@ -1,6 +1,8 @@
Revision history for Perl extension MooseX::SingleArg.
{{$NEXT}}
+ - Use Moose's meta traits more effectively so that single args may be
+ declared in roles.
0.03 2012-03-20
- Comment on MooseX::OneArgNew.
View
7 README.pod
@@ -18,10 +18,9 @@ MooseX::SingleArg - No-fuss instantiation of Moose objects using a single argume
=head1 DESCRIPTION
-This module provides a role and declarative sugar for allowing Moose instances
-to be constructed with a single argument. Your class must use this module and
-then use the single_arg method to declare which of the class's attributes will
-be assigned the single argument value.
+This module allows Moose instances to be constructed with a single argument.
+Your class or role must use this module and then use the single_arg method to
+declare which attribute will be assigned the single argument value.
If the class is constructed using the typical argument list name/value pairs,
or with a hashref, then things work as is usual. But, if the arguments are a
View
84 lib/MooseX/SingleArg.pm
@@ -22,10 +22,9 @@ MooseX::SingleArg - No-fuss instantiation of Moose objects using a single argume
=head1 DESCRIPTION
-This module provides a role and declarative sugar for allowing Moose instances
-to be constructed with a single argument. Your class must use this module and
-then use the single_arg method to declare which of the class's attributes will
-be assigned the single argument value.
+This module allows Moose instances to be constructed with a single argument.
+Your class or role must use this module and then use the single_arg method to
+declare which attribute will be assigned the single argument value.
If the class is constructed using the typical argument list name/value pairs,
or with a hashref, then things work as is usual. But, if the arguments are a
@@ -68,78 +67,35 @@ argument when force is on.
use Carp qw( croak );
Moose::Exporter->setup_import_methods(
- with_meta => [ 'single_arg' ],
+ with_meta => ['single_arg'],
+ class_metaroles => {
+ class => ['MooseX::SingleArg::Meta::Class'],
+ },
+ role_metaroles => {
+ role => ['MooseX::SingleArg::Meta::Role'],
+ application_to_class => ['MooseX::SingleArg::Meta::ToClass'],
+ application_to_role => ['MooseX::SingleArg::Meta::ToRole'],
+ },
+ base_class_roles => ['MooseX::SingleArg::Meta::Object'],
);
sub single_arg {
- my ($meta, $arg, %params) = @_;
+ my ($meta, $name, %args) = @_;
my $class = $meta->name();
- croak "A single arg has already been declared for $class" if $class->_has_single_arg();
+ croak "A single arg has already been declared for $class" if $meta->has_single_arg();
- $class->_single_arg( $arg );
+ $meta->single_arg( $name );
- foreach my $param (keys %params) {
- my $method = '_' . $param . '_single_arg';
- croak("Unknown single_arg parameter $param") if !$class->can($method);
- $class->$method( $params{$param} );
+ foreach my $arg (keys %args) {
+ my $method = $arg . '_single_arg';
+ croak("Unknown single_arg argument $arg") if !$meta->can($method);
+ $meta->$method( $args{$arg} );
}
return;
}
-sub init_meta {
- shift;
- my %args = @_;
-
- Moose->init_meta( %args );
-
- my $class = $args{for_class};
-
- Moose::Util::MetaRole::apply_base_class_roles(
- for_class => $class,
- roles => [ 'MooseX::SingleArg::Role' ],
- );
-
- return $class->meta();
-}
-
-{
- package MooseX::SingleArg::Role;
- use Moose::Role;
-
- use Carp qw( croak );
- use MooseX::ClassAttribute;
-
- class_has _single_arg => (
- is => 'rw',
- isa => 'Str',
- predicate => '_has_single_arg',
- );
-
- class_has _force_single_arg => (
- is => 'rw',
- isa => 'Bool',
- );
-
- around BUILDARGS => sub{
- my $orig = shift;
- my $class = shift;
-
- my $single_arg = $class->_single_arg();
- croak("single_arg() has not been called for $class") if !$single_arg;
-
- my $force = $class->_force_single_arg();
- croak("$class accepts only one argument for $single_arg") if $force and @_>1;
-
- if (@_==1 and ($force or ref($_[0]) ne 'HASH')) {
- return $class->$orig( $single_arg => $_[0] );
- }
-
- return $class->$orig( @_ );
- };
-}
-
1;
__END__
View
17 lib/MooseX/SingleArg/Meta/Class.pm
@@ -0,0 +1,17 @@
+package # Hide from the indexer for now until docs are added later.
+ MooseX::SingleArg::Meta::Class;
+use Moose::Role;
+
+has single_arg => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_single_arg',
+);
+
+has force_single_arg => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 0,
+);
+
+1;
View
24 lib/MooseX/SingleArg/Meta/Object.pm
@@ -0,0 +1,24 @@
+package # Hide from the indexer for now until docs are added later.
+ MooseX::SingleArg::Meta::Object;
+use Moose::Role;
+
+use Carp qw( croak );
+
+around BUILDARGS => sub{
+ my $orig = shift;
+ my $class = shift;
+
+ my $meta = $class->meta();
+ croak("single_arg() has not been called for $class") if !$meta->has_single_arg();
+
+ my $force = $meta->force_single_arg();
+ croak("$class accepts only one argument") if $force and @_>1;
+
+ if (@_==1 and ($force or ref($_[0]) ne 'HASH')) {
+ return $class->$orig( $meta->single_arg() => $_[0] );
+ }
+
+ return $class->$orig( @_ );
+};
+
+1;
View
17 lib/MooseX/SingleArg/Meta/Role.pm
@@ -0,0 +1,17 @@
+package # Hide from the indexer for now until docs are added later.
+ MooseX::SingleArg::Meta::Role;
+use Moose::Role;
+
+has single_arg => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_single_arg',
+);
+
+has force_single_arg => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 0,
+);
+
+1;
View
29 lib/MooseX/SingleArg/Meta/ToClass.pm
@@ -0,0 +1,29 @@
+package # Hide from the indexer for now until docs are added later.
+ MooseX::SingleArg::Meta::ToClass;
+use Moose::Role;
+
+around apply => sub {
+ my $orig = shift;
+ my $self = shift;
+ my $from_role = shift;
+ my $to_class = shift;
+
+ $to_class = Moose::Util::MetaRole::apply_metaroles(
+ for => $to_class,
+ class_metaroles => {
+ class => ['MooseX::SingleArg::Meta::Class'],
+ },
+ );
+
+ Moose::Util::MetaRole::apply_base_class_roles(
+ for => $to_class,
+ roles => ['MooseX::SingleArg::Meta::Object'],
+ );
+
+ $to_class->single_arg( $from_role->single_arg() ) if $from_role->has_single_arg();
+ $to_class->force_single_arg( $from_role->force_single_arg() );
+
+ return $self->$orig( $from_role, $to_class );
+};
+
+1;
View
26 lib/MooseX/SingleArg/Meta/ToRole.pm
@@ -0,0 +1,26 @@
+package # Hide from the indexer for now until docs are added later.
+ MooseX::SingleArg::Meta::ToRole;
+use Moose::Role;
+
+around apply => sub{
+ my $orig = shift;
+ my $self = shift;
+ my $from_role = shift;
+ my $to_role = shift;
+
+ $to_role = Moose::Util::MetaRole::apply_metaroles(
+ for => $to_role,
+ role_metaroles => {
+ role => ['MooseX::SingleArg::Meta::Role'],
+ application_to_class => ['MooseX::SingleArg::Meta::ToClass'],
+ application_to_role => ['MooseX::SingleArg::Meta::ToRole'],
+ },
+ );
+
+ $to_role->single_arg( $from_role->single_arg() ) if $from_role->has_single_arg();
+ $to_role->force_single_arg( $from_role->force_single_arg() );
+
+ return $self->$orig( $from_role, $to_role );
+};
+
+1;
View
22 t/basic.t
@@ -55,6 +55,28 @@ require_ok('MooseX::SingleArg');
is( $obj->arg2(), 789, '( 789 ) sets arg2 to 789' );
}
+{
+ package MyRole;
+ use Moose::Role;
+ use MooseX::SingleArg;
+ single_arg 'blah';
+ has blah => (
+ is => 'ro',
+ isa => 'Str',
+ );
+}
+
+{
+ package MyClass2;
+ use Moose;
+ with 'MyRole';
+}
+
+{
+ my $obj = MyClass2->new( 55 );
+ is( $obj->blah(), 55, 'works with roles too' );
+}
+
like(
exception {
package Broken;

0 comments on commit 5626557

Please sign in to comment.