Commit | Line | Data |
4093c859 |
1 | #!/usr/bin/env perl |
2 | package Mouse::Util; |
3 | use strict; |
4 | use warnings; |
5 | use base 'Exporter'; |
6 | |
7 | our %dependencies = ( |
8fcbe7fb |
8 | 'Scalar::Util' => { |
9 | 'blessed' => do { |
10 | do { |
11 | no strict 'refs'; |
12 | *UNIVERSAL::a_sub_not_likely_to_be_here = sub { |
13 | my $ref = ref($_[0]); |
14 | |
15 | # deviation from Scalar::Util |
16 | # XS returns undef, PP returns GLOB. |
17 | # let's make that more consistent by having PP return |
18 | # undef if it's a GLOB. :/ |
19 | |
20 | # \*STDOUT would be allowed as an object in PP blessed |
21 | # but not XS |
22 | return $ref eq 'GLOB' ? undef : $ref; |
23 | }; |
24 | }; |
25 | |
26 | sub { |
27 | local($@, $SIG{__DIE__}, $SIG{__WARN__}); |
28 | length(ref($_[0])) |
29 | ? eval { $_[0]->a_sub_not_likely_to_be_here } |
30 | : undef; |
31 | }, |
32 | }, |
33 | }, |
4093c859 |
34 | 'MRO::Compat' => { |
35 | 'get_linear_isa' => { |
36 | loaded => \&mro::get_linear_isa, |
37 | not_loaded => do { |
38 | # this recurses so it isn't pretty |
39 | my $code; |
40 | $code = sub { |
41 | no strict 'refs'; |
42 | |
43 | my $classname = shift; |
44 | |
45 | my @lin = ($classname); |
46 | my %stored; |
47 | foreach my $parent (@{"$classname\::ISA"}) { |
48 | my $plin = $code->($parent); |
49 | foreach (@$plin) { |
50 | next if exists $stored{$_}; |
51 | push(@lin, $_); |
52 | $stored{$_} = 1; |
53 | } |
54 | } |
55 | return \@lin; |
56 | } |
57 | }, |
58 | }, |
59 | }, |
60 | ); |
61 | |
62 | our @EXPORT_OK = map { keys %$_ } values %dependencies; |
63 | |
64 | for my $module_name (keys %dependencies) { |
65 | (my $file = "$module_name.pm") =~ s{::}{/}g; |
66 | |
67 | my $loaded = do { |
68 | local $SIG{__DIE__} = 'DEFAULT'; |
69 | eval "require '$file'; 1"; |
70 | }; |
71 | |
72 | for my $method_name (keys %{ $dependencies{ $module_name } }) { |
73 | my $producer = $dependencies{$module_name}{$method_name}; |
74 | my $implementation; |
75 | |
76 | if (ref($producer) eq 'HASH') { |
77 | $implementation = $loaded |
78 | ? $producer->{loaded} |
79 | : $producer->{not_loaded}; |
80 | } |
81 | else { |
82 | $implementation = $loaded |
83 | ? $module_name->can($method_name) |
84 | : $producer; |
85 | } |
86 | |
87 | no strict 'refs'; |
88 | *{ __PACKAGE__ . '::' . $method_name } = $implementation; |
89 | } |
90 | } |
91 | |
92 | 1; |
93 | |