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 (file)
--- 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<DBIx::Class::ResultSet/find> 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<DBIx::Class::ResultSet/update_or_create> 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 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -988,13 +988,14 @@ L<DBIx::Class::Cursor> 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 (file)
--- 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<DBIx::Class::Relationship::Base/add
 =cut
 
 sub relationship_info {
-  my ($self, $rel) = @_;
-  return $self->_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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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] )