package Mouse::Util;
use strict;
use warnings;
-use base 'Exporter';
+use Exporter 'import';
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' => {
+ 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 || eval { require Scalar::Util; 1 }) {
+ *openhandle = \&Scalar::Util::openhandle;
+ } else {
+ # XXX - room for improvement
+ *openhandle = sub {
+ my $fh = shift;
+ my $rt = reftype($fh) || '';
+
+ return defined(fileno($fh)) ? $fh : undef
+ if $rt eq 'IO';
+
+ if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
+ $fh = \(my $tmp=$fh);
+ }
+ elsif ($rt ne 'GLOB') {
+ return undef;
+ }
+ (tied(*$fh) or defined(fileno($fh)))
+ ? $fh : undef;
+ };
+ }
+
+ if (defined &mro::get_linear_isa || eval { require MRO::Compat; 1; }) {
+ *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 = (
+ 'Scalar::Util' => {
# VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV
'blessed' => do {
*UNIVERSAL::a_sub_not_likely_to_be_here = sub {
},
);
- our %loaded;
-
- our @EXPORT_OK = map { keys %$_ } values %dependencies;
- our %EXPORT_TAGS = (
- all => \@EXPORT_OK,
- );
-
+ my %loaded;
for my $module_name (keys %dependencies) {
my $loaded = do {
local $SIG{__DIE__} = 'DEFAULT';