From: Christian Hansen Date: Tue, 18 Apr 2006 22:53:05 +0000 (+0000) Subject: Initial work on Moose.pm exporting X-Git-Tag: 0_05~25 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3c7e2fe17f2d911218b827dd566f06477f3f109;p=gitmo%2FMoose.git Initial work on Moose.pm exporting --- diff --git a/lib/Moose.pm b/lib/Moose.pm index c100bf2..4d6f87c 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -21,95 +21,136 @@ use Moose::Meta::Attribute; use Moose::Object; use Moose::Util::TypeConstraints; - -sub import { - shift; - my $pkg = caller(); - - # we should never export to main - return if $pkg eq 'main'; - - # make a subtype for each Moose class - subtype $pkg - => as 'Object' - => where { $_->isa($pkg) } - unless find_type_constraint($pkg); - - my $meta; - if ($pkg->can('meta')) { - $meta = $pkg->meta(); - (blessed($meta) && $meta->isa('Moose::Meta::Class')) - || confess "Whoops, not møøsey enough"; - } - else { - $meta = Moose::Meta::Class->initialize($pkg => ( - ':attribute_metaclass' => 'Moose::Meta::Attribute' - )); - $meta->add_method('meta' => sub { - # re-initialize so it inherits properly - Moose::Meta::Class->initialize($pkg => ( - ':attribute_metaclass' => 'Moose::Meta::Attribute' - )); - }) - } - - # NOTE: - # &alias_method will install the method, but it - # will not name it with - - # handle superclasses - $meta->alias_method('extends' => subname 'Moose::extends' => sub { - _load_all_classes(@_); - $meta->superclasses(@_) - }); - - # handle roles - $meta->alias_method('with' => subname 'Moose::with' => sub { - my ($role) = @_; - _load_all_classes($role); - $role->meta->apply($meta); - }); - - # handle attributes - $meta->alias_method('has' => subname 'Moose::has' => sub { - my ($name, %options) = @_; - $meta->add_attribute($name, %options) - }); - - # handle method modifers - $meta->alias_method('before' => subname 'Moose::before' => sub { - my $code = pop @_; - $meta->add_before_method_modifier($_, $code) for @_; - }); - $meta->alias_method('after' => subname 'Moose::after' => sub { - my $code = pop @_; - $meta->add_after_method_modifier($_, $code) for @_; - }); - $meta->alias_method('around' => subname 'Moose::around' => sub { - my $code = pop @_; - $meta->add_around_method_modifier($_, $code) for @_; - }); - - $meta->alias_method('super' => subname 'Moose::super' => sub {}); - $meta->alias_method('override' => subname 'Moose::override' => sub { - my ($name, $method) = @_; - $meta->add_override_method_modifier($name => $method); - }); - - $meta->alias_method('inner' => subname 'Moose::inner' => sub {}); - $meta->alias_method('augment' => subname 'Moose::augment' => sub { - my ($name, $method) = @_; - $meta->add_augment_method_modifier($name => $method); - }); - - # make sure they inherit from Moose::Object - $meta->superclasses('Moose::Object') - unless $meta->superclasses(); - - # we recommend using these things - # so export them for them - $meta->alias_method('confess' => \&Carp::confess); - $meta->alias_method('blessed' => \&Scalar::Util::blessed); +use Sub::Exporter; + +{ + my ( $CALLER, %METAS ); + + sub meta() { + my $class = $CALLER; + + return $METAS{$class} if exists $METAS{$class}; + + # make a subtype for each Moose class + subtype $class + => as 'Object' + => where { $_->isa($class) } + unless find_type_constraint($class); + + my $meta; + if ($class->can('meta')) { + $meta = $class->meta(); + (blessed($meta) && $meta->isa('Moose::Meta::Class')) + || confess "Whoops, not møøsey enough"; + } + else { + $meta = Moose::Meta::Class->initialize($class => ( + ':attribute_metaclass' => 'Moose::Meta::Attribute' + )); + $meta->add_method('meta' => sub { + # re-initialize so it inherits properly + Moose::Meta::Class->initialize($class => ( + ':attribute_metaclass' => 'Moose::Meta::Attribute' + )); + }) + } + + # make sure they inherit from Moose::Object + $meta->superclasses('Moose::Object') + unless $meta->superclasses(); + + return $METAS{$class} = $meta; + } + + my %exports = ( + extends => sub { + my $meta = meta(); + return sub { + _load_all_classes(@_); + $meta->superclasses(@_) + }; + }, + with => sub { + my $meta = meta(); + return sub { + my ($role) = @_; + _load_all_classes($role); + $role->meta->apply($meta); + }; + }, + has => sub { + my $meta = meta(); + return sub { + my ($name, %options) = @_; + $meta->add_attribute($name, %options) + }; + }, + before => sub { + my $meta = meta(); + return sub { + my $code = pop @_; + $meta->add_before_method_modifier($_, $code) for @_; + }; + }, + after => sub { + my $meta = meta(); + return sub { + my $code = pop @_; + $meta->add_after_method_modifier($_, $code) for @_; + }; + }, + around => sub { + my $meta = meta(); + return sub { + my $code = pop @_; + $meta->add_around_method_modifier($_, $code) for @_; + }; + }, + super => sub { + my $meta = meta(); + return sub {}; + }, + override => sub { + my $meta = meta(); + return sub { + my ($name, $method) = @_; + $meta->add_override_method_modifier($name => $method); + }; + }, + inner => sub { + my $meta = meta(); + return sub {}; + }, + augment => sub { + my $meta = meta(); + return sub { + my ($name, $method) = @_; + $meta->add_augment_method_modifier($name => $method); + }; + }, + confess => sub { + return \&Carp::confess; + }, + blessed => sub { + return \&Scalar::Util::blessed; + } + ); + + my $exporter = Sub::Exporter::build_exporter({ + exports => \%exports, + groups => { + default => [':all'] + } + }); + + sub import { + $CALLER = caller(); + + # we should never export to main + return if $CALLER eq 'main'; + + goto $exporter; + }; } ## Utility functions diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 0d154cb..4ceab19 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -9,7 +9,7 @@ use Carp 'confess'; our $VERSION = '0.04'; -use Moose::Util::TypeConstraints '-no-export'; +use Moose::Util::TypeConstraints (); use base 'Class::MOP::Attribute'; diff --git a/lib/Moose/Meta/TypeCoercion.pm b/lib/Moose/Meta/TypeCoercion.pm index 1aaec3a..ef6d680 100644 --- a/lib/Moose/Meta/TypeCoercion.pm +++ b/lib/Moose/Meta/TypeCoercion.pm @@ -8,7 +8,7 @@ use metaclass; use Carp 'confess'; use Moose::Meta::Attribute; -use Moose::Util::TypeConstraints '-no-export'; +use Moose::Util::TypeConstraints (); our $VERSION = '0.01'; diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 75dc8a6..c1b6b9c 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -12,14 +12,19 @@ our $VERSION = '0.05'; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; -sub import { - shift; - my $pkg = shift || caller(); - return if $pkg eq '-no-export'; - no strict 'refs'; - foreach my $export (qw(type subtype as where message coerce from via find_type_constraint)) { - *{"${pkg}::${export}"} = \&{"${export}"}; - } +{ + require Sub::Exporter; + + my @exports = qw[type subtype as where message coerce from via find_type_constraint]; + + Sub::Exporter->import( + -setup => { + exports => \@exports, + groups => { + default => [':all'] + } + } + ); } { diff --git a/t/051_util_type_constraints_export.t b/t/051_util_type_constraints_export.t index 54f3357..70c4a09 100644 --- a/t/051_util_type_constraints_export.t +++ b/t/051_util_type_constraints_export.t @@ -7,7 +7,7 @@ use Test::More tests => 5; use Test::Exception; BEGIN { - use_ok('Moose::Util::TypeConstraints', ('Foo')); + use_ok('Moose::Util::TypeConstraints', { into => 'Foo' } ); } {