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 # Checking for undefinedness will ensure that our functions are
24 # properly loaded without loading Mouse, but this is kind of ugly
25 if ($Mouse::PurePerl || ! defined $Mouse::PurePerl) {
28 # VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV
30 *UNIVERSAL::a_sub_not_likely_to_be_here = sub {
33 # deviation from Scalar::Util
34 # XS returns undef, PP returns GLOB.
35 # let's make that more consistent by having PP return
36 # undef if it's a GLOB. :/
38 # \*STDOUT would be allowed as an object in PP blessed
40 return $ref eq 'GLOB' ? undef : $ref;
44 local($@, $SIG{__DIE__}, $SIG{__WARN__});
46 ? eval { $_[0]->a_sub_not_likely_to_be_here }
50 'looks_like_number' => sub {
53 # checks from perlfaq4
54 return 0 if !defined($_) or ref($_);
55 return 1 if (/^[+-]?\d+$/); # is a +/- integer
56 return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
57 return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
62 local($@, $SIG{__DIE__}, $SIG{__WARN__});
66 length($t = ref($r)) or return undef;
68 # This eval will fail if the reference is not blessed
69 eval { $r->a_sub_not_likely_to_be_here; 1 }
72 # we have a GLOB or an IO. Stringify a GLOB gives it's name
74 $q =~ /^\*/ ? "GLOB" : "IO";
77 # OK, if we don't have a GLOB what parts of
78 # a glob will it populate.
79 # NOTE: A glob always has a SCALAR
81 defined *glob{ARRAY} && "ARRAY"
82 or defined *glob{HASH} && "HASH"
83 or defined *glob{CODE} && "CODE"
84 or length(ref(${$r})) ? "REF" : "SCALAR";
91 my $rt = reftype($fh) || '';
93 return defined(fileno($fh)) ? $fh : undef
96 if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
99 elsif ($rt ne 'GLOB') {
103 (tied(*$fh) or defined(fileno($fh)))
107 loaded => \&Scalar::Util::weaken,
108 not_loaded => sub { die "Scalar::Util required for weak reference support" },
110 # ^^^^^ CODE TAKEN FROM SCALAR::UTIL ^^^^^
113 # VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV
114 'get_linear_isa' => {
115 loaded => \&mro::get_linear_isa,
117 # this recurses so it isn't pretty
122 my $classname = shift;
124 my @lin = ($classname);
126 foreach my $parent (@{"$classname\::ISA"}) {
127 my $plin = $code->($parent);
129 next if exists $stored{$_};
138 # ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
143 for my $module_name (keys %dependencies) {
145 local $SIG{__DIE__} = 'DEFAULT';
146 eval "require $module_name; 1";
149 $loaded{$module_name} = $loaded;
151 for my $method_name (keys %{ $dependencies{ $module_name } }) {
152 my $producer = $dependencies{$module_name}{$method_name};
155 if (ref($producer) eq 'HASH') {
156 $implementation = $loaded
157 ? $producer->{loaded}
158 : $producer->{not_loaded};
161 $implementation = $loaded
162 ? $module_name->can($method_name)
167 *{ __PACKAGE__ . '::' . $method_name } = $implementation;
171 # If we're running under XS, we can provide
176 # other functions need to be loaded from our respective sources
178 if (defined &Scalar::Util::openhandle) {
179 *openhandle = \&Scalar::Util::openhandle;
181 # XXX - room for improvement
184 my $rt = reftype($fh) || '';
186 return defined(fileno($fh)) ? $fh : undef
189 if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
190 $fh = \(my $tmp=$fh);
192 elsif ($rt ne 'GLOB') {
196 (tied(*$fh) or defined(fileno($fh)))
201 if (defined &mro::get_linear_isa || eval { require MRO::Compat; 1; }) {
202 *get_linear_isa = \&mro::get_linear_isa;
204 # this recurses so it isn't pretty
206 *get_linear_isa = $code = sub {
209 my $classname = shift;
211 my @lin = ($classname);
213 foreach my $parent (@{"$classname\::ISA"}) {
214 my $plin = $code->($parent);
216 next if exists $stored{$_};
227 sub apply_all_roles {
228 my $meta = Mouse::Meta::Class->initialize(shift);
231 my $max = scalar(@_);
232 for (my $i = 0; $i < $max ; $i++) {
233 if ($i + 1 < $max && ref($_[$i + 1])) {
234 push @roles, [ $_[$i++] => $_[$i] ];
236 push @roles, [ $_[$i] => {} ];
240 foreach my $role_spec (@roles) {
241 Mouse::load_class( $role_spec->[0] );
244 ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
245 || croak("You can only consume roles, "
247 . " is not a Moose role")
250 if ( scalar @roles == 1 ) {
251 my ( $role, $params ) = @{ $roles[0] };
252 $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
255 Mouse::Meta::Role->combine_apply($meta, @roles);
266 Mouse::Util - features, with or without their dependencies
268 =head1 IMPLEMENTATIONS FOR
270 =head2 L<MRO::Compat>
272 =head3 get_linear_isa
274 =head2 L<Scalar::Util>
278 =head3 looks_like_number
286 C<weaken> I<must> be implemented in XS. If the user tries to use C<weaken>
287 without L<Scalar::Util>, an error is thrown.
289 =head2 Test::Exception