2 use Mouse::Exporter; # enables strict and warnings
4 # Note that those which don't exist here are defined in XS or Mouse::PurePerl
6 # must be here because it will be refered by other modules loaded
7 sub get_linear_isa($;$); ## no critic
9 # must be here because it will called in Mouse::Exporter
10 sub install_subroutines {
13 while(my($name, $code) = splice @_, 0, 2){
15 no warnings 'once', 'redefine';
16 use warnings FATAL => 'uninitialized';
17 *{$into . '::' . $name} = \&{$code};
23 # This is used in Mouse::PurePerl
24 Mouse::Exporter->setup_import_methods(
28 resolve_metaclass_alias
43 does meta throw_error dump
46 default => [], # export no functions by default
48 # The ':meta' group is 'use metaclass' for Mouse
49 meta => [qw(does meta dump throw_error)],
53 our $VERSION = '0.95';
55 my $xs = !(defined(&is_valid_class_name) || $ENV{MOUSE_PUREPERL} || $ENV{PERL_ONLY});
57 # Because Mouse::Util is loaded first in all the Mouse sub-modules,
58 # XSLoader must be placed here, not in Mouse.pm.
60 # XXX: XSLoader tries to get the object path from caller's file name
61 # $hack_mouse_file fools its mechanism
62 (my $hack_mouse_file = __FILE__) =~ s/.Util//; # .../Mouse/Util.pm -> .../Mouse.pm
63 $xs = eval sprintf("#line %d %s\n", __LINE__, $hack_mouse_file) . q{
64 local $^W = 0; # workaround 'redefine' warning to &install_subroutines
66 XSLoader::load('Mouse', $VERSION);
67 Mouse::Util->import({ into => 'Mouse::Meta::Method::Constructor::XS' }, ':meta');
68 Mouse::Util->import({ into => 'Mouse::Meta::Method::Destructor::XS' }, ':meta');
69 Mouse::Util->import({ into => 'Mouse::Meta::Method::Accessor::XS' }, ':meta');
72 warn $@ if $@ && $ENV{MOUSE_XS};
76 require 'Mouse/PurePerl.pm'; # we don't want to create its namespace
79 *MOUSE_XS = sub(){ $xs };
81 # definition of mro::get_linear_isa()
83 if ($] >= 5.010_000) {
85 $get_linear_isa = \&mro::get_linear_isa;
88 # this code is based on MRO::Compat::__get_linear_isa
89 my $_get_linear_isa_dfs; # this recurses so it isn't pretty
90 $_get_linear_isa_dfs = sub {
93 my @lin = ($classname);
97 foreach my $parent (@{"$classname\::ISA"}) {
98 foreach my $p(@{ $_get_linear_isa_dfs->($parent) }) {
99 next if exists $stored{$p};
108 package # hide from PAUSE
110 our %MRO; # avoid 'once' warnings
113 # MRO::Compat::__get_linear_isa has no prototype, so
114 # we define a prototyped version for compatibility with core's
115 # See also MRO::Compat::__get_linear_isa.
116 $get_linear_isa = sub ($;$){
117 my($classname, $type) = @_;
120 $type = exists $Class::C3::MRO{$classname} ? 'c3' : 'dfs';
124 return [Class::C3::calculateMRO($classname)];
127 return $_get_linear_isa_dfs->($classname);
132 *get_linear_isa = $get_linear_isa;
138 # aliases as public APIs
139 # it must be 'require', not 'use', because Mouse::Meta::Module depends on Mouse::Util
140 require Mouse::Meta::Module; # for the entities of metaclass cache utilities
144 *class_of = \&Mouse::Meta::Module::_class_of;
145 *get_metaclass_by_name = \&Mouse::Meta::Module::_get_metaclass_by_name;
146 *get_all_metaclass_instances = \&Mouse::Meta::Module::_get_all_metaclass_instances;
147 *get_all_metaclass_names = \&Mouse::Meta::Module::_get_all_metaclass_names;
149 *Mouse::load_class = \&load_class;
150 *Mouse::is_class_loaded = \&is_class_loaded;
153 #generate_isa_predicate_for('Mouse::Meta::TypeConstraint' => 'is_a_type_constraint');
154 #generate_isa_predicate_for('Mouse::Meta::Class' => 'is_a_metaclass');
155 #generate_isa_predicate_for('Mouse::Meta::Role' => 'is_a_metarole');
157 # duck type predicates
158 generate_can_predicate_for(['_compiled_type_constraint'] => 'is_a_type_constraint');
159 generate_can_predicate_for(['create_anon_class'] => 'is_a_metaclass');
160 generate_can_predicate_for(['create_anon_role'] => 'is_a_metarole');
163 our $in_global_destruction = 0;
164 END{ $in_global_destruction = 1 }
166 # Moose::Util compatible utilities
169 return class_of( $_[0] );
172 sub _does_role_impl {
173 my ($class_or_obj, $role_name) = @_;
175 my $meta = class_of($class_or_obj);
178 || ($meta || 'Mouse::Meta::Class')->throw_error("You must supply a role name to does()");
180 return defined($meta) && $meta->does_role($role_name);
184 my($thing, $role_name) = @_;
186 if( (Scalar::Util::blessed($thing) || is_class_loaded($thing))
187 && $thing->can('does')) {
188 return $thing->does($role_name);
190 goto &_does_role_impl;
193 # taken from Mouse::Util (0.90)
197 sub resolve_metaclass_alias {
198 my ( $type, $metaclass_name, %options ) = @_;
200 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
202 return $cache{$cache_key}{$metaclass_name} ||= do{
204 my $possible_full_name = join '::',
205 'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name
208 my $loaded_class = load_first_existing_class(
213 $loaded_class->can('register_implementation')
214 ? $loaded_class->register_implementation
220 # Utilities from Class::MOP
223 sub get_code_package;
225 sub is_valid_class_name;
228 # taken from Class/MOP.pm
229 sub load_first_existing_class {
234 for my $class (@classes) {
235 my $e = _try_load_one_class($class);
238 $exceptions{$class} = $e;
249 sprintf( "Could not load class (%s) because : %s",
250 $_, $exceptions{$_} )
255 # taken from Class/MOP.pm
256 sub _try_load_one_class {
259 unless ( is_valid_class_name($class) ) {
260 my $display = defined($class) ? $class : 'undef';
261 Carp::confess "Invalid class name ($display)";
264 return '' if is_class_loaded($class);
271 eval { require $class };
279 my $e = _try_load_one_class($class);
280 Carp::confess "Could not load class ($class) because : $e" if $e;
286 sub apply_all_roles {
287 my $consumer = Scalar::Util::blessed($_[0])
289 : Mouse::Meta::Class->initialize($_[0]); # class or role name
293 # Basis of Data::OptList
294 my $max = scalar(@_);
295 for (my $i = 1; $i < $max ; $i++) {
299 $role_name = $role->name;
303 load_class($role_name);
304 $role = get_metaclass_by_name($role_name);
307 if ($i + 1 < $max && ref($_[$i + 1]) eq 'HASH') {
308 push @roles, [ $role => $_[++$i] ];
310 push @roles, [ $role => undef ];
313 || $consumer->meta->throw_error("You can only consume roles, $role_name is not a Mouse role");
316 if ( scalar @roles == 1 ) {
317 my ( $role, $params ) = @{ $roles[0] };
318 $role->apply( $consumer, defined $params ? $params : () );
321 Mouse::Meta::Role->combine(@roles)->apply($consumer);
326 # taken from Moose::Util 0.90
328 return $_[0] if @_ == 1;
332 return "$items[0] and $items[1]" if @items == 2;
334 my $tail = pop @items;
336 return join q{, }, @items, "and $tail";
339 sub quoted_english_list {
340 return english_list(map { qq{'$_'} } @_);
348 $feature ||= ( caller(1) )[3] . '()'; # subroutine name
350 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
351 Carp::confess("Mouse does not currently support $feature");
354 # general meta() method
356 return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]);
359 # general throw_error() method
360 # $o->throw_error($msg, depth => $leve, longmess => $croak_or_confess)
361 sub throw_error :method {
362 my($self, $message, %args) = @_;
364 local $Carp::CarpLevel = $Carp::CarpLevel + 1 + ($args{depth} || 0);
365 local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though
367 if(exists $args{longmess} && !$args{longmess}) {
368 Carp::croak($message);
371 Carp::confess($message);
375 # general dump() method
377 my($self, $maxdepth) = @_;
379 require 'Data/Dumper.pm'; # we don't want to create its namespace
380 my $dd = Data::Dumper->new([$self]);
381 $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 3);
388 # general does() method
390 goto &_does_role_impl;
398 Mouse::Util - Utilities for working with Mouse classes
402 This document describes Mouse version 0.95
406 use Mouse::Util; # turns on strict and warnings
410 This module provides a set of utility functions. Many of these
411 functions are intended for use in Mouse itself or MouseX modules, but
412 some of them may be useful for use in your own code.
414 =head1 IMPLEMENTATIONS FOR
416 =head2 Moose::Util functions
418 The following functions are exportable.
420 =head3 C<find_meta($class_or_obj)>
422 The same as C<Mouse::Util::class_of()>.
424 =head3 C<does_role($class_or_obj, $role_or_obj)>
426 =head3 C<resolve_metaclass_alias($category, $name, %options)>
428 =head3 C<apply_all_roles($applicant, @roles)>
430 =head3 C<english_listi(@items)>
432 =head2 Class::MOP functions
434 The following functions are not exportable.
436 =head3 C<< Mouse::Util::is_class_loaded($classname) -> Bool >>
438 Returns whether I<$classname> is actually loaded or not.
439 It uses a heuristic which involves checking for the existence of
440 C<$VERSION>, C<@ISA>, and any locally-defined method.
442 =head3 C<< Mouse::Util::load_class($classname) -> ClassName >>
444 This will load a given I<$classname> (or die if it is not loadable).
445 This function can be used in place of tricks like
446 C<eval "use $module ()"> or using C<require>.
448 =head3 C<< Mouse::Util::class_of($classname_or_object) -> MetaClass >>
450 =head3 C<< Mouse::Util::get_metaclass_by_name($classname) -> MetaClass >>
452 =head3 C<< Mouse::Util::get_all_metaclass_instances() -> (MetaClasses) >>
454 =head3 C<< Mouse::Util::get_all_metaclass_names() -> (ClassNames) >>
456 =head2 mro (or MRO::Compat)
458 =head3 C<get_linear_isa>
462 =head3 C<get_code_info>
464 =head1 Mouse specific utilities
466 =head3 C<not_supported>
468 =head3 C<get_code_package>
470 =head3 C<get_code_ref>