use strict;
use warnings;
use base qw/Exporter/;
-use Carp;
+use Carp qw(confess);
+use B ();
our @EXPORT_OK = qw(
get_linear_isa
apply_all_roles
- version
- authority
- identifier
+ get_code_info
);
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
require mro;
$impl = \&mro::get_linear_isa;
} else {
- my $loaded = do {
- local $SIG{__DIE__} = 'DEFAULT';
- eval { require MRO::Compat; 1 };
+ my $e = do {
+ local $@;
+ eval { require MRO::Compat };
+ $@;
};
- if ($loaded) {
+ if (!$e) {
$impl = \&mro::get_linear_isa;
} else {
# VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV
- my $code; # this recurses so it isn't pretty
- $code = sub {
+ my $_get_linear_isa_dfs; # this recurses so it isn't pretty
+ $_get_linear_isa_dfs = 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;
+ my $plin = $_get_linear_isa_dfs->($parent);
+ foreach my $p(@$plin) {
+ next if exists $stored{$p};
+ push(@lin, $p);
+ $stored{$p} = 1;
}
}
return \@lin;
};
# ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
- $impl = $code;
+ $impl = $_get_linear_isa_dfs;
}
}
- no strict 'refs';
- *{ __PACKAGE__ . '::get_linear_isa'} = $impl;
+
+ no warnings 'once';
+ *get_linear_isa = $impl;
}
-{ # adapted from Class::MOP::Module
-
- sub version { no strict 'refs'; ${shift->name.'::VERSION'} }
- sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} }
- sub identifier {
- my $self = shift;
- join '-' => (
- $self->name,
- ($self->version || ()),
- ($self->authority || ()),
- );
- }
+{ # taken from Sub::Identify
+ sub get_code_info($) {\r
+ my ($coderef) = @_;\r
+ ref($coderef) or return;\r
+
+ my $cv = B::svref_2object($coderef);\r
+ $cv->isa('B::CV') or return;
+
+ my $gv = $cv->GV;\r
+ $gv->isa('B::GV') or return;\r
+\r
+ return ($gv->STASH->NAME, $gv->NAME);\r
+ }\r
}
# taken from Class/MOP.pm
}
# taken from Class/MOP.pm
-sub _is_valid_class_name {
+sub is_valid_class_name {
my $class = shift;
return 0 if ref($class);
my @classes = @_
or return;
- foreach my $class (@classes) {
- unless ( _is_valid_class_name($class) ) {
+ my $found;
+ my %exceptions;
+ for my $class (@classes) {
+ unless ( is_valid_class_name($class) ) {
my $display = defined($class) ? $class : 'undef';
confess "Invalid class name ($display)";
}
- }
- my $found;
- my %exceptions;
- for my $class (@classes) {
my $e = _try_load_one_class($class);
if ($e) {
}
( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
- || croak("You can only consume roles, "
+ || confess("You can only consume roles, "
. $_->[0]
. " is not a Moose role")
foreach @roles;
else {
Mouse::Meta::Role->combine_apply($meta, @roles);
}
-
+ return;
}
1;