[Bps-public-commit] dbix-searchbuilder branch, master, updated. 1.63-10-gddeb4e0

Thomas Sibley trs at bestpractical.com
Tue Mar 26 15:02:00 EDT 2013


The branch, master has been updated
       via  ddeb4e0aa9535cfb32aa78d9ad02b6c606148cdb (commit)
      from  e3fa6a140ed529f4d9bb713dfd0cb58beab44bf1 (commit)

Summary of changes:
 lib/DBIx/SearchBuilder.pm              |  5 ++--
 lib/DBIx/SearchBuilder/Handle.pm       | 22 ++++++++--------
 lib/DBIx/SearchBuilder/Handle/mysql.pm |  4 +--
 lib/DBIx/SearchBuilder/Record.pm       | 14 +++++-----
 lib/DBIx/SearchBuilder/Util.pm         | 47 ++++++++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+), 21 deletions(-)
 create mode 100644 lib/DBIx/SearchBuilder/Util.pm

- Log -----------------------------------------------------------------
commit ddeb4e0aa9535cfb32aa78d9ad02b6c606148cdb
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Mon Mar 25 17:01:19 2013 -0700

    Consistent query generation by sorting hash keys/values
    
    All uses of keys and values to build SQL queries are now sorted.
    Consistent queries given the same inputs are important for query caches
    which may require the query to match exactly, such as MySQL's
    implementation.  It also improves debuggability and aggregation when
    doing performance analysis by making it easier to find the same query
    across runs.

diff --git a/lib/DBIx/SearchBuilder.pm b/lib/DBIx/SearchBuilder.pm
index b5e700a..5bf8b43 100755
--- a/lib/DBIx/SearchBuilder.pm
+++ b/lib/DBIx/SearchBuilder.pm
@@ -9,6 +9,7 @@ our $VERSION = "1.63";
 use Clone qw();
 use Encode qw();
 use Scalar::Util qw(blessed);
+use DBIx::SearchBuilder::Util qw/ sorted_values /;
 
 =head1 NAME
 
