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;
-sub constructor_class() { 'Mouse::Meta::Method::Constructor' }
+sub method_metaclass { $_[0]->{method_metaclass} || 'Mouse::Meta::Method' }
+sub attribute_metaclass { $_[0]->{attribute_metaclass} || 'Mouse::Meta::Attribute' }
+
+sub constructor_class { $_[0]->{constructor_class} || 'Mouse::Meta::Method::Constructor' }
+sub destructor_class { $_[0]->{destructor_class} || 'Mouse::Meta::Method::Destructor' }
sub is_anon_class{
return exists $_[0]->{anon_serial_id};
return values %attrs;
}
+sub new_object {
+ my $self = shift;
+ my %args = (@_ == 1 ? %{$_[0]} : @_);
+
+ my $object = bless {}, $self->name;
+
+ $self->_initialize_object($object, \%args);
+ return $object;
+}
+
sub _initialize_object{
my($self, $object, $args, $ignore_triggers) = @_;
package
Mouse::Meta::Role;
+sub method_metaclass{ $_[0]->{method_metaclass} || 'Mouse::Meta::Role::Method' }
+
sub is_anon_role{
return exists $_[0]->{anon_serial_id};
}
package
Mouse::Meta::Attribute;
-use Mouse::Meta::Method::Accessor;
+require Mouse::Meta::Method::Accessor;
+
+sub accessor_metaclass{ $_[0]->{accessor_metaclass} || 'Mouse::Meta::Method::Accessor' }
# readers
sub has_documentation { exists $_[0]->{documentation} }
-sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' }
-
package
Mouse::Meta::TypeConstraint;
}
}
+sub new {
+ my $class = shift;
+
+ $class->meta->throw_error('Cannot call new() on an instance') if ref $class;
+
+ my $args = $class->BUILDARGS(@_);
+
+ my $meta = Mouse::Meta::Class->initialize($class);
+ my $self = $meta->new_object($args);
+
+ # BUILDALL
+ if( $self->can('BUILD') ) {
+ for my $class (reverse $meta->linearized_isa) {
+ my $build = Mouse::Util::get_code_ref($class, 'BUILD')
+ || next;
+
+ $self->$build($args);
+ }
+ }
+
+ return $self;
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ return unless $self->can('DEMOLISH'); # short circuit
+
+ local $?;
+
+ my $e = do{
+ local $@;
+ eval{
+
+ # DEMOLISHALL
+
+ # We cannot count on being able to retrieve a previously made
+ # metaclass, _or_ being able to make a new one during global
+ # destruction. However, we should still be able to use mro at
+ # that time (at least tests suggest so ;)
+
+ foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) {
+ my $demolish = Mouse::Util::get_code_ref($class, 'DEMOLISH')
+ || next;
+
+ $self->$demolish();
+ }
+ };
+ $@;
+ };
+
+ no warnings 'misc';
+ die $e if $e; # rethrow
+}
+
1;
__END__
=head1 VERSION
-This document describes Mouse version 0.40_05
+This document describes Mouse version 0.40_08
=head1 SEE ALSO