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=ad10a598ec10bba48dbce470bcd3bf5327fd22f1;hb=74f2f839994288ca48292d561c9dc2d822deae39;hpb=fb0394a27249134114e98ed491f5306c15d049e0

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index ad10a59..e24db21 100644
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -2,8 +2,23 @@
 package Mouse::Util;
 use strict;
 use warnings;
-use base 'Exporter';
-
+use base qw/Exporter/;
+use Carp;
+
+our @EXPORT_OK = qw(
+    blessed
+    get_linear_isa
+    looks_like_number
+    openhandle
+    reftype
+    weaken
+);
+our %EXPORT_TAGS = (
+    all  => \@EXPORT_OK,
+);
+
+# 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 {
     our %dependencies = (
         'Scalar::Util' => {
@@ -120,69 +135,6 @@ BEGIN {
             },
 #       ^^^^^   CODE TAKEN FROM MRO::COMPAT   ^^^^^
         },
-#       VVVVV   CODE TAKEN FROM TEST::EXCEPTION   VVVVV
-        'Test::Exception' => do {
-
-            my $Tester;
-
-            my $is_exception = sub {
-                my $exception = shift;
-                return ref $exception || $exception ne '';
-            };
-
-            my $exception_as_string = sub {
-                my ( $prefix, $exception ) = @_;
-                return "$prefix normal exit" unless $is_exception->( $exception );
-                my $class = ref $exception;
-                $exception = "$class ($exception)"
-                        if $class && "$exception" !~ m/^\Q$class/;
-                chomp $exception;
-                return "$prefix $exception";
-            };
-            my $try_as_caller = sub {
-                my $coderef = shift;
-                eval { $coderef->() };
-                $@;
-            };
-
-            {
-                'throws_ok' => sub (&$;$) {
-                    my ( $coderef, $expecting, $description ) = @_;
-                    Carp::croak "throws_ok: must pass exception class/object or regex"
-                        unless defined $expecting;
-                    $description = $exception_as_string->( "threw", $expecting )
-                        unless defined $description;
-                    my $exception = $try_as_caller->($coderef);
-
-                    $Tester ||= Test::Builder->new;
-
-                    my $regex = $Tester->maybe_regex( $expecting );
-                    my $ok = $regex
-                        ? ( $exception =~ m/$regex/ )
-                        : eval {
-                            $exception->isa( ref $expecting ? ref $expecting : $expecting )
-                        };
-                    $Tester->ok( $ok, $description );
-                    unless ( $ok ) {
-                        $Tester->diag( $exception_as_string->( "expecting:", $expecting ) );
-                        $Tester->diag( $exception_as_string->( "found:", $exception ) );
-                    };
-                    $@ = $exception;
-                    return $ok;
-                },
-                'lives_ok' => sub (&;$) {
-                    my ( $coderef, $description ) = @_;
-                    my $exception = $try_as_caller->( $coderef );
-
-                    $Tester ||= Test::Builder->new;
-
-                    my $ok = $Tester->ok( ! $is_exception->( $exception ), $description );
-                    $Tester->diag( $exception_as_string->( "died:", $exception ) ) unless $ok;
-                    $@ = $exception;
-                    return $ok;
-                },
-            },
-        },
     );
 
     our %loaded;
@@ -190,19 +142,21 @@ BEGIN {
     our @EXPORT_OK = map { keys %$_ } values %dependencies;
     our %EXPORT_TAGS = (
         all  => \@EXPORT_OK,
-        test => [qw/throws_ok lives_ok/],
+        test => [qw/throws_ok lives_ok dies_ok/],
     );
 
-    for my $module_name (keys %dependencies) {
+    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') {
@@ -222,6 +176,39 @@ BEGIN {
     }
 }
 
+sub apply_all_roles {
+    my $meta = Mouse::Meta::Class->initialize(shift);
+
+    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;
 
 __END__