12 # VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV
14 *UNIVERSAL::a_sub_not_likely_to_be_here = sub {
17 # deviation from Scalar::Util
18 # XS returns undef, PP returns GLOB.
19 # let's make that more consistent by having PP return
20 # undef if it's a GLOB. :/
22 # \*STDOUT would be allowed as an object in PP blessed
24 return $ref eq 'GLOB' ? undef : $ref;
28 local($@, $SIG{__DIE__}, $SIG{__WARN__});
30 ? eval { $_[0]->a_sub_not_likely_to_be_here }
34 'looks_like_number' => sub {
37 # checks from perlfaq4
38 return 0 if !defined($_) or ref($_);
39 return 1 if (/^[+-]?\d+$/); # is a +/- integer
40 return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
41 return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
46 local($@, $SIG{__DIE__}, $SIG{__WARN__});
50 length($t = ref($r)) or return undef;
52 # This eval will fail if the reference is not blessed
53 eval { $r->a_sub_not_likely_to_be_here; 1 }
56 # we have a GLOB or an IO. Stringify a GLOB gives it's name
58 $q =~ /^\*/ ? "GLOB" : "IO";
61 # OK, if we don't have a GLOB what parts of
62 # a glob will it populate.
63 # NOTE: A glob always has a SCALAR
65 defined *glob{ARRAY} && "ARRAY"
66 or defined *glob{HASH} && "HASH"
67 or defined *glob{CODE} && "CODE"
68 or length(ref(${$r})) ? "REF" : "SCALAR";
75 my $rt = reftype($fh) || '';
77 return defined(fileno($fh)) ? $fh : undef
80 if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
83 elsif ($rt ne 'GLOB') {
87 (tied(*$fh) or defined(fileno($fh)))
91 loaded => \&Scalar::Util::weaken,
92 not_loaded => sub { die "Scalar::Util required for weak reference support" },
94 # ^^^^^ CODE TAKEN FROM SCALAR::UTIL ^^^^^
97 # VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV
99 loaded => \&mro::get_linear_isa,
101 # this recurses so it isn't pretty
106 my $classname = shift;
108 my @lin = ($classname);
110 foreach my $parent (@{"$classname\::ISA"}) {
111 my $plin = $code->($parent);
113 next if exists $stored{$_};
122 # ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
128 our @EXPORT_OK = map { keys %$_ } values %dependencies;
133 for my $module_name (keys %dependencies) {
135 local $SIG{__DIE__} = 'DEFAULT';
136 eval "require $module_name; 1";
139 $loaded{$module_name} = $loaded;
141 for my $method_name (keys %{ $dependencies{ $module_name } }) {
142 my $producer = $dependencies{$module_name}{$method_name};
145 if (ref($producer) eq 'HASH') {
146 $implementation = $loaded
147 ? $producer->{loaded}
148 : $producer->{not_loaded};
151 $implementation = $loaded
152 ? $module_name->can($method_name)
157 *{ __PACKAGE__ . '::' . $method_name } = $implementation;
162 sub apply_all_roles {
163 my $meta = Mouse::Meta::Class->initialize(shift);
165 confess "Mouse::Util only supports 'apply_all_roles' on individual roles at a time" if @_;
167 Mouse::load_class($role);
168 $role->meta->apply($meta);
177 Mouse::Util - features, with or without their dependencies
179 =head1 IMPLEMENTATIONS FOR
181 =head2 L<MRO::Compat>
183 =head3 get_linear_isa
185 =head2 L<Scalar::Util>
189 =head3 looks_like_number
197 C<weaken> I<must> be implemented in XS. If the user tries to use C<weaken>
198 without L<Scalar::Util>, an error is thrown.
200 =head2 Test::Exception