[interchange] Add new DBI sub, foreign_hash().

commit 700889a1ad6078fb0ce0cba7bdd4bdf9a3c488ff
Author: Josh Lavin <[email protected]>
Date:   Thu Mar 28 15:52:37 2013 -0700

    Add new DBI sub, foreign_hash().
    
    Basically a row_hash() function that uses a foreign key column instead of primary key. Example:
    
    code     ticket      type
    1234     9876        request
    1233     5555        response
    
    my $rec1 = $db->row_hash('1234');
    my $rec2 = $db->foreign_hash('ticket','9876');
    
    Each of the above would return the same record hash.
    
    Of course the foreign column has to be unique, or an array will be returned.

 lib/Vend/Table/DBI.pm |   34 ++++++++++++++++++++++++++++++++++
 1 files changed, 34 insertions(+), 0 deletions(-)
---
diff --git a/lib/Vend/Table/DBI.pm b/lib/Vend/Table/DBI.pm
index 343c365..10ce8e9 100644
--- a/lib/Vend/Table/DBI.pm
+++ b/lib/Vend/Table/DBI.pm
@@ -1515,6 +1515,40 @@ sub row {
 	return @{ $sth->fetchrow_arrayref() || [] };
 }
 
+sub foreign_hash {
+    my ($s, $col, $key) = @_;
+	$s = $s->import_db() if ! defined $s->[$DBI];
+	my $q = "select * from $s->[$TABLE] where $col = ?";
+    my $sth = $s->[$DBI]->prepare($q)
+		or $s->log_error("%s prepare error for %s: %s", 'row_hash', $q, $DBI::errstr)
+		and return undef;
+    $sth->execute($key)
+		or $s->log_error("%s execute error for %s: %s", 'row_hash', $q, $DBI::errstr)
+		and return undef;
+
+	return $sth->fetchrow_hashref()
+		unless $s->[$TYPE];
+	my $ref;
+	if($s->config('UPPERCASE')) {
+		my $aref = $sth->fetchrow_arrayref()
+			or return undef;
+		$ref = {};
+		my @nm = @{$sth->{NAME}};
+		for ( my $i = 0; $i < @$aref; $i++) {
+			$ref->{$nm[$i]} = $ref->{lc $nm[$i]} = $aref->[$i];
+		}
+	}
+	else {
+		$ref = $sth->fetchrow_hashref();
+	}
+	return $ref unless $s->[$CONFIG]{FIELD_ALIAS};
+	my ($k, $v);
+	while ( ($k, $v) = each %{ $s->[$CONFIG]{FIELD_ALIAS} } ) {
+		$ref->{$v} = $ref->{$k};
+	}
+	return $ref;
+}
+
 sub row_hash {
     my ($s, $key) = @_;
 	$s = $s->import_db() if ! defined $s->[$DBI];