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.94';
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] );
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);
183 # taken from Mouse::Util (0.90)
187 sub resolve_metaclass_alias {
188 my ( $type, $metaclass_name, %options ) = @_;
190 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
192 return $cache{$cache_key}{$metaclass_name} ||= do{
194 my $possible_full_name = join '::',
195 'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name
198 my $loaded_class = load_first_existing_class(
203 $loaded_class->can('register_implementation')
204 ? $loaded_class->register_implementation
210 # Utilities from Class::MOP
213 sub get_code_package;
215 sub is_valid_class_name;
218 # taken from Class/MOP.pm
219 sub load_first_existing_class {
224 for my $class (@classes) {
225 my $e = _try_load_one_class($class);
228 $exceptions{$class} = $e;
239 sprintf( "Could not load class (%s) because : %s",
240 $_, $exceptions{$_} )
245 # taken from Class/MOP.pm
246 sub _try_load_one_class {
249 unless ( is_valid_class_name($class) ) {
250 my $display = defined($class) ? $class : 'undef';
251 Carp::confess "Invalid class name ($display)";
254 return '' if is_class_loaded($class);
261 eval { require $class };
269 my $e = _try_load_one_class($class);
270 Carp::confess "Could not load class ($class) because : $e" if $e;
276 sub apply_all_roles {
277 my $consumer = Scalar::Util::blessed($_[0])
279 : Mouse::Meta::Class->initialize($_[0]); # class or role name
283 # Basis of Data::OptList
284 my $max = scalar(@_);
285 for (my $i = 1; $i < $max ; $i++) {
289 $role_name = $role->name;
293 load_class($role_name);
294 $role = get_metaclass_by_name($role_name);
297 if ($i + 1 < $max && ref($_[$i + 1]) eq 'HASH') {
298 push @roles, [ $role => $_[++$i] ];
300 push @roles, [ $role => undef ];
303 || $consumer->meta->throw_error("You can only consume roles, $role_name is not a Mouse role");
306 if ( scalar @roles == 1 ) {
307 my ( $role, $params ) = @{ $roles[0] };
308 $role->apply( $consumer, defined $params ? $params : () );
311 Mouse::Meta::Role->combine(@roles)->apply($consumer);
316 # taken from Moose::Util 0.90
318 return $_[0] if @_ == 1;
322 return "$items[0] and $items[1]" if @items == 2;
324 my $tail = pop @items;
326 return join q{, }, @items, "and $tail";
329 sub quoted_english_list {
330 return english_list(map { qq{'$_'} } @_);
338 $feature ||= ( caller(1) )[3] . '()'; # subroutine name
340 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
341 Carp::confess("Mouse does not currently support $feature");
344 # general meta() method
346 return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]);
349 # general throw_error() method
350 # $o->throw_error($msg, depth => $leve, longmess => $croak_or_confess)
351 sub throw_error :method {
352 my($self, $message, %args) = @_;
354 local $Carp::CarpLevel = $Carp::CarpLevel + 1 + ($args{depth} || 0);
355 local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though
357 if(exists $args{longmess} && !$args{longmess}) {
358 Carp::croak($message);
361 Carp::confess($message);
365 # general dump() method
367 my($self, $maxdepth) = @_;
369 require 'Data/Dumper.pm'; # we don't want to create its namespace
370 my $dd = Data::Dumper->new([$self]);
371 $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 3);
378 # general does() method
388 Mouse::Util - Utilities for working with Mouse classes
392 This document describes Mouse version 0.94
396 use Mouse::Util; # turns on strict and warnings
400 This module provides a set of utility functions. Many of these
401 functions are intended for use in Mouse itself or MouseX modules, but
402 some of them may be useful for use in your own code.
404 =head1 IMPLEMENTATIONS FOR
406 =head2 Moose::Util functions
408 The following functions are exportable.
410 =head3 C<find_meta($class_or_obj)>
412 The same as C<Mouse::Util::class_of()>.
414 =head3 C<does_role($class_or_obj, $role_or_obj)>
416 =head3 C<resolve_metaclass_alias($category, $name, %options)>
418 =head3 C<apply_all_roles($applicant, @roles)>
420 =head3 C<english_listi(@items)>
422 =head2 Class::MOP functions
424 The following functions are not exportable.
426 =head3 C<< Mouse::Util::is_class_loaded($classname) -> Bool >>
428 Returns whether I<$classname> is actually loaded or not.
429 It uses a heuristic which involves checking for the existence of
430 C<$VERSION>, C<@ISA>, and any locally-defined method.
432 =head3 C<< Mouse::Util::load_class($classname) -> ClassName >>
434 This will load a given I<$classname> (or die if it is not loadable).
435 This function can be used in place of tricks like
436 C<eval "use $module ()"> or using C<require>.
438 =head3 C<< Mouse::Util::class_of($classname_or_object) -> MetaClass >>
440 =head3 C<< Mouse::Util::get_metaclass_by_name($classname) -> MetaClass >>
442 =head3 C<< Mouse::Util::get_all_metaclass_instances() -> (MetaClasses) >>
444 =head3 C<< Mouse::Util::get_all_metaclass_names() -> (ClassNames) >>
446 =head2 mro (or MRO::Compat)
448 =head3 C<get_linear_isa>
452 =head3 C<get_code_info>
454 =head1 Mouse specific utilities
456 =head3 C<not_supported>
458 =head3 C<get_code_package>
460 =head3 C<get_code_ref>