From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 24 Mar 2013 07:28:53 +0000 (+0100)
Subject: 9 years of perl and I somehow did not know that...
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d77ee505c77d14a8a89cf356a014e7fbdc4e3967;p=dbsrgits%2FDBIx-Class-Historic.git

9 years of perl and I somehow did not know that...
---

diff --git a/Changes b/Changes
index 59ec224..3863adf 100644
--- a/Changes
+++ b/Changes
@@ -4,6 +4,10 @@ Revision history for DBIx::Class
         - Officially deprecate the 'cols' and 'include_columns' resultset
           attributes
 
+    * Fixes
+        - Audit and correct potential bugs associated with braindead reuse
+          of $1 on unsuccessful matches
+
 0.08209 2013-03-01 12:56 (UTC)
     * New Features / Changes
         - Debugging aid - warn on invalid result objects created by what
diff --git a/lib/DBIx/Class/CDBICompat/Constraints.pm b/lib/DBIx/Class/CDBICompat/Constraints.pm
index bc44462..1014886 100644
--- a/lib/DBIx/Class/CDBICompat/Constraints.pm
+++ b/lib/DBIx/Class/CDBICompat/Constraints.pm
@@ -16,7 +16,7 @@ sub constrain_column {
   } elsif (ref $how eq "Regexp") {
     $class->add_constraint(regexp => $col => sub { shift =~ $how });
   } else {
-    $how =~ m/([^:]+)$/;
+    $how =~ m/([^:]+)$/; # match is safe - we throw above on empty $how
     my $try_method = sprintf '_constrain_by_%s', lc $1; # $how->moniker;
     if (my $dispatch = $class->can($try_method)) {
       $class->$dispatch($col => ($how, @_));
diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm
index 16fa0ba..c9d1777 100644
--- a/lib/DBIx/Class/Relationship/HasMany.pm
+++ b/lib/DBIx/Class/Relationship/HasMany.pm
@@ -36,7 +36,7 @@ sub has_many {
       $f_key = $cond;
       $guess = "caller specified foreign key '$f_key'";
     } else {
-      $class =~ /([^\:]+)$/;
+      $class =~ /([^\:]+)$/;  # match is safe - $class can't be ''
       $f_key = lc $1; # go ahead and guess; best we can do
       $guess = "using our class name '$class' as foreign key";
     }
diff --git a/lib/DBIx/Class/SQLMaker/LimitDialects.pm b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
index 7639988..2062021 100644
--- a/lib/DBIx/Class/SQLMaker/LimitDialects.pm
+++ b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
@@ -358,9 +358,12 @@ sub _prep_for_skimming_limit {
     for my $ch ($self->_order_by_chunks ($inner_order)) {
       $ch = $ch->[0] if ref $ch eq 'ARRAY';
 
-      $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix;
-      my $dir = uc ($1||'ASC');
-      push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' );
+      my $is_desc = (
+        $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix
+          and
+        uc($1) eq 'DESC'
+      ) ? 1 : 0;
+      push @out_chunks, \join (' ', $ch, $is_desc ? 'ASC' : 'DESC' );
     }
 
     $sq_attrs->{order_by_middle} = $self->_order_by (\@out_chunks);
@@ -569,8 +572,9 @@ sub _GenericSubQ {
   . 'unique-column order criteria.'
   );
 
-  $first_order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix;
-  my $direction = lc ($1 || 'asc');
+  my $direction = (
+    $first_order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix
+  ) ? lc($1) : 'asc';
 
   my ($first_ord_alias, $first_ord_col) = $first_order_by =~ /^ (?: ([^\.]+) \. )? ([^\.]+) $/x;
 
diff --git a/lib/DBIx/Class/Storage/DBI/Firebird/Common.pm b/lib/DBIx/Class/Storage/DBI/Firebird/Common.pm
index 8b7e2a3..4676fc4 100644
--- a/lib/DBIx/Class/Storage/DBI/Firebird/Common.pm
+++ b/lib/DBIx/Class/Storage/DBI/Firebird/Common.pm
@@ -60,9 +60,10 @@ EOF
   $sth->execute($table_name);
 
   while (my ($trigger) = $sth->fetchrow_array) {
-    my @trig_cols = map {
-      /^"([^"]+)/ ? $1 : uc($1)
-    } $trigger =~ /new\.("?\w+"?)/ig;
+    my @trig_cols = map
+      { /^"([^"]+)/ ? $1 : uc($_) }
+      $trigger =~ /new\.("?\w+"?)/ig
+    ;
 
     my ($quoted, $generator) = $trigger =~
 /(?:gen_id\s* \( \s* |next \s* value \s* for \s*)(")?(\w+)/ix;
diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index 3e59028..fcdab67 100644
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -104,7 +104,7 @@ sub _dbh_get_autoinc_seq {
     ));
   }
 
-  return $1;
+  return $1;  # exception thrown unless match is made above
 }
 
 # custom method for fetching column default, since column_info has a
diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm
index ae55f1f..3ace8e2 100644
--- a/lib/DBIx/Class/Storage/DBI/mysql.pm
+++ b/lib/DBIx/Class/Storage/DBI/mysql.pm
@@ -5,7 +5,6 @@ use warnings;
 
 use base qw/DBIx::Class::Storage::DBI/;
 
-use List::Util 'first';
 use namespace::clean;
 
 __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MySQL');
@@ -69,7 +68,7 @@ sub _prep_for_execute {
     ) {
       # this is just a plain-ish name, which has been literal-ed for
       # whatever reason
-      $target_name = first { defined $_ } ($1, $2);
+      $target_name = (defined $1) ? $1 : $2;
     }
     else {
       # this is something very complex, perhaps a custom result source or whatnot