@@ -1045,7 +1046,7 @@ sub _WhereClause {
     #Go through all restriction types. Build the where clause from the
     #Various subclauses.
     my $where_clause = '';
-    foreach my $subclause ( grep $_, values %{ $self->{'subclauses'} } ) {
+    foreach my $subclause ( grep $_, sorted_values($self->{'subclauses'}) ) {
         $where_clause .= " AND " if $where_clause;
         $where_clause .= $subclause;
     }
@@ -1063,7 +1064,7 @@ sub _CompileGenericRestrictions {
 
     my $result = '';
     #Go through all the restrictions of this type. Buld up the generic subclause
-    foreach my $restriction ( grep @$_, values %{ $self->{'restrictions'} } ) {
+    foreach my $restriction ( grep @$_, sorted_values($self->{'restrictions'}) ) {
         $result .= " AND " if $result;
         $result .= '(';
         foreach my $entry ( @$restriction ) {
diff --git a/lib/DBIx/SearchBuilder/Handle.pm b/lib/DBIx/SearchBuilder/Handle.pm
index ba0ddff..10c8e76 100755
--- a/lib/DBIx/SearchBuilder/Handle.pm
+++ b/lib/DBIx/SearchBuilder/Handle.pm
@@ -9,6 +9,8 @@ use DBI;
 use Class::ReturnValue;
 use Encode qw();
 
+use DBIx::SearchBuilder::Util qw/ sorted_values /;
+
 use vars qw(@ISA %DBIHandle $PrevHandle $DEBUG %TRANSDEPTH %FIELDS_IN_TABLE);
 
 
@@ -441,7 +443,7 @@ sub UpdateRecordValue {
 
   ## Constructs the where clause.
   my $where  = 'WHERE ';
-  foreach my $key (keys %{$args{'PrimaryKeys'}}) {
+  foreach my $key (sort keys %{$args{'PrimaryKeys'}}) {
      $where .= $key . "=?" . " AND ";
      push (@bind, $args{'PrimaryKeys'}{$key});
   }
@@ -494,9 +496,9 @@ sub SimpleUpdateFromSelect {
     my ($self, $table, $values, $query, @query_binds) = @_;
 
     my @columns; my @binds;
-    while ( my ($k, $v) = each %$values ) {
+    for my $k (sort keys %$values) {
         push @columns, $k;
-        push @binds, $v;
+        push @binds, $values->{$k};
     }
 
     my $full_query = "UPDATE $table SET ";
@@ -1043,7 +1045,7 @@ sub Join {
         push @{$args{SearchBuilder}{aliases}}, @{$collection->{aliases}};
 
         # Move over joins, as well
-        for my $join (keys %{$collection->{left_joins}}) {
+        for my $join (sort keys %{$collection->{left_joins}}) {
             my %alias = %{$collection->{left_joins}{$join}};
             $alias{depends_on} = $alias if $alias{depends_on} eq "main";
             $alias{criteria} = $self->_RenameRestriction(
@@ -1169,7 +1171,7 @@ sub _BuildJoins {
     while ( my @list =
         grep !$processed{ $_ }
             && (!$joins->{ $_ }{'depends_on'} || $processed{ $joins->{ $_ }{'depends_on'} }),
-        keys %$joins
+        sort keys %$joins
     ) {
         foreach my $join ( @list ) {
             $processed{ $join }++;
@@ -1183,7 +1185,7 @@ sub _BuildJoins {
                         $_->{'field'} .' '. $_->{'op'} .' '. $_->{'value'}:
                         $_
                 }
-                map { ('(', @$_, ')', $aggregator) } values %{ $meta->{'criteria'} };
+                map { ('(', @$_, ')', $aggregator) } sorted_values($meta->{'criteria'});
             pop @tmp;
             $join_clause .= join ' ', @tmp;
         }
@@ -1213,7 +1215,7 @@ sub OptimizeJoins {
     # finally we'll get ordered list with leafes in the beginning and top most nodes at
     # the end.
     while ( my @list = grep !$processed{ $_ }
-            && $processed{ $joins->{ $_ }{'depends_on'} }, keys %$joins )
+            && $processed{ $joins->{ $_ }{'depends_on'} }, sort keys %$joins )
     {
         unshift @ordered, @list;
         $processed{ $_ }++ foreach @list;
@@ -1253,19 +1255,19 @@ sub MayBeNull {
 
     # build full list of generic conditions
     my @conditions;
-    foreach ( grep @$_, values %{ $args{'SearchBuilder'}->{'restrictions'} } ) {
+    foreach ( grep @$_, sorted_values($args{'SearchBuilder'}->{'restrictions'}) ) {
         push @conditions, 'AND' if @conditions;
         push @conditions, '(', @$_, ')';
     }
 
     # find tables that depends on this alias and add their join conditions
-    foreach my $join ( values %{ $args{'SearchBuilder'}->{'left_joins'} } ) {
+    foreach my $join ( sorted_values($args{'SearchBuilder'}->{'left_joins'}) ) {
         # left joins on the left side so later we'll get 1 AND x expression
         # which equal to x, so we just skip it
         next if $join->{'type'} eq 'LEFT';
         next unless $join->{'depends_on'} eq $args{'ALIAS'};
 
-        my @tmp = map { ('(', @$_, ')', $join->{'entry_aggregator'}) } values %{ $join->{'criteria'} };
+        my @tmp = map { ('(', @$_, ')', $join->{'entry_aggregator'}) } sorted_values($join->{'criteria'});
         pop @tmp;
 
         @conditions = ('(', @conditions, ')', 'AND', '(', @tmp ,')');
diff --git a/lib/DBIx/SearchBuilder/Handle/mysql.pm b/lib/DBIx/SearchBuilder/Handle/mysql.pm
index 5c56ca9..01bbcf1 100755
--- a/lib/DBIx/SearchBuilder/Handle/mysql.pm
+++ b/lib/DBIx/SearchBuilder/Handle/mysql.pm
@@ -69,9 +69,9 @@ sub SimpleUpdateFromSelect {
     return $sth unless $sth;
 
     my (@binds, @columns);
-    while ( my ($k, $v) = each %$values ) {
+    for my $k (sort keys %$values) {
         push @columns, $k;
-        push @binds, $v;
+        push @binds, $values->{$k};
     }
 
     my $update_query = "UPDATE $table SET "
diff --git a/lib/DBIx/SearchBuilder/Record.pm b/lib/DBIx/SearchBuilder/Record.pm
index a8d188c..7aa3401 100755
--- a/lib/DBIx/SearchBuilder/Record.pm
+++ b/lib/DBIx/SearchBuilder/Record.pm
@@ -7,7 +7,7 @@ use vars qw($AUTOLOAD);
 use Class::ReturnValue;
 use Encode qw();
 
-
+use DBIx::SearchBuilder::Util qw/ sorted_values /;
 
 =head1 NAME
 
@@ -667,7 +667,7 @@ Returns an array of the attributes of this class defined as "read" => 1 in this
 sub ReadableAttributes {
     my $self = shift;
     my $ca = $self->_ClassAccessible();
-    my @readable = grep { $ca->{$_}->{'read'} or $ca->{$_}->{'record-read'} } keys %{$ca};
+    my @readable = grep { $ca->{$_}->{'read'} or $ca->{$_}->{'record-read'} } sort keys %{$ca};
     return (@readable);
 }
 
@@ -682,7 +682,7 @@ Returns an array of the attributes of this class defined as "write" => 1 in this
 sub WritableAttributes {
     my $self = shift;
     my $ca = $self->_ClassAccessible();
-    my @writable = grep { $ca->{$_}->{'write'} || $ca->{$_}->{'record-write'} } keys %{$ca};
+    my @writable = grep { $ca->{$_}->{'write'} || $ca->{$_}->{'record-write'} } sort keys %{$ca};
     return @writable;
 }
 
@@ -710,8 +710,8 @@ sub __Value {
     return undef if grep !defined, values %pk;
 
     my $query = "SELECT $field FROM ". $self->Table
-        ." WHERE ". join " AND ", map "$_ = ?", keys %pk;
-    my $sth = $self->_Handle->SimpleQuery( $query, values %pk ) or return undef;
+        ." WHERE ". join " AND ", map "$_ = ?", sort keys %pk;
+    my $sth = $self->_Handle->SimpleQuery( $query, sorted_values(%pk) ) or return undef;
     return $self->{'values'}{$field} = ($sth->fetchrow_array)[0];
 }
 
@@ -1089,7 +1089,7 @@ sub LoadByCols  {
     my $self = shift;
     my %hash  = (@_);
     my (@bind, @phrases);
-    foreach my $key (keys %hash) {  
+    foreach my $key (sort keys %hash) {
 	if (defined $hash{$key} &&  $hash{$key} ne '') {
         my $op;
         my $value;
@@ -1315,7 +1315,7 @@ sub __Delete {
     my @bind=();
     my %pkeys=$self->PrimaryKeys();
     my $where  = 'WHERE ';
-    foreach my $key (keys %pkeys) {
+    foreach my $key (sort keys %pkeys) {
        $where .= $key . "=?" . " AND ";
        push (@bind, $pkeys{$key});
     }
diff --git a/lib/DBIx/SearchBuilder/Util.pm b/lib/DBIx/SearchBuilder/Util.pm
new file mode 100644
index 0000000..d81c275
--- /dev/null
+++ b/lib/DBIx/SearchBuilder/Util.pm
@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+
+package DBIx::SearchBuilder::Util;
+use base 'Exporter';
+
+our @EXPORT_OK = qw(
+    sorted_values
+);
+
+=head1 NAME
+
+DBIx::SearchBuilder::Util - Utility and convenience functions for DBIx::SearchBuilder
+
+=head1 SYNOPSIS
+
+    use DBIx::SearchBuilder::Util qw( sorted_values );  # or other function you want
+
+=head1 EXPORTED FUNCTIONS
+
+=head2 sorted_values
+
+Takes a hash or hashref and returns the values sorted by their respective keys.
+
+Equivalent to
+
+    map { $hash{$_} } sort keys %hash
+
+but far more convenient.
+
+=cut
+
+sub sorted_values {
+    my $hash = @_ == 1 ? $_[0] : { @_ };
+    return map { $hash->{$_} } sort keys %$hash;
+}
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2013 Best Practical Solutions, LLC.  All rights reserved.
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list