return $predicate;
}
+sub generate_can_predicate_for {
+ my($methods_ref, $name) = @_;
+
+ my @methods = @{$methods_ref};
+
+ my $predicate = sub{
+ my($instance) = @_;
+ if(Scalar::Util::blessed($instance)){
+ foreach my $method(@methods){
+ if(!$instance->can($method)){
+ return 0;
+ }
+ }
+ return 1;
+ }
+ return 0;
+ };
+
+ if(defined $name){
+ no strict 'refs';
+ *{ caller() . '::' . $name } = $predicate;
+ return;
+ }
+
+ return $predicate;
+}
package
Mouse::Util::TypeConstraints;
return;
}
-my %SIGIL_MAP = (
- '$' => 'SCALAR',
- '@' => 'ARRAY',
- '%' => 'HASH',
- '&' => 'CODE',
- '*' => 'GLOB',
-);
-
-sub _deconstruct_variable_name {
- my($self, $variable) = @_;
-
- (defined $variable)
- || $self->throw_error("You must pass a variable name");
-
- my $sigil = substr($variable, 0, 1, '');
-
- (defined $sigil)
- || $self->throw_error("The variable name must include a sigil");
-
- (exists $SIGIL_MAP{$sigil})
- || $self->throw_error("I do not recognize that sigil '$sigil'");
-
- return ($variable, $SIGIL_MAP{$sigil});
-}
-
-sub has_package_symbol {
- my($self, $variable) = @_;
-
- my($name, $type) = $self->_deconstruct_variable_name($variable);
-
- my $namespace = $self->namespace;
-
- return 0 unless exists $namespace->{$name};
-
- my $entry_ref = \$namespace->{$name};
- if ( ref($entry_ref) eq 'GLOB' ) {
- return defined( *{$entry_ref}{$type} );
- }
- else {
- # a symbol table entry can be -1 (stub), string (stub with prototype),
- # or reference (constant)
- return $type eq 'CODE';
- }
-}
-
-sub get_package_symbol {
- my ($self, $variable) = @_;
-
- my($name, $type) = $self->_deconstruct_variable_name($variable);
-
- my $namespace = $self->namespace;
-
- return undef
- unless exists $namespace->{$name};
-
- my $entry_ref = \$namespace->{$name};
-
- if ( ref($entry_ref) eq 'GLOB' ) {
- return *{$entry_ref}{$type};
- }
- else {
- if ( $type eq 'CODE' ) {
- no strict 'refs';
- return \&{ $self->name . '::' . $name };
- }
- else {
- return undef;
- }
- }
-}
-
-
package
Mouse::Meta::Class;
return;
}
+sub is_immutable { $_[0]->{is_immutable} }
package
Mouse::Meta::Role;
die $e if $e; # rethrow
}
+sub BUILDALL {
+ my $self = shift;
+
+ # short circuit
+ return unless $self->can('BUILD');
+
+ for my $class (reverse $self->meta->linearized_isa) {
+ my $build = Mouse::Util::get_code_ref($class, 'BUILD')
+ || next;
+
+ $self->$build(@_);
+ }
+ return;
+}
+
+sub DEMOLISHALL;
+*DEMOLISHALL = \&DESTROY;
+
1;
__END__
=head1 VERSION
-This document describes Mouse version 0.40_09
+This document describes Mouse version 0.4501
=head1 SEE ALSO