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.80';
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($_[0]); # class or role name
282 # Basis of Data::OptList
283 my $max = scalar(@_);
284 for (my $i = 1; $i < $max ; $i++) {
288 $role_name = $role->name;
292 load_class($role_name);
293 $role = get_metaclass_by_name($role_name);
296 if ($i + 1 < $max && ref($_[$i + 1]) eq 'HASH') {
297 push @roles, [ $role => $_[++$i] ];
299 push @roles, [ $role => undef ];
302 || $consumer->meta->throw_error("You can only consume roles, $role_name is not a Mouse role");
305 if ( scalar @roles == 1 ) {
306 my ( $role, $params ) = @{ $roles[0] };
307 $role->apply( $consumer, defined $params ? $params : () );
310 Mouse::Meta::Role->combine(@roles)->apply($consumer);
315 # taken from Moose::Util 0.90
317 return $_[0] if @_ == 1;
321 return "$items[0] and $items[1]" if @items == 2;
323 my $tail = pop @items;
325 return join q{, }, @items, "and $tail";
328 sub quoted_english_list {
329 return english_list(map { qq{'$_'} } @_);
337 $feature ||= ( caller(1) )[3] . '()'; # subroutine name
339 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
340 Carp::confess("Mouse does not currently support $feature");
343 # general meta() method
345 return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]);
348 # general throw_error() method
349 # $o->throw_error($msg, depth => $leve, longmess => $croak_or_confess)
350 sub throw_error :method {
351 my($self, $message, %args) = @_;
353 local $Carp::CarpLevel = $Carp::CarpLevel + 1 + ($args{depth} || 0);
354 local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though
356 if(exists $args{longmess} && !$args{longmess}) {
357 Carp::croak($message);
360 Carp::confess($message);
364 # general dump() method
366 my($self, $maxdepth) = @_;
368 require 'Data/Dumper.pm'; # we don't want to create its namespace
369 my $dd = Data::Dumper->new([$self]);
370 $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 3);
377 # general does() method
387 Mouse::Util - Utilities for working with Mouse classes
391 This document describes Mouse version 0.80
395 use Mouse::Util; # turns on strict and warnings
399 This module provides a set of utility functions. Many of these
400 functions are intended for use in Mouse itself or MouseX modules, but
401 some of them may be useful for use in your own code.
403 =head1 IMPLEMENTATIONS FOR
405 =head2 Moose::Util functions
407 The following functions are exportable.
409 =head3 C<find_meta($class_or_obj)>
411 The same as C<Mouse::Util::class_of()>.
413 =head3 C<does_role($class_or_obj, $role_or_obj)>
415 =head3 C<resolve_metaclass_alias($category, $name, %options)>
417 =head3 C<apply_all_roles($applicant, @roles)>
419 =head3 C<english_listi(@items)>
421 =head2 Class::MOP functions
423 The following functions are not exportable.
425 =head3 C<< Mouse::Util::is_class_loaded($classname) -> Bool >>
427 Returns whether I<$classname> is actually loaded or not.
428 It uses a heuristic which involves checking for the existence of
429 C<$VERSION>, C<@ISA>, and any locally-defined method.
431 =head3 C<< Mouse::Util::load_class($classname) -> ClassName >>
433 This will load a given I<$classname> (or die if it is not loadable).
434 This function can be used in place of tricks like
435 C<eval "use $module ()"> or using C<require>.
437 =head3 C<< Mouse::Util::class_of($classname_or_object) -> MetaClass >>
439 =head3 C<< Mouse::Util::get_metaclass_by_name($classname) -> MetaClass >>
441 =head3 C<< Mouse::Util::get_all_metaclass_instances() -> (MetaClasses) >>
443 =head3 C<< Mouse::Util::get_all_metaclass_names() -> (ClassNames) >>
447 =head3 C<get_linear_isa>
451 =head3 C<get_code_info>
453 =head1 Mouse specific utilities
455 =head3 C<not_supported>
457 =head3 C<get_code_package>
459 =head3 C<get_code_ref>