[interchange-cvs] interchange - heins modified lib/Vend/Table/DBI.pm
interchange-core@icdevgroup.org
interchange-core@icdevgroup.org
Thu Apr 24 13:31:09 2003
User: heins
Date: 2003-04-24 17:26:33 GMT
Modified: lib/Vend/Table DBI.pm
Log:
* Add single() convenience method which returns a single field based on a
presumably-distinct query. DBI only; doesn't really make sense with
DBM, memory, or LDAP.
my $spec = { prod_group => 'Ladders', category => 'Ladders' };
my $param = $db->single('sku', $spec);
$param will equal 'os28008' with the foundation "tools" data. Like
the foreign method, if more than one record matches only returns the
first one.
Can be called from the [data ..] tag:
[data table=products
col=name
foreign.prod_group="Ladders"
foreign.category="Ladders"
] eq 'Painters Ladder'
Or:
[perl products]
$Tag->data({
table => 'products',
column => 'name',
foreign => { prod_group => 'Ladders', category => 'Ladders' },
});
[/perl] eq 'Painters Ladder'
Also can be called with an array specification and text parameters:
my $ary = ["prod_group=Ladders", "category=Ladders"]
my $param = $db->single('sku', $ary);
This allows query optimization if the first field is indexed and
the second isn't.
Similarly:
[data table=products
col=name
foreign.0="prod_group=Ladders"
foreign.1="category="Ladders"
] eq 'Painters Ladder'
or
[perl products]
$Tag->data({
table => 'products',
column => 'name',
foreign => [ "prod_group=Ladders", "category=Ladders" ],
});
[/perl] eq 'Painters Ladder'
* Documented in ictags.
Revision Changes Path
2.46 +45 -2 interchange/lib/Vend/Table/DBI.pm
rev 2.46, prev_rev 2.45
Index: DBI.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/DBI.pm,v
retrieving revision 2.45
retrieving revision 2.46
diff -u -r2.45 -r2.46
--- DBI.pm 21 Apr 2003 19:27:00 -0000 2.45
+++ DBI.pm 24 Apr 2003 17:26:33 -0000 2.46
@@ -1,6 +1,6 @@
# Vend::Table::DBI - Access a table stored in an DBI/DBD database
#
-# $Id: DBI.pm,v 2.45 2003/04/21 19:27:00 mheins Exp $
+# $Id: DBI.pm,v 2.46 2003/04/24 17:26:33 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -20,7 +20,7 @@
# MA 02111-1307 USA.
package Vend::Table::DBI;
-$VERSION = substr(q$Revision: 2.45 $, 10);
+$VERSION = substr(q$Revision: 2.46 $, 10);
use strict;
@@ -1470,6 +1470,7 @@
sub foreign {
my ($s, $key, $foreign) = @_;
+ return single($s, $s->[$KEY], $foreign) if ref($foreign);
$s = $s->import_db() if ! defined $s->[$DBI];
my $idx;
if( $s->[$TYPE] and $idx = $s->column_index($foreign) ) {
@@ -1485,6 +1486,48 @@
$sth->execute();
};
return '' if $@;
+ my $data = ($sth->fetchrow_array())[0];
+ return '' unless $data =~ /\S/;
+ return $data;
+}
+
+sub single {
+ my ($s, $field, $qhash) = @_;
+ $s = $s->import_db() if ! defined $s->[$DBI];
+ my $idx;
+
+ my $q = "select $field from $s->[$TABLE] WHERE ";
+
+ my @fields;
+ my @dats;
+
+ if(ref($qhash) eq 'ARRAY') {
+ for(@$qhash) {
+ s/(\w+)\s*=\s*//
+ or next;
+ push @fields, "$1 = ?";
+ push @dats, $_;
+ }
+ }
+ elsif(ref($qhash) eq 'HASH') {
+ while(my ($k,$v) = each %$qhash) {
+ push @fields, "$k = ?";
+ push @dats, $v;
+ }
+ }
+ else {
+ ::logError("Bad single data query parameter type: %s", ref($qhash));
+ return undef;
+ }
+
+ $q .= join ' AND ', @fields;
+#::logDebug("DBI single: query=$q");
+ my $sth;
+ eval {
+ $sth = $s->[$DBI]->prepare($q);
+ $sth->execute(@dats);
+ };
+ return undef if $@;
my $data = ($sth->fetchrow_array())[0];
return '' unless $data =~ /\S/;
return $data;