From: Yuval Kogman Date: Wed, 13 Aug 2008 21:48:49 +0000 (+0000) Subject: use hash refs with _new X-Git-Tag: 0_64_01~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0bfc85b88523ddd75e0868d6ec1244f4365bda07;p=gitmo%2FClass-MOP.git use hash refs with _new --- diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index d7df895..7d9856c 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -55,26 +55,27 @@ sub new { } 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: diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index fa2c920..2ac726e 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -54,8 +54,8 @@ sub reinitialize { # 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: @@ -82,14 +82,14 @@ sub construct_class_instance { 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 @@ -106,10 +106,12 @@ sub construct_class_instance { } 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 @@ -128,9 +130,9 @@ sub _new { '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; } @@ -372,11 +374,12 @@ sub new_object { } 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 diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm index 2318346..0ddc75a 100644 --- a/lib/Class/MOP/Immutable.pm +++ b/lib/Class/MOP/Immutable.pm @@ -31,12 +31,11 @@ sub new { $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 @@ -47,6 +46,13 @@ sub new { 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'} } diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index ab56ffc..ecf7cc4 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -42,7 +42,7 @@ sub wrap { ($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}; @@ -50,13 +50,14 @@ sub wrap { } 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; } diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index f882ae5..d4c7de6 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/lib/Class/MOP/Method/Accessor.pm @@ -28,7 +28,7 @@ sub new { ($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 @@ -41,11 +41,12 @@ sub new { } 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 diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm index df1d5c2..966731e 100644 --- a/lib/Class/MOP/Method/Constructor.pm +++ b/lib/Class/MOP/Method/Constructor.pm @@ -23,7 +23,7 @@ sub new { ($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 @@ -36,17 +36,18 @@ sub new { } 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; } diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm index 61ae408..87d8698 100644 --- a/lib/Class/MOP/Method/Generated.pm +++ b/lib/Class/MOP/Method/Generated.pm @@ -18,7 +18,7 @@ sub new { ($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; @@ -26,12 +26,13 @@ sub new { } 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 diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 10c4622..5b42565 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -19,25 +19,25 @@ sub initialize { 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