X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=35c117d1acbf2c6163acfe6ae41cd8e7433ceff9;hp=eb72c43fda3e347039196c083170da1834b37cd5;hb=ea249879d28f5ce42afb95feeb7dcb6d37fcd241;hpb=08f7a8dbc5e48fcece4396a500d37bb2c6e45b74 diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index eb72c43..35c117d 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -2,6 +2,7 @@ package Mouse::Util; use strict; use warnings; use base qw/Exporter/; + use Carp qw(confess); use B (); @@ -9,15 +10,16 @@ our @EXPORT_OK = qw( find_meta does_role resolve_metaclass_alias + apply_all_roles + english_list load_class is_class_loaded - apply_all_roles - not_supported - get_linear_isa get_code_info + + not_supported ); our %EXPORT_TAGS = ( all => \@EXPORT_OK, @@ -26,16 +28,16 @@ our %EXPORT_TAGS = ( # Moose::Util compatible utilities sub find_meta{ - return Mouse::Module::class_of( $_[0] ); + return Mouse::Meta::Module::class_of( $_[0] ); } sub does_role{ - my ($class_or_obj, $role) = @_; - - my $meta = Mouse::Module::class_of($class_or_obj); - - return 0 unless defined $meta; - return 1 if $meta->does_role($role); + my ($class_or_obj, $role) = @_; + + my $meta = Mouse::Meta::Module::class_of($class_or_obj); + + return 0 unless defined $meta; + return 1 if $meta->does_role($role); return 0; } @@ -85,44 +87,44 @@ BEGIN { } { # taken from Sub::Identify - sub get_code_info($) { - my ($coderef) = @_; - ref($coderef) or return; + sub get_code_info($) { + my ($coderef) = @_; + ref($coderef) or return; - my $cv = B::svref_2object($coderef); + my $cv = B::svref_2object($coderef); $cv->isa('B::CV') or return; - my $gv = $cv->GV; - $gv->isa('B::GV') or return; - - return ($gv->STASH->NAME, $gv->NAME); - } + my $gv = $cv->GV; + $gv->isa('B::GV') or return; + + return ($gv->STASH->NAME, $gv->NAME); + } } # taken from Mouse::Util (0.90) { my %cache; - sub resolve_metaclass_alias { - my ( $type, $metaclass_name, %options ) = @_; - - my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' ); + sub resolve_metaclass_alias { + my ( $type, $metaclass_name, %options ) = @_; + + my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' ); + + return $cache{$cache_key}{$metaclass_name} ||= do{ - return $cache{$cache_key}{$metaclass_name} ||= do{ - my $possible_full_name = join '::', 'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name ; - my $loaded_class = load_first_existing_class( - $possible_full_name, - $metaclass_name - ); - - $loaded_class->can('register_implementation') - ? $loaded_class->register_implementation + my $loaded_class = load_first_existing_class( + $possible_full_name, + $metaclass_name + ); + + $loaded_class->can('register_implementation') + ? $loaded_class->register_implementation : $loaded_class; - }; + }; } } @@ -261,13 +263,26 @@ sub apply_all_roles { return; } +# taken from Moose::Util 0.90 +sub english_list { + return $_[0] if @_ == 1; + + my @items = sort @_; + + return "$items[0] and $items[1]" if @items == 2; + + my $tail = pop @items; + + return join q{, }, @items, "and $tail"; +} + sub not_supported{ my($feature) = @_; $feature ||= ( caller(1) )[3]; # subroutine name - local $Carp::CarpLevel = $Carp::CarpLevel + 2; - Carp::croak("Mouse does not currently support $feature"); + local $Carp::CarpLevel = $Carp::CarpLevel + 1; + Carp::confess("Mouse does not currently support $feature"); } 1; @@ -280,9 +295,41 @@ Mouse::Util - features, with or without their dependencies =head1 IMPLEMENTATIONS FOR -=head2 L +=head2 Moose::Util + +=head3 C + +=head3 C + +=head3 C + +=head3 C + +=head3 C + +=head2 Class::MOP + +=head3 C + +=head3 C + +=head2 MRO::Compat + +=head3 C + +=head2 Sub::Identify + +=head3 C + +=head1 UTILITIES FOR MOUSE + +=over 4 + +=item * + +C -=head3 get_linear_isa +=back =cut