}
sub _new {
- my ( $class, %options ) = @_;
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
bless {
- 'name' => $options{name},
- 'accessor' => $options{accessor},
- 'reader' => $options{reader},
- 'writer' => $options{writer},
- 'predicate' => $options{predicate},
- 'clearer' => $options{clearer},
- 'builder' => $options{builder},
- 'init_arg' => $options{init_arg},
- 'default' => $options{default},
- 'initializer' => $options{initializer},
+ 'name' => $options->{name},
+ 'accessor' => $options->{accessor},
+ 'reader' => $options->{reader},
+ 'writer' => $options->{writer},
+ 'predicate' => $options->{predicate},
+ 'clearer' => $options->{clearer},
+ 'builder' => $options->{builder},
+ 'init_arg' => $options->{init_arg},
+ 'default' => $options->{default},
+ 'initializer' => $options->{initializer},
# keep a weakened link to the
# class we are associated with
'associated_class' => undef,
# and a list of the methods
# associated with this attr
'associated_methods' => [],
- } => $class;
+ }, $class;
}
# NOTE:
# normal &construct_instance.
sub construct_class_instance {
my $class = shift;
- my %options = @_;
- my $package_name = $options{'package'};
+ my $options = @_ == 1 ? $_[0] : {@_};
+ my $package_name = $options->{package};
(defined $package_name && $package_name)
|| confess "You must pass a package name";
# NOTE:
my $meta;
if ($class eq 'Class::MOP::Class') {
no strict 'refs';
- $meta = $class->_new(%options)
+ $meta = $class->_new($options)
}
else {
# NOTE:
# it is safe to use meta here because
# class will always be a subclass of
# Class::MOP::Class, which defines meta
- $meta = $class->meta->construct_instance(%options)
+ $meta = $class->meta->construct_instance($options)
}
# and check the metaclass compatibility
}
sub _new {
- my ( $class, %options ) = @_;
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
+
bless {
# inherited from Class::MOP::Package
- 'package' => $options{package},
+ 'package' => $options->{package},
# NOTE:
# since the following attributes will
'methods' => {},
'attributes' => {},
- 'attribute_metaclass' => $options{'attribute_metaclass'} || 'Class::MOP::Attribute',
- 'method_metaclass' => $options{'method_metaclass'} || 'Class::MOP::Method',
- 'instance_metaclass' => $options{'instance_metaclass'} || 'Class::MOP::Instance',
+ 'attribute_metaclass' => $options->{'attribute_metaclass'} || 'Class::MOP::Attribute',
+ 'method_metaclass' => $options->{'method_metaclass'} || 'Class::MOP::Method',
+ 'instance_metaclass' => $options->{'instance_metaclass'} || 'Class::MOP::Instance',
}, $class;
}
}
sub construct_instance {
- my ($class, %params) = @_;
+ my $class = shift;
+ my $params = @_ == 1 ? $_[0] : {@_};
my $meta_instance = $class->get_meta_instance();
my $instance = $meta_instance->create_instance();
foreach my $attr ($class->compute_all_applicable_attributes()) {
- $attr->initialize_instance_slot($meta_instance, $instance, \%params);
+ $attr->initialize_instance_slot($meta_instance, $instance, $params);
}
# NOTE:
# this will only work for a HASH instance type
$metaclass = $options{metaclass};
}
- # FIXME make a proper constructor using ->meta->new_object
- my $self = bless {
+ my $self = $class->_new(
'metaclass' => $metaclass,
'options' => $options,
'immutable_metaclass' => undef,
- } => $class;
+ );
# NOTE:
# we initialize the immutable
return $self;
}
+sub _new {
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
+
+ bless $options, $class;
+}
+
sub immutable_metaclass { (shift)->{'immutable_metaclass'} }
sub metaclass { (shift)->{'metaclass'} }
sub options { (shift)->{'options'} }
($params{package_name} && $params{name})
|| confess "You must supply the package_name and name parameters $UPGRADE_ERROR_TEXT";
- my $self = (ref($class) || $class)->_new(%params);
+ my $self = (ref($class) || $class)->_new(\%params);
weaken($self->{associated_metaclass}) if $self->{associated_metaclass};
}
sub _new {
- my ( $class, %params ) = @_;
+ my $class = shift;
+ my $params = @_ == 1 ? $_[0] : {@_};
my $self = bless {
- 'body' => $params{body},
- 'associated_metaclass' => $params{associated_metaclass},
- 'package_name' => $params{package_name},
- 'name' => $params{name},
+ 'body' => $params->{body},
+ 'associated_metaclass' => $params->{associated_metaclass},
+ 'package_name' => $params->{package_name},
+ 'name' => $params->{name},
} => $class;
}
($options{package_name} && $options{name})
|| confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
- my $self = $class->_new(%options);
+ my $self = $class->_new(\%options);
# we don't want this creating
# a cycle in the code, if not
}
sub _new {
- my ( $class, %options ) = @_;
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
- $options{is_inline} ||= 0;
+ $options->{is_inline} ||= 0;
- return bless \%options, $class;
+ return bless $options, $class;
}
## accessors
($options{package_name} && $options{name})
|| confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
- my $self = $class->_new(%options);
+ my $self = $class->_new(\%options);
# we don't want this creating
# a cycle in the code, if not
}
sub _new {
- my ( $class, %options ) = @_;
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
bless {
# from our superclass
'body' => undef,
- 'package_name' => $options{package_name},
- 'name' => $options{name},
+ 'package_name' => $options->{package_name},
+ 'name' => $options->{name},
# specific to this subclass
- 'options' => $options{options} || {},
- 'associated_metaclass' => $options{metaclass},
- 'is_inline' => ($options{is_inline} || 0),
+ 'options' => $options->{options} || {},
+ 'associated_metaclass' => $options->{metaclass},
+ 'is_inline' => ($options->{is_inline} || 0),
}, $class;
}
($options{package_name} && $options{name})
|| confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
- my $self = $class->_new(%options);
+ my $self = $class->_new(\%options);
$self->initialize_body;
}
sub _new {
- my ( $class, %options ) = @_;
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
- $options{is_inline} ||= 0;
- $options{body} ||= undef;
+ $options->{is_inline} ||= 0;
+ $options->{body} ||= undef;
- bless \%options, $class;
+ bless $options, $class;
}
## accessors
my $package_name = shift;
# we hand-construct the class
# until we can bootstrap it
- $class->_new(
+ $class->_new({
'package' => $package_name,
- );
+ });
}
sub _new {
- my ( $class, @args ) = @_;
-
- bless {
- # NOTE:
- # because of issues with the Perl API
- # to the typeglob in some versions, we
- # need to just always grab a new
- # reference to the hash in the accessor.
- # Ideally we could just store a ref and
- # it would Just Work, but oh well :\
- 'namespace' => \undef,
- @args,
- }, $class;
+ my $class = shift;
+ my $options = @_ == 1 ? $_[0] : {@_};
+
+ # NOTE:
+ # because of issues with the Perl API
+ # to the typeglob in some versions, we
+ # need to just always grab a new
+ # reference to the hash in the accessor.
+ # Ideally we could just store a ref and
+ # it would Just Work, but oh well :\
+ $options->{namespace} ||= \undef;
+
+ bless $options, $class;
}
# Attributes
projects / gitmo/Class-MOP.git / commitdiff