We don't need to do both eval and Module::Name -> Module/Name.pm munging
[gitmo/Mouse.git] / lib / Mouse / Util.pm
CommitLineData
4093c859 1#!/usr/bin/env perl
2package Mouse::Util;
3use strict;
4use warnings;
5use base 'Exporter';
6
7our %dependencies = (
8fcbe7fb 8 'Scalar::Util' => {
577be390 9
10# VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV
8fcbe7fb 11 'blessed' => do {
7fe1b68f 12 *UNIVERSAL::a_sub_not_likely_to_be_here = sub {
13 my $ref = ref($_[0]);
8fcbe7fb 14
7fe1b68f 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. :/
8fcbe7fb 19
7fe1b68f 20 # \*STDOUT would be allowed as an object in PP blessed
21 # but not XS
22 return $ref eq 'GLOB' ? undef : $ref;
8fcbe7fb 23 };
24
25 sub {
26 local($@, $SIG{__DIE__}, $SIG{__WARN__});
27 length(ref($_[0]))
28 ? eval { $_[0]->a_sub_not_likely_to_be_here }
29 : undef;
30 },
31 },
58fe9fb7 32 'looks_like_number' => sub {
33 local $_ = shift;
34
35 # checks from perlfaq4
36 return 0 if !defined($_) or ref($_);
37 return 1 if (/^[+-]?\d+$/); # is a +/- integer
38 return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
39 return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
40
41 0;
42 },
d8aea268 43 'reftype' => sub {
44 local($@, $SIG{__DIE__}, $SIG{__WARN__});
45 my $r = shift;
46 my $t;
47
48 length($t = ref($r)) or return undef;
49
50 # This eval will fail if the reference is not blessed
51 eval { $r->a_sub_not_likely_to_be_here; 1 }
52 ? do {
53 $t = eval {
54 # we have a GLOB or an IO. Stringify a GLOB gives it's name
55 my $q = *$r;
56 $q =~ /^\*/ ? "GLOB" : "IO";
57 }
58 or do {
59 # OK, if we don't have a GLOB what parts of
60 # a glob will it populate.
61 # NOTE: A glob always has a SCALAR
62 local *glob = $r;
63 defined *glob{ARRAY} && "ARRAY"
64 or defined *glob{HASH} && "HASH"
65 or defined *glob{CODE} && "CODE"
66 or length(ref(${$r})) ? "REF" : "SCALAR";
67 }
68 }
69 : $t
70 },
29312fc3 71 'openhandle' => sub {
72 my $fh = shift;
73 my $rt = reftype($fh) || '';
74
75 return defined(fileno($fh)) ? $fh : undef
76 if $rt eq 'IO';
77
78 if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
79 $fh = \(my $tmp=$fh);
80 }
81 elsif ($rt ne 'GLOB') {
82 return undef;
83 }
84
85 (tied(*$fh) or defined(fileno($fh)))
86 ? $fh : undef;
87 },
577be390 88 weaken => {
89 loaded => \&Scalar::Util::weaken,
90 not_loaded => sub { die "Scalar::Util required for weak reference support" },
91 },
92# ^^^^^ CODE TAKEN FROM SCALAR::UTIL ^^^^^
8fcbe7fb 93 },
4093c859 94 'MRO::Compat' => {
577be390 95# VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV
4093c859 96 'get_linear_isa' => {
97 loaded => \&mro::get_linear_isa,
98 not_loaded => do {
99 # this recurses so it isn't pretty
100 my $code;
101 $code = sub {
102 no strict 'refs';
103
104 my $classname = shift;
105
106 my @lin = ($classname);
107 my %stored;
108 foreach my $parent (@{"$classname\::ISA"}) {
109 my $plin = $code->($parent);
110 foreach (@$plin) {
111 next if exists $stored{$_};
112 push(@lin, $_);
113 $stored{$_} = 1;
114 }
115 }
116 return \@lin;
117 }
118 },
119 },
577be390 120# ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
4093c859 121 },
122);
123
124our @EXPORT_OK = map { keys %$_ } values %dependencies;
125
126for my $module_name (keys %dependencies) {
4093c859 127 my $loaded = do {
128 local $SIG{__DIE__} = 'DEFAULT';
4d02abfd 129 eval "require $module_name; 1";
4093c859 130 };
131
132 for my $method_name (keys %{ $dependencies{ $module_name } }) {
133 my $producer = $dependencies{$module_name}{$method_name};
134 my $implementation;
135
136 if (ref($producer) eq 'HASH') {
137 $implementation = $loaded
138 ? $producer->{loaded}
139 : $producer->{not_loaded};
140 }
141 else {
142 $implementation = $loaded
143 ? $module_name->can($method_name)
144 : $producer;
145 }
146
147 no strict 'refs';
148 *{ __PACKAGE__ . '::' . $method_name } = $implementation;
149 }
150}
151
1521;
153
f38ce2d0 154__END__
155
156=head1 NAME
157
158Mouse::Util - features, with or without their dependencies
159
160=head1 IMPLEMENTATIONS FOR
161
162=head2 L<MRO::Compat>
163
164=head3 get_linear_isa
165
166=head2 L<Scalar::Util>
167
168=head3 blessed
169
170=head3 looks_like_number
171
172=head3 reftype
173
174=head3 openhandle
175
176=head3 weaken
177
178C<weaken> I<must> be implemented in XS. If the user tries to use C<weaken>
179without L<Scalar::Util>, an error is thrown.
180
181=cut
182