2 use Mouse::Exporter; # enables strict and warnings
4 # must be here because it will be refered by other modules loaded
5 sub get_linear_isa($;$); ## no critic
7 # must be here because it will called in Mouse::Exporter
8 sub install_subroutines {
11 while(my($name, $code) = splice @_, 0, 2){
13 no warnings 'once', 'redefine';
14 use warnings FATAL => 'uninitialized';
15 *{$into . '::' . $name} = \&{$code};
21 # This is used in Mouse::PurePerl
22 Mouse::Exporter->setup_import_methods(
26 resolve_metaclass_alias
41 does meta throw_error dump
44 default => [], # export no functions by default
46 # The ':meta' group is 'use metaclass' for Mouse
47 meta => [qw(does meta dump throw_error)],
51 our $VERSION = '0.70';
53 my $xs = !(defined(&is_valid_class_name) || $ENV{MOUSE_PUREPERL} || $ENV{PERL_ONLY});
55 # Because Mouse::Util is loaded first in all the Mouse sub-modules,
56 # XSLoader must be placed here, not in Mouse.pm.
58 # XXX: XSLoader tries to get the object path from caller's file name
59 # $hack_mouse_file fools its mechanism
60 (my $hack_mouse_file = __FILE__) =~ s/.Util//; # .../Mouse/Util.pm -> .../Mouse.pm
61 $xs = eval sprintf("#line %d %s\n", __LINE__, $hack_mouse_file) . q{
62 local $^W = 0; # workaround 'redefine' warning to &install_subroutines
64 XSLoader::load('Mouse', $VERSION);
65 Mouse::Util->import({ into => 'Mouse::Meta::Method::Constructor::XS' }, ':meta');
66 Mouse::Util->import({ into => 'Mouse::Meta::Method::Destructor::XS' }, ':meta');
67 Mouse::Util->import({ into => 'Mouse::Meta::Method::Accessor::XS' }, ':meta');
70 warn $@ if $@ && $ENV{MOUSE_XS};
74 require 'Mouse/PurePerl.pm'; # we don't want to create its namespace
77 *MOUSE_XS = sub(){ $xs };
83 # aliases as public APIs
84 # it must be 'require', not 'use', because Mouse::Meta::Module depends on Mouse::Util
85 require Mouse::Meta::Module; # for the entities of metaclass cache utilities
89 *class_of = \&Mouse::Meta::Module::_class_of;
90 *get_metaclass_by_name = \&Mouse::Meta::Module::_get_metaclass_by_name;
91 *get_all_metaclass_instances = \&Mouse::Meta::Module::_get_all_metaclass_instances;
92 *get_all_metaclass_names = \&Mouse::Meta::Module::_get_all_metaclass_names;
94 *Mouse::load_class = \&load_class;
95 *Mouse::is_class_loaded = \&is_class_loaded;
98 #generate_isa_predicate_for('Mouse::Meta::TypeConstraint' => 'is_a_type_constraint');
99 #generate_isa_predicate_for('Mouse::Meta::Class' => 'is_a_metaclass');
100 #generate_isa_predicate_for('Mouse::Meta::Role' => 'is_a_metarole');
102 # duck type predicates
103 generate_can_predicate_for(['_compiled_type_constraint'] => 'is_a_type_constraint');
104 generate_can_predicate_for(['create_anon_class'] => 'is_a_metaclass');
105 generate_can_predicate_for(['create_anon_role'] => 'is_a_metarole');
108 our $in_global_destruction = 0;
109 END{ $in_global_destruction = 1 }
111 # Moose::Util compatible utilities
114 return class_of( $_[0] );
118 my ($class_or_obj, $role_name) = @_;
120 my $meta = class_of($class_or_obj);
123 || ($meta || 'Mouse::Meta::Class')->throw_error("You must supply a role name to does()");
125 return defined($meta) && $meta->does_role($role_name);
130 if ($] >= 5.009_005) {
132 $get_linear_isa = \&mro::get_linear_isa;
134 # this code is based on MRO::Compat::__get_linear_isa
135 my $_get_linear_isa_dfs; # this recurses so it isn't pretty
136 $_get_linear_isa_dfs = sub {
139 my @lin = ($classname);
143 foreach my $parent (@{"$classname\::ISA"}) {
144 foreach my $p(@{ $_get_linear_isa_dfs->($parent) }) {
145 next if exists $stored{$p};
154 package # hide from PAUSE
156 our %MRO; # avoid 'once' warnings
159 # MRO::Compat::__get_linear_isa has no prototype, so
160 # we define a prototyped version for compatibility with core's
161 # See also MRO::Compat::__get_linear_isa.
162 $get_linear_isa = sub ($;$){
163 my($classname, $type) = @_;
166 $type = exists $Class::C3::MRO{$classname} ? 'c3' : 'dfs';
170 return [Class::C3::calculateMRO($classname)];
173 return $_get_linear_isa_dfs->($classname);
178 *get_linear_isa = $get_linear_isa;
182 # taken from Mouse::Util (0.90)
186 sub resolve_metaclass_alias {
187 my ( $type, $metaclass_name, %options ) = @_;
189 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
191 return $cache{$cache_key}{$metaclass_name} ||= do{
193 my $possible_full_name = join '::',
194 'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name
197 my $loaded_class = load_first_existing_class(
202 $loaded_class->can('register_implementation')
203 ? $loaded_class->register_implementation
209 # Utilities from Class::MOP
212 sub get_code_package;
214 sub is_valid_class_name;
216 # taken from Class/MOP.pm
217 sub load_first_existing_class {
222 for my $class (@classes) {
223 my $e = _try_load_one_class($class);
226 $exceptions{$class} = $e;
237 sprintf( "Could not load class (%s) because : %s",
238 $_, $exceptions{$_} )
243 # taken from Class/MOP.pm
244 sub _try_load_one_class {
247 unless ( is_valid_class_name($class) ) {
248 my $display = defined($class) ? $class : 'undef';
249 Carp::confess "Invalid class name ($display)";
252 return '' if is_class_loaded($class);
259 eval { require $class };
267 my $e = _try_load_one_class($class);
268 Carp::confess "Could not load class ($class) because : $e" if $e;
275 sub apply_all_roles {
276 my $consumer = Scalar::Util::blessed($_[0])
278 : Mouse::Meta::Class->initialize(shift); # class or role name
282 # Basis of Data::OptList
283 my $max = scalar(@_);
284 for (my $i = 0; $i < $max ; $i++) {
285 if ($i + 1 < $max && ref($_[$i + 1])) {
286 push @roles, [ $_[$i] => $_[++$i] ];
288 push @roles, [ $_[$i] => undef ];
290 my $role_name = $roles[-1][0];
291 load_class($role_name);
293 is_a_metarole( get_metaclass_by_name($role_name) )
294 || $consumer->meta->throw_error("You can only consume roles, $role_name is not a Mouse role");
297 if ( scalar @roles == 1 ) {
298 my ( $role_name, $params ) = @{ $roles[0] };
299 get_metaclass_by_name($role_name)->apply( $consumer, defined $params ? $params : () );
302 Mouse::Meta::Role->combine(@roles)->apply($consumer);
307 # taken from Moose::Util 0.90
309 return $_[0] if @_ == 1;
313 return "$items[0] and $items[1]" if @items == 2;
315 my $tail = pop @items;
317 return join q{, }, @items, "and $tail";
320 sub quoted_english_list {
321 return english_list(map { qq{'$_'} } @_);
329 $feature ||= ( caller(1) )[3]; # subroutine name
331 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
332 Carp::confess("Mouse does not currently support $feature");
335 # general meta() method
337 return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]);
340 # general throw_error() method
341 # $o->throw_error($msg, depth => $leve, longmess => $croak_or_confess)
342 sub throw_error :method {
343 my($self, $message, %args) = @_;
345 local $Carp::CarpLevel = $Carp::CarpLevel + 1 + ($args{depth} || 0);
346 local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though
348 if(exists $args{longmess} && !$args{longmess}) {
349 Carp::croak($message);
352 Carp::confess($message);
356 # general dump() method
358 my($self, $maxdepth) = @_;
360 require 'Data/Dumper.pm'; # we don't want to create its namespace
361 my $dd = Data::Dumper->new([$self]);
362 $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 3);
369 # general does() method
379 Mouse::Util - Utilities for working with Mouse classes
383 This document describes Mouse version 0.70
387 use Mouse::Util; # turns on strict and warnings
391 This module provides a set of utility functions. Many of these
392 functions are intended for use in Mouse itself or MouseX modules, but
393 some of them may be useful for use in your own code.
395 =head1 IMPLEMENTATIONS FOR
397 =head2 Moose::Util functions
399 The following functions are exportable.
401 =head3 C<find_meta($class_or_obj)>
403 The same as C<Mouse::Util::class_of()>.
405 =head3 C<does_role($class_or_obj, $role_or_obj)>
407 =head3 C<resolve_metaclass_alias($category, $name, %options)>
409 =head3 C<apply_all_roles($applicant, @roles)>
411 =head3 C<english_listi(@items)>
413 =head2 Class::MOP functions
415 The following functions are not exportable.
417 =head3 C<< Mouse::Util::is_class_loaded($classname) -> Bool >>
419 Returns whether I<$classname> is actually loaded or not.
420 It uses a heuristic which involves checking for the existence of
421 C<$VERSION>, C<@ISA>, and any locally-defined method.
423 =head3 C<< Mouse::Util::load_class($classname) -> ClassName >>
425 This will load a given I<$classname> (or die if it is not loadable).
426 This function can be used in place of tricks like
427 C<eval "use $module ()"> or using C<require>.
429 =head3 C<< Mouse::Util::class_of($classname_or_object) -> MetaClass >>
431 =head3 C<< Mouse::Util::get_metaclass_by_name($classname) -> MetaClass >>
433 =head3 C<< Mouse::Util::get_all_metaclass_instances() -> (MetaClasses) >>
435 =head3 C<< Mouse::Util::get_all_metaclass_names() -> (ClassNames) >>
439 =head3 C<get_linear_isa>
443 =head3 C<get_code_info>
445 =head1 Mouse specific utilities
447 =head3 C<not_supported>
449 =head3 C<get_code_package>
451 =head3 C<get_code_ref>