Initial work on Moose.pm exporting
Christian Hansen [Tue, 18 Apr 2006 22:53:05 +0000 (22:53 +0000)]
lib/Moose.pm
lib/Moose/Meta/Attribute.pm
lib/Moose/Meta/TypeCoercion.pm
lib/Moose/Util/TypeConstraints.pm
t/051_util_type_constraints_export.t

index c100bf2..4d6f87c 100644 (file)
@@ -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
index 0d154cb..4ceab19 100644 (file)
@@ -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';
 
index 1aaec3a..ef6d680 100644 (file)
@@ -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';
 
index 75dc8a6..c1b6b9c 100644 (file)
@@ -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']
+            }
+        }
+    );
 }
 
 {
index 54f3357..70c4a09 100644 (file)
@@ -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' } );
 }
 
 {