Switch to unshifting message if needed, like most of Moose

[gitmo/Moose.git] / lib / Moose / Util.pm

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 469e281..2658ec8 100644 (file)
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -3,6 +3,7 @@ package Moose::Util;
 use strict;
 use warnings;
 
+use Class::Load 0.07 qw(load_class load_first_existing_class);
 use Data::OptList;
 use Params::Util qw( _STRING );
 use Sub::Exporter;
@@ -10,6 +11,7 @@ use Scalar::Util 'blessed';
 use List::Util qw(first);
 use List::MoreUtils qw(any all);
 use overload ();
+use Try::Tiny;
 use Class::MOP;
 
 my @exports = qw[
@@ -27,6 +29,7 @@ my @exports = qw[
     english_list
     meta_attribute_alias
     meta_class_alias
+    throw
 ];
 
 Sub::Exporter::setup_exporter({
@@ -43,6 +46,10 @@ sub find_meta { Class::MOP::class_of(@_) }
 sub does_role {
     my ($class_or_obj, $role) = @_;
 
+    if (try { $class_or_obj->isa('Moose::Object') }) {
+        return $class_or_obj->does($role);
+    }
+
     my $meta = find_meta($class_or_obj);
 
     return unless defined $meta;
@@ -117,8 +124,8 @@ sub _apply_all_roles {
             $meta = $role->[0];
         }
         else {
-            Class::MOP::load_class( $role->[0] , $role->[1] );
-            $meta = Class::MOP::class_of( $role->[0] );
+            load_class( $role->[0] , $role->[1] );
+            $meta = find_meta( $role->[0] );
         }
 
         unless ($meta && $meta->isa('Moose::Meta::Role') ) {
@@ -137,7 +144,11 @@ sub _apply_all_roles {
 
     return unless @role_metas;
 
-    my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
+    load_class($applicant)
+        unless blessed($applicant)
+            || Class::MOP::class_of($applicant);
+
+    my $meta = ( blessed $applicant ? $applicant : Moose::Meta::Class->initialize($applicant) );
 
     if ( scalar @role_metas == 1 ) {
         my ( $role, $params ) = @{ $role_metas[0] };
@@ -206,7 +217,7 @@ sub _build_alias_package_name {
             $type, $metaclass_name, $options{trait}
         );
 
-        my $loaded_class = Class::MOP::load_first_existing_class(
+        my $loaded_class = load_first_existing_class(
             $possible_full_name,
             $metaclass_name
         );
@@ -298,12 +309,14 @@ sub meta_class_alias {
 
 # XXX - this should be added to Params::Util
 sub _STRINGLIKE0 ($) {
-    return _STRING( $_[0] )
-        || ( defined $_[0]
-        && $_[0] eq q{} )
-        || ( blessed $_[0]
-        && overload::Method( $_[0], q{""} )
-        && length "$_[0]" );
+    return 1 if _STRING( $_[0] );
+    if ( blessed $_[0] ) {
+        return overload::Method( $_[0], q{""} );
+    }
+
+    return 1 if defined $_[0] && $_[0] eq q{};
+
+    return 0;
 }
 
 sub _reconcile_roles_for_metaclass {
@@ -458,6 +471,34 @@ sub _is_role_only_subclass {
     return 1;
 }
 
+sub throw {
+    if (@_ % 2) {
+        unshift @_, 'message';
+    }
+
+    my %args = @_;
+
+    my $superclass = delete($args{superclass}) || 'Throwable::Error';
+    my $roles = delete($args{roles});
+
+    my $metaclass;
+
+    load_class($superclass);
+
+    if ($roles) {
+        $metaclass = Moose::Meta::Class->create_anon_class(
+            superclasses => [$superclass],
+            roles        => $roles,
+        );
+    }
+    else {
+        $metaclass = Moose::Meta::Class->initialize($superclass);
+    }
+
+    $metaclass->name->throw(\%args);
+}
+
+
 1;
 
 # ABSTRACT: Utilities for working with Moose classes
@@ -524,7 +565,7 @@ each of which can be followed by an optional hash reference of options
 
 =item B<ensure_all_roles($applicant, @roles)>
 
-This function is similar to L</apply_all_roles>, but only applies roles that
+This function is similar to C<apply_all_roles>, but only applies roles that
 C<$applicant> does not already consume.
 
 =item B<with_traits($class_name, @role_names)>