20 # We only have to do this nastiness if we haven't loaded XS version of
21 # Mouse.pm, so check if we're running under PurePerl or not
23 if ($Mouse::PurePerl) {
26 # If we're running under XS, we can provide
31 # other functions need to be loaded from our respective sources
33 if (defined &Scalar::Util::openhandle) {
34 *openhandle = \&Scalar::Util::openhandle;
36 # XXX - room for improvement
38 local($@, $SIG{__DIE__}, $SIG{__WARN__});
42 length($t = ref($r)) or return undef;
44 # This eval will fail if the reference is not blessed
45 eval { $r->a_sub_not_likely_to_be_here; 1 }
48 # we have a GLOB or an IO. Stringify a GLOB gives it's name
50 $q =~ /^\*/ ? "GLOB" : "IO";
53 # OK, if we don't have a GLOB what parts of
54 # a glob will it populate.
55 # NOTE: A glob always has a SCALAR
57 defined *glob{ARRAY} && "ARRAY"
58 or defined *glob{HASH} && "HASH"
59 or defined *glob{CODE} && "CODE"
60 or length(ref(${$r})) ? "REF" : "SCALAR";
67 if (defined &mro::get_linear_isa) {
68 *get_linear_isa = \&mro::get_linear_isa;
70 # this recurses so it isn't pretty
72 *get_linear_isa = $code = sub {
75 my $classname = shift;
77 my @lin = ($classname);
79 foreach my $parent (@{"$classname\::ISA"}) {
80 my $plin = $code->($parent);
82 next if exists $stored{$_};
93 sub _install_pp_func {
96 # VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV
98 *UNIVERSAL::a_sub_not_likely_to_be_here = sub {
101 # deviation from Scalar::Util
102 # XS returns undef, PP returns GLOB.
103 # let's make that more consistent by having PP return
104 # undef if it's a GLOB. :/
106 # \*STDOUT would be allowed as an object in PP blessed
108 return $ref eq 'GLOB' ? undef : $ref;
112 local($@, $SIG{__DIE__}, $SIG{__WARN__});
114 ? eval { $_[0]->a_sub_not_likely_to_be_here }
118 'looks_like_number' => sub {
121 # checks from perlfaq4
122 return 0 if !defined($_) or ref($_);
123 return 1 if (/^[+-]?\d+$/); # is a +/- integer
124 return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
125 return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
130 local($@, $SIG{__DIE__}, $SIG{__WARN__});
134 length($t = ref($r)) or return undef;
136 # This eval will fail if the reference is not blessed
137 eval { $r->a_sub_not_likely_to_be_here; 1 }
140 # we have a GLOB or an IO. Stringify a GLOB gives it's name
142 $q =~ /^\*/ ? "GLOB" : "IO";
145 # OK, if we don't have a GLOB what parts of
146 # a glob will it populate.
147 # NOTE: A glob always has a SCALAR
149 defined *glob{ARRAY} && "ARRAY"
150 or defined *glob{HASH} && "HASH"
151 or defined *glob{CODE} && "CODE"
152 or length(ref(${$r})) ? "REF" : "SCALAR";
157 'openhandle' => sub {
159 my $rt = reftype($fh) || '';
161 return defined(fileno($fh)) ? $fh : undef
164 if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
165 $fh = \(my $tmp=$fh);
167 elsif ($rt ne 'GLOB') {
171 (tied(*$fh) or defined(fileno($fh)))
175 loaded => \&Scalar::Util::weaken,
176 not_loaded => sub { die "Scalar::Util required for weak reference support" },
178 # ^^^^^ CODE TAKEN FROM SCALAR::UTIL ^^^^^
181 # VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV
182 'get_linear_isa' => {
183 loaded => \&mro::get_linear_isa,
185 # this recurses so it isn't pretty
190 my $classname = shift;
192 my @lin = ($classname);
194 foreach my $parent (@{"$classname\::ISA"}) {
195 my $plin = $code->($parent);
197 next if exists $stored{$_};
206 # ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
211 for my $module_name (keys %dependencies) {
213 local $SIG{__DIE__} = 'DEFAULT';
214 eval "require $module_name; 1";
217 $loaded{$module_name} = $loaded;
219 for my $method_name (keys %{ $dependencies{ $module_name } }) {
220 my $producer = $dependencies{$module_name}{$method_name};
223 if (ref($producer) eq 'HASH') {
224 $implementation = $loaded
225 ? $producer->{loaded}
226 : $producer->{not_loaded};
229 $implementation = $loaded
230 ? $module_name->can($method_name)
235 *{ __PACKAGE__ . '::' . $method_name } = $implementation;
240 sub apply_all_roles {
241 my $meta = Mouse::Meta::Class->initialize(shift);
243 confess "Mouse::Util only supports 'apply_all_roles' on individual roles at a time" if @_;
245 Mouse::load_class($role);
246 $role->meta->apply($meta);
255 Mouse::Util - features, with or without their dependencies
257 =head1 IMPLEMENTATIONS FOR
259 =head2 L<MRO::Compat>
261 =head3 get_linear_isa
263 =head2 L<Scalar::Util>
267 =head3 looks_like_number
275 C<weaken> I<must> be implemented in XS. If the user tries to use C<weaken>
276 without L<Scalar::Util>, an error is thrown.
278 =head2 Test::Exception