[interchange-cvs] interchange - heins modified lib/Vend/Table/DBI.pm
interchange-core@icdevgroup.org
interchange-core@icdevgroup.org
Wed Oct 9 10:25:00 2002
User: heins
Date: 2002-10-09 14:24:58 GMT
Modified: lib/Vend/Table DBI.pm
Log:
* Put in Andrew's length-exception stuff.
Revision Changes Path
2.35 +117 -2 interchange/lib/Vend/Table/DBI.pm
rev 2.35, prev_rev 2.34
Index: DBI.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Table/DBI.pm,v
retrieving revision 2.34
retrieving revision 2.35
diff -u -r2.34 -r2.35
--- DBI.pm 7 Oct 2002 15:35:57 -0000 2.34
+++ DBI.pm 9 Oct 2002 14:24:58 -0000 2.35
@@ -1,6 +1,6 @@
# Vend::Table::DBI - Access a table stored in an DBI/DBD database
#
-# $Id: DBI.pm,v 2.34 2002/10/07 15:35:57 mheins Exp $
+# $Id: DBI.pm,v 2.35 2002/10/09 14:24:58 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -20,7 +20,7 @@
# MA 02111-1307 USA.
=20
package Vend::Table::DBI;
-$VERSION =3D substr(q$Revision: 2.34 $, 10);
+$VERSION =3D substr(q$Revision: 2.35 $, 10);
=20
use strict;
=20
@@ -204,6 +204,9 @@
Oracle =3D> 1,
Pg =3D> 1,
},
+ MAX_FIELD_LENGTH =3D> {
+ Pg =3D> "SELECT a.attnum,t.typname,a.attlen,a.atttypmod,a.attname =
FROM pg_class c,pg_attribute a,pg_type t WHERE c.relname=3D'_TABLE_' AND a.=
attnum > 0 AND a.attrelid =3D c.oid AND a.atttypid =3D t.oid ORDER BY a.att=
num;",
+ },
);
=20
sub check_capability {
@@ -655,6 +658,47 @@
)
if ! defined $config->{KEY_INDEX};
=20
+ if ( $config->{MAX_FIELD_LENGTH}
+ and
+ $config->{LENGTH_EXCEPTION_DEFAULT}
+ and=20
+ ! $config->{FIELD_LENGTH_DATA}
+ )
+ {
+ my $ssql =3D $config->{MAX_FIELD_LENGTH};
+ $ssql =3D~ s/_TABLE_/$tablename/g;
+ my $osth =3D $db->prepare($ssql);
+ $osth->execute;
+=09
+ $config->{FIELD_LENGTH_DATA} =3D {};
+
+ while (my @ores =3D $osth->fetchrow_array) {
+ my $stype =3D $ores[1];
+ my $slen =3D $ores[2];
+ my $slenvar =3D $ores[3];
+ my $scfg =3D $config->{FIELD_LENGTH_DATA}{$ores[4]} =3D {};
+=09=20=20=20=20
+ $scfg->{TYPE} =3D $stype;
+
+ if( $stype=3D~/numeric/i or $stype=3D~/varbit/i ){=20=20
+ $scfg->{LENGTH} =3D $slenvar;
+ }
+ else {
+ if ($slen > 0) {
+ $scfg->{LENGTH} =3D $slen;
+ }
+ elsif ($slenvar>0) {
+ $scfg->{LENGTH} =3D ($slenvar-4);
+ }
+ else {
+ $scfg->{LENGTH} =3D 'var';
+ }
+ }
+ }
+
+ $osth->finish;
+ }
+
my $s =3D [$config, $tablename, $key, $config->{NAME}, $config->{EXTEN=
DED}, $db];
bless $s, $class;
}
@@ -1004,6 +1048,61 @@
return $new;
}
=20
+sub length_exception {
+ my ($s, $fname, $data) =3D @_;
+
+ my $fcfg =3D $s->[$CONFIG]{FIELD_LENGTH_DATA}{$fname}
+ or return $data;
+ my $action =3D $s->[$CONFIG]{LENGTH_EXCEPTION}{$fname}
+ || $s->[$CONFIG]{LENGTH_EXCEPTION_DEFAULT};
+
+ my $slen =3D $fcfg->{LENGTH};
+
+ my $errout;
+ if( $action =3D~ /^truncate(?:_(\w+))$/i) {
+ my $errout =3D lc $1;
+ $data =3D substr($data,0,$slen);=09=09=09=20=20=20=20=20=20
+ }
+ elsif ($action =3D~ /^filter/i){
+ my $faction =3D $action;
+ $faction =3D~ s/^filter\s+//i;
+ my @filters =3D Text::ParseWords::shellwords($faction);
+ for my $filt (@filters) {
+ if ($filt eq 'truncate') {
+ $data =3D substr($data,0,$slen);
+ }
+ else {
+ $data =3D Vend::Interpolate::filter_value($filt, $data);
+ }
+ }=20=20=20=20
+ }
+
+ if($errout) {
+ my $caller =3D caller();
+ my $msg1 =3D errmsg(
+ "%s - Length Exception! - Data length: %s Field length: %s",
+ $caller,
+ length($data),
+ $slen,
+ );
+ my $msg2 =3D errmsg(
+ "%s - Length Exception - Table: %s, Field: %s. Action to take: %s",
+ $caller,
+ $s->[$TABLE],
+ $action,
+ );
+ if($errout eq 'debug') {
+ ::logDebug($msg1);
+ ::logDebug($msg2);
+ }
+ elsif($errout eq 'log') {
+ ::logError($msg1);
+ ::logError($msg2);
+ }
+ }
+ return $data;
+}
+
sub get_slice {
my ($s, $key, $fary) =3D @_;
$s =3D $s->import_db() if ! defined $s->[$DBI];
@@ -1067,6 +1166,22 @@
$vary =3D [ values %$href ];
$fary =3D [ keys %$href ];
}
+
+ if($s->[$CONFIG]->{LENGTH_EXCEPTION_DEFAULT}) {
+
+ my $lcfg =3D $s->[$CONFIG]{FIELD_LENGTH_DATA}
+ or die "No field length data!";
+ my $ecfg =3D $s->[$CONFIG]{LENGTH_EXCEPTION} || {};
+ my $edefault =3D $s->[$CONFIG]{LENGTH_EXCEPTION_DEFAULT};
+
+ for (my $i=3D0; $i < @$fary; $i++){
+ next unless defined $lcfg->{$fary->[$i]};
+
+ $vary->[$i] =3D $s->length_exception($fary->[$i], $vary->[$i])
+ if length($vary->[$i]) > $lcfg->{$fary->[$i]}{LENGTH};
+
+ }
+ }
=20
$tkey =3D $s->quote($key, $s->[$KEY]) if defined $key;
#::logDebug("tkey now $tkey");