X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=e24db21de3e117c571322198ca3bade935c905c6;hp=4c194fda6bece9516da73b413fe449173c24ab28;hb=74f2f839994288ca48292d561c9dc2d822deae39;hpb=eae8075956ba01581ea7488b4ddb2506db1111da

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index 4c194fd..e24db21 100644
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -2,7 +2,7 @@
 package Mouse::Util;
 use strict;
 use warnings;
-use Exporter 'import';
+use base qw/Exporter/;
 use Carp;
 
 our @EXPORT_OK = qw(
@@ -20,79 +20,9 @@ our %EXPORT_TAGS = (
 # We only have to do this nastiness if we haven't loaded XS version of
 # Mouse.pm, so check if we're running under PurePerl or not
 BEGIN {
-    if ($Mouse::PurePerl) {
-        _install_pp_func();
-    } else {
-        # If we're running under XS, we can provide
-        #   blessed
-        #   looks_like_number
-        #   reftype
-        #   weaken
-        # other functions need to be loaded from our respective sources
-
-        if (defined &Scalar::Util::openhandle) {
-            *openhandle = \&Scalar::Util::openhandle;
-        } else {
-            # XXX - room for improvement
-            *openhandle = sub {
-                local($@, $SIG{__DIE__}, $SIG{__WARN__});
-                my $r = shift;
-                my $t;
-
-                length($t = ref($r)) or return undef;
-
-                # This eval will fail if the reference is not blessed
-                eval { $r->a_sub_not_likely_to_be_here; 1 }
-                ? do {
-                    $t = eval {
-                        # we have a GLOB or an IO. Stringify a GLOB gives it's name
-                        my $q = *$r;
-                        $q =~ /^\*/ ? "GLOB" : "IO";
-                    }
-                    or do {
-                        # OK, if we don't have a GLOB what parts of
-                        # a glob will it populate.
-                        # NOTE: A glob always has a SCALAR
-                        local *glob = $r;
-                        defined *glob{ARRAY} && "ARRAY"
-                            or defined *glob{HASH} && "HASH"
-                            or defined *glob{CODE} && "CODE"
-                            or length(ref(${$r})) ? "REF" : "SCALAR";
-                    }
-                }
-                : $t
-            };
-        }
-
-        if (defined &mro::get_linear_isa) {
-            *get_linear_isa = \&mro::get_linear_isa;
-        } else {
-            # this recurses so it isn't pretty
-            my $code;
-            *get_linear_isa = $code = sub {
-                no strict 'refs';
-
-                my $classname = shift;
-
-                my @lin = ($classname);
-                my %stored;
-                foreach my $parent (@{"$classname\::ISA"}) {
-                    my $plin = $code->($parent);
-                    foreach (@$plin) {
-                        next if exists $stored{$_};
-                        push(@lin, $_);
-                        $stored{$_} = 1;
-                    }
-                }
-                return \@lin;
-            };
-        }
-    }
-}
-
-sub _install_pp_func {
-    my %dependencies = (
+    our %dependencies = (
         'Scalar::Util' => {
+
 #       VVVVV   CODE TAKEN FROM SCALAR::UTIL   VVVVV
             'blessed' => do {
                 *UNIVERSAL::a_sub_not_likely_to_be_here = sub {
@@ -207,17 +137,26 @@ sub _install_pp_func {
         },
     );
 
-    my %loaded;
-    for my $module_name (keys %dependencies) {
+    our %loaded;
+
+    our @EXPORT_OK = map { keys %$_ } values %dependencies;
+    our %EXPORT_TAGS = (
+        all  => \@EXPORT_OK,
+        test => [qw/throws_ok lives_ok dies_ok/],
+    );
+
+    for my $module (keys %dependencies) {
+        my ($module_name, $version) = split ' ', $module;
+
         my $loaded = do {
             local $SIG{__DIE__} = 'DEFAULT';
-            eval "require $module_name; 1";
+            eval "use $module (); 1";
         };
 
         $loaded{$module_name} = $loaded;
 
-        for my $method_name (keys %{ $dependencies{ $module_name } }) {
-            my $producer = $dependencies{$module_name}{$method_name};
+        for my $method_name (keys %{ $dependencies{ $module } }) {
+            my $producer = $dependencies{$module}{$method_name};
             my $implementation;
 
             if (ref($producer) eq 'HASH') {
@@ -239,11 +178,35 @@ sub _install_pp_func {
 
 sub apply_all_roles {
     my $meta = Mouse::Meta::Class->initialize(shift);
-    my $role  = shift;
-    confess "Mouse::Util only supports 'apply_all_roles' on individual roles at a time" if @_;
 
-    Mouse::load_class($role);
-    $role->meta->apply($meta);
+    my @roles;
+    my $max = scalar(@_);
+    for (my $i = 0; $i < $max ; $i++) {
+        if ($i + 1 < $max && ref($_[$i + 1])) {
+            push @roles, [ $_[$i++] => $_[$i] ];
+        } else {
+            push @roles, [ $_[$i] => {} ];
+        }
+    }
+
+    foreach my $role_spec (@roles) {
+        Mouse::load_class( $role_spec->[0] );
+    }
+
+    ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
+        || croak("You can only consume roles, "
+        . $_->[0]
+        . " is not a Moose role")
+        foreach @roles;
+
+    if ( scalar @roles == 1 ) {
+        my ( $role, $params ) = @{ $roles[0] };
+        $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
+    }
+    else {
+        Mouse::Meta::Role->combine_apply($meta, @roles);
+    }
+
 }
 
 1;