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.90';
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 (eval { require mro }) {
84 $get_linear_isa = \&mro::get_linear_isa;
87 # this code is based on MRO::Compat::__get_linear_isa
88 my $_get_linear_isa_dfs; # this recurses so it isn't pretty
89 $_get_linear_isa_dfs = sub {
92 my @lin = ($classname);
96 foreach my $parent (@{"$classname\::ISA"}) {
97 foreach my $p(@{ $_get_linear_isa_dfs->($parent) }) {
98 next if exists $stored{$p};
107 package # hide from PAUSE
109 our %MRO; # avoid 'once' warnings
112 # MRO::Compat::__get_linear_isa has no prototype, so
113 # we define a prototyped version for compatibility with core's
114 # See also MRO::Compat::__get_linear_isa.
115 $get_linear_isa = sub ($;$){
116 my($classname, $type) = @_;
119 $type = exists $Class::C3::MRO{$classname} ? 'c3' : 'dfs';
123 return [Class::C3::calculateMRO($classname)];
126 return $_get_linear_isa_dfs->($classname);
131 *get_linear_isa = $get_linear_isa;
137 # aliases as public APIs
138 # it must be 'require', not 'use', because Mouse::Meta::Module depends on Mouse::Util
139 require Mouse::Meta::Module; # for the entities of metaclass cache utilities
143 *class_of = \&Mouse::Meta::Module::_class_of;
144 *get_metaclass_by_name = \&Mouse::Meta::Module::_get_metaclass_by_name;
145 *get_all_metaclass_instances = \&Mouse::Meta::Module::_get_all_metaclass_instances;
146 *get_all_metaclass_names = \&Mouse::Meta::Module::_get_all_metaclass_names;
148 *Mouse::load_class = \&load_class;
149 *Mouse::is_class_loaded = \&is_class_loaded;
152 #generate_isa_predicate_for('Mouse::Meta::TypeConstraint' => 'is_a_type_constraint');
153 #generate_isa_predicate_for('Mouse::Meta::Class' => 'is_a_metaclass');
154 #generate_isa_predicate_for('Mouse::Meta::Role' => 'is_a_metarole');
156 # duck type predicates
157 generate_can_predicate_for(['_compiled_type_constraint'] => 'is_a_type_constraint');
158 generate_can_predicate_for(['create_anon_class'] => 'is_a_metaclass');
159 generate_can_predicate_for(['create_anon_role'] => 'is_a_metarole');
162 our $in_global_destruction = 0;
163 END{ $in_global_destruction = 1 }
165 # Moose::Util compatible utilities
168 return class_of( $_[0] );
172 my ($class_or_obj, $role_name) = @_;
174 my $meta = class_of($class_or_obj);
177 || ($meta || 'Mouse::Meta::Class')->throw_error("You must supply a role name to does()");
179 return defined($meta) && $meta->does_role($role_name);
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;
217 # taken from Class/MOP.pm
218 sub load_first_existing_class {
223 for my $class (@classes) {
224 my $e = _try_load_one_class($class);
227 $exceptions{$class} = $e;
238 sprintf( "Could not load class (%s) because : %s",
239 $_, $exceptions{$_} )
244 # taken from Class/MOP.pm
245 sub _try_load_one_class {
248 unless ( is_valid_class_name($class) ) {
249 my $display = defined($class) ? $class : 'undef';
250 Carp::confess "Invalid class name ($display)";
253 return '' if is_class_loaded($class);
260 eval { require $class };
268 my $e = _try_load_one_class($class);
269 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.90
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) >>
445 =head2 mro (or MRO::Compat)
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>