summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-05-07 04:55:31 -0500
committerJesse Luehrs <doy@tozt.net>2010-05-07 04:55:31 -0500
commite0b21df6d7872b520dd4694c07608f99813ba9bd (patch)
tree9092a3e98e398bc54c6d67347f99060837fddb7d
parent36d59057bed9ec98b2d89cd475fefe2a4bf3f0ab (diff)
downloadmoosex-attribute-shorthand-e0b21df6d7872b520dd4694c07608f99813ba9bd.tar.gz
moosex-attribute-shorthand-e0b21df6d7872b520dd4694c07608f99813ba9bd.zip
initial implementation
-rw-r--r--lib/MooseX/Attribute/Shorthand.pm55
-rw-r--r--t/001-basic.t24
2 files changed, 76 insertions, 3 deletions
diff --git a/lib/MooseX/Attribute/Shorthand.pm b/lib/MooseX/Attribute/Shorthand.pm
index 185f581..e8a10bf 100644
--- a/lib/MooseX/Attribute/Shorthand.pm
+++ b/lib/MooseX/Attribute/Shorthand.pm
@@ -1,5 +1,8 @@
package MooseX::Attribute::Shorthand;
-use Moose;
+use strict;
+use warnings;
+
+use Scalar::Util qw(reftype);
=head1 NAME
@@ -13,8 +16,54 @@ MooseX::Attribute::Shorthand -
=cut
-__PACKAGE__->meta->make_immutable;
-no Moose;
+sub import {
+ my $package = shift;
+ my $caller = caller;
+ my %custom_options = @_;
+ my $role = Moose::Meta::Role->create_anon_role(cache => 1);
+ for my $option (keys %custom_options) {
+ my $meta_options = delete $custom_options{$option}{'-meta_attr_options'};
+ $role->add_attribute($option => (
+ is => 'ro',
+ isa => 'Bool',
+ %{ $meta_options || {} },
+ ));
+ }
+ $role->add_around_method_modifier(_process_options => sub {
+ my $orig = shift;
+ my $class = shift;
+ my ($name, $options) = @_;
+ my %new_options;
+ for my $option (keys %$options) {
+ if (exists($custom_options{$option})) {
+ for my $expanded_option (keys %{ $custom_options{$option} }) {
+ my $expanded_val = $custom_options{$option}->{$expanded_option};
+ if (reftype($expanded_val)
+ && reftype($expanded_val) eq 'CODE') {
+ $new_options{$expanded_option} = $expanded_val->(
+ $name, $options->{$option},
+ );
+ }
+ else {
+ $new_options{$expanded_option} = $expanded_val;
+ }
+ }
+ }
+ else {
+ $new_options{$option} = $options->{$option};
+ }
+ }
+ # relies on being modified in-place
+ %$options = %new_options;
+ $class->$orig($name, $options);
+ });
+ Moose::Util::MetaRole::apply_metaroles(
+ for => $caller,
+ class_metaroles => {
+ attribute => [$role->name],
+ },
+ );
+}
=head1 BUGS
diff --git a/t/001-basic.t b/t/001-basic.t
new file mode 100644
index 0000000..f3445a4
--- /dev/null
+++ b/t/001-basic.t
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Attribute::Shorthand string => {
+ is => 'ro',
+ isa => 'Str',
+ default => sub { $_[1] },
+ -meta_attr_options => { isa => 'Str' },
+ };
+
+ has foo => (string => 'FOO');
+}
+
+my $foo = Foo->new;
+is($foo->foo, 'FOO', "expanded properly");
+dies_ok { $foo->foo('sldkfj') } "expanded properly";
+
+done_testing;