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 || eval { require Scalar::Util; 1 }) {
34 *openhandle = \&Scalar::Util::openhandle;
36 # XXX - room for improvement
39 my $rt = reftype($fh) || '';
41 return defined(fileno($fh)) ? $fh : undef
44 if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
47 elsif ($rt ne 'GLOB') {
51 (tied(*$fh) or defined(fileno($fh)))
56 if (defined &mro::get_linear_isa || eval { require MRO::Compat; 1; }) {
57 *get_linear_isa = \&mro::get_linear_isa;
59 # this recurses so it isn't pretty
61 *get_linear_isa = $code = sub {
64 my $classname = shift;
66 my @lin = ($classname);
68 foreach my $parent (@{"$classname\::ISA"}) {
69 my $plin = $code->($parent);
71 next if exists $stored{$_};
82 sub _install_pp_func {
85 # VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV
87 *UNIVERSAL::a_sub_not_likely_to_be_here = sub {
90 # deviation from Scalar::Util
91 # XS returns undef, PP returns GLOB.
92 # let's make that more consistent by having PP return
93 # undef if it's a GLOB. :/
95 # \*STDOUT would be allowed as an object in PP blessed
97 return $ref eq 'GLOB' ? undef : $ref;
101 local($@, $SIG{__DIE__}, $SIG{__WARN__});
103 ? eval { $_[0]->a_sub_not_likely_to_be_here }
107 'looks_like_number' => sub {
110 # checks from perlfaq4
111 return 0 if !defined($_) or ref($_);
112 return 1 if (/^[+-]?\d+$/); # is a +/- integer
113 return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
114 return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
119 local($@, $SIG{__DIE__}, $SIG{__WARN__});
123 length($t = ref($r)) or return undef;
125 # This eval will fail if the reference is not blessed
126 eval { $r->a_sub_not_likely_to_be_here; 1 }
129 # we have a GLOB or an IO. Stringify a GLOB gives it's name
131 $q =~ /^\*/ ? "GLOB" : "IO";
134 # OK, if we don't have a GLOB what parts of
135 # a glob will it populate.
136 # NOTE: A glob always has a SCALAR
138 defined *glob{ARRAY} && "ARRAY"
139 or defined *glob{HASH} && "HASH"
140 or defined *glob{CODE} && "CODE"
141 or length(ref(${$r})) ? "REF" : "SCALAR";
146 'openhandle' => sub {
148 my $rt = reftype($fh) || '';
150 return defined(fileno($fh)) ? $fh : undef
153 if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
154 $fh = \(my $tmp=$fh);
156 elsif ($rt ne 'GLOB') {
160 (tied(*$fh) or defined(fileno($fh)))
164 loaded => \&Scalar::Util::weaken,
165 not_loaded => sub { die "Scalar::Util required for weak reference support" },
167 # ^^^^^ CODE TAKEN FROM SCALAR::UTIL ^^^^^
170 # VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV
171 'get_linear_isa' => {
172 loaded => \&mro::get_linear_isa,
174 # this recurses so it isn't pretty
179 my $classname = shift;
181 my @lin = ($classname);
183 foreach my $parent (@{"$classname\::ISA"}) {
184 my $plin = $code->($parent);
186 next if exists $stored{$_};
195 # ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
200 for my $module_name (keys %dependencies) {
202 local $SIG{__DIE__} = 'DEFAULT';
203 eval "require $module_name; 1";
206 $loaded{$module_name} = $loaded;
208 for my $method_name (keys %{ $dependencies{ $module_name } }) {
209 my $producer = $dependencies{$module_name}{$method_name};
212 if (ref($producer) eq 'HASH') {
213 $implementation = $loaded
214 ? $producer->{loaded}
215 : $producer->{not_loaded};
218 $implementation = $loaded
219 ? $module_name->can($method_name)
224 *{ __PACKAGE__ . '::' . $method_name } = $implementation;
229 sub apply_all_roles {
230 my $meta = Mouse::Meta::Class->initialize(shift);
232 confess "Mouse::Util only supports 'apply_all_roles' on individual roles at a time" if @_;
234 Mouse::load_class($role);
235 $role->meta->apply($meta);
244 Mouse::Util - features, with or without their dependencies
246 =head1 IMPLEMENTATIONS FOR
248 =head2 L<MRO::Compat>
250 =head3 get_linear_isa
252 =head2 L<Scalar::Util>
256 =head3 looks_like_number
264 C<weaken> I<must> be implemented in XS. If the user tries to use C<weaken>
265 without L<Scalar::Util>, an error is thrown.
267 =head2 Test::Exception