From: Peter Rabbitson Date: Thu, 13 Dec 2012 06:40:13 +0000 (+0100) Subject: Fix some pessimizations spotted here and there (no functional changes) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4b8a53eabdb1629bacdb95f04ca8fc3718ca7c58;p=dbsrgits%2FDBIx-Class-Historic.git Fix some pessimizations spotted here and there (no functional changes) Mainly remove a number of unused @_ unpackings, and remove the hideous _resolved_attrs_copy pessimizer --- diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 731ed23..5338cb6 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -587,8 +587,7 @@ current result or where conditions. =cut sub count_related { - my $self = shift; - return $self->search_related(@_)->count; + shift->search_related(@_)->count; } =head2 new_related @@ -685,9 +684,8 @@ See L for details. =cut sub find_related { - my $self = shift; - my $rel = shift; - return $self->search_related($rel)->find(@_); + #my ($self, $rel, @args) = @_; + return shift->search_related(shift)->find(@_); } =head2 find_or_new_related @@ -748,9 +746,8 @@ L for details. =cut sub update_or_create_related { - my $self = shift; - my $rel = shift; - return $self->related_resultset($rel)->update_or_create(@_); + #my ($self, $rel, @args) = @_; + shift->related_resultset(shift)->update_or_create(@_); } =head2 set_from_related diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 023eab3..3cc24b1 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -988,13 +988,14 @@ L for more information. =cut sub cursor { - my ($self) = @_; - - my $attrs = $self->_resolved_attrs_copy; + my $self = shift; - return $self->{cursor} - ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select}, - $attrs->{where},$attrs); + return $self->{cursor} ||= do { + my $attrs = { %{$self->_resolved_attrs } }; + $self->result_source->storage->select( + $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs + ); + }; } =head2 single @@ -1046,7 +1047,7 @@ sub single { $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()'); } - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{$self->_resolved_attrs} }; if (keys %{$attrs->{collapse}}) { $self->throw_exception( @@ -1455,7 +1456,7 @@ sub count { return $self->search(@_)->count if @_ and defined $_[0]; return scalar @{ $self->get_cache } if $self->get_cache; - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{ $self->_resolved_attrs } }; # this is a little optimization - it is faster to do the limit # adjustments in software, instead of a subquery @@ -2111,10 +2112,7 @@ sub populate { return unless @$data; if(defined wantarray) { - my @created; - foreach my $item (@$data) { - push(@created, $self->create($item)); - } + my @created = map { $self->create($_) } @$data; return wantarray ? @created : \@created; } else { @@ -2523,7 +2521,7 @@ This is generally used as the RHS for a subquery. sub as_query { my $self = shift; - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{ $self->_resolved_attrs } }; # For future use: # @@ -3105,9 +3103,7 @@ source alias of the current result set: =cut sub current_source_alias { - my ($self) = @_; - - return ($self->{attrs} || {})->{alias} || 'me'; + return (shift->{attrs} || {})->{alias} || 'me'; } =head2 as_subselect_rs @@ -3289,12 +3285,6 @@ sub _chain_relationship { return {%$attrs, from => $from, seen_join => $seen}; } -# too many times we have to do $attrs = { %{$self->_resolved_attrs} } -sub _resolved_attrs_copy { - my $self = shift; - return { %{$self->_resolved_attrs (@_)} }; -} - sub _resolved_attrs { my $self = shift; return $self->{_attrs} if $self->{_attrs}; diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index fe82fac..7dfb688 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -1367,8 +1367,8 @@ name. The keys/values are as specified for L_relationships->{$rel}; + #my ($self, $rel) = @_; + return shift->_relationships->{+shift}; } =head2 has_relationship @@ -1386,8 +1386,8 @@ Returns true if the source has a relationship of this name, false otherwise. =cut sub has_relationship { - my ($self, $rel) = @_; - return exists $self->_relationships->{$rel}; + #my ($self, $rel) = @_; + return exists shift->_relationships->{+shift}; } =head2 reverse_relationship_info diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 0d49b4b..6fca48e 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -618,8 +618,7 @@ Retrieves the Result class name for the given source name. =cut sub class { - my ($self, $source_name) = @_; - return $self->source($source_name)->result_class; + return shift->source(shift)->result_class; } =head2 txn_do @@ -770,15 +769,10 @@ those values. sub populate { my ($self, $name, $data) = @_; - if(my $rs = $self->resultset($name)) { - if(defined wantarray) { - return $rs->populate($data); - } else { - $rs->populate($data); - } - } else { - $self->throw_exception("$name is not a resultset"); - } + my $rs = $self->resultset($name) + or $self->throw_exception("'$name' is not a resultset"); + + return $rs->populate($data); } =head2 connection diff --git a/lib/DBIx/Class/Storage/DBI/Informix.pm b/lib/DBIx/Class/Storage/DBI/Informix.pm index db953d4..ca6bf55 100644 --- a/lib/DBIx/Class/Storage/DBI/Informix.pm +++ b/lib/DBIx/Class/Storage/DBI/Informix.pm @@ -32,7 +32,6 @@ This class implements storage-specific support for the Informix RDBMS sub _execute { my $self = shift; - my ($op) = @_; my ($rv, $sth, @rest) = $self->next::method(@_); $self->__last_insert_id($sth->{ix_sqlerrd}[1]) diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index b20db9f..30b66fe 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -69,7 +69,6 @@ sub _prep_for_execute { sub _execute { my $self = shift; - my ($op) = @_; # always list ctx - we need the $sth my ($rv, $sth, @bind) = $self->next::method(@_); diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index c107934..dc5df6f 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -284,9 +284,10 @@ sub _ping { } sub _dbh_execute { - my ($self, $dbh, $sql, $bind) = @_; + #my ($self, $dbh, $sql, $bind, $ident) = @_; + my ($self, $bind) = @_[0,3]; - # Turn off sth caching for multi-part LOBs. See _prep_for_execute above. + # Turn off sth caching for multi-part LOBs. See _prep_for_execute below local $self->{disable_sth_caching} = 1 if first { ($_->[0]{_ora_lob_autosplit_part}||0) > diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm index 8d1419f..346dcd9 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm @@ -255,7 +255,7 @@ sub _is_lob_column { sub _prep_for_execute { my $self = shift; - my ($op, $ident) = @_; + my $ident = $_[1]; # ### This is commented out because all tests pass. However I am leaving it @@ -263,6 +263,8 @@ sub _prep_for_execute { ### BTW it doesn't currently work exactly - need better sensitivity to # currently set value # + #my ($op, $ident) = @_; + # # inherit these from the parent for the duration of _prep_for_execute # Don't know how to make a localizing loop with if's, otherwise I would #local $self->{_autoinc_supplied_for_op} @@ -322,8 +324,6 @@ sub _native_data_type { sub _execute { my $self = shift; - my ($op) = @_; - my ($rv, $sth, @bind) = $self->next::method(@_); $self->_identity( ($sth->fetchall_arrayref)->[0][0] )