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
44 default => [], # export no functions by default
46 # The ':meta' group is 'use metaclass' for Mouse
47 meta => [qw(does meta dump)],
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');
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 dump() method
342 my($self, $maxdepth) = @_;
344 require 'Data/Dumper.pm'; # we don't want to create its namespace
345 my $dd = Data::Dumper->new([$self]);
346 $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 3);
352 # general does() method
362 Mouse::Util - Utilities for working with Mouse classes
366 This document describes Mouse version 0.70
370 use Mouse::Util; # turns on strict and warnings
374 This module provides a set of utility functions. Many of these
375 functions are intended for use in Mouse itself or MouseX modules, but
376 some of them may be useful for use in your own code.
378 =head1 IMPLEMENTATIONS FOR
380 =head2 Moose::Util functions
382 The following functions are exportable.
384 =head3 C<find_meta($class_or_obj)>
386 The same as C<Mouse::Util::class_of()>.
388 =head3 C<does_role($class_or_obj, $role_or_obj)>
390 =head3 C<resolve_metaclass_alias($category, $name, %options)>
392 =head3 C<apply_all_roles($applicant, @roles)>
394 =head3 C<english_listi(@items)>
396 =head2 Class::MOP functions
398 The followign functions are not exportable.
400 =head3 C<< Mouse::Util::is_class_loaded($classname) -> Bool >>
402 Returns whether I<$classname> is actually loaded or not.
403 It uses a heuristic which involves checking for the existence of
404 C<$VERSION>, C<@ISA>, and any locally-defined method.
406 =head3 C<< Mouse::Util::load_class($classname) -> ClassName >>
408 This will load a given I<$classname> (or die if it is not loadable).
409 This function can be used in place of tricks like
410 C<eval "use $module ()"> or using C<require>.
412 =head3 C<< Mouse::Util::class_of($classname_or_object) -> MetaClass >>
414 =head3 C<< Mouse::Util::get_metaclass_by_name($classname) -> MetaClass >>
416 =head3 C<< Mouse::Util::get_all_metaclass_instances() -> (MetaClasses) >>
418 =head3 C<< Mouse::Util::get_all_metaclass_names() -> (ClassNames) >>
422 =head3 C<get_linear_isa>
426 =head3 C<get_code_info>
428 =head1 Mouse specific utilities
430 =head3 C<not_supported>
432 =head3 C<get_code_package>
434 =head3 C<get_code_ref>