# Vend::Table::DBI - Access a table stored in an DBI/DBD database

#

# Copyright (C) 2002-2018 Interchange Development Group

# Copyright (C) 1996-2002 Red Hat, Inc.

#

# This program is free software; you can redistribute it and/or modify

# it under the terms of the GNU General Public License as published by

# the Free Software Foundation; either version 2 of the License, or

# (at your option) any later version.

#

# This program is distributed in the hope that it will be useful,

# but WITHOUT ANY WARRANTY; without even the implied warranty of

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

# GNU General Public License for more details.

#

# You should have received a copy of the GNU General Public

# License along with this program; if not, write to the Free

# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,

# MA 02110-1301 USA.

package Vend::Table::DBI_CompositeKey;

$VERSION = '1.17';

use strict;

# 0: dummy open object

# 1: table name

# 2: key name

# 3: Configuration hash

# 4: Array of column names

# 5: database object

# 6: each reference (transitory)

use vars qw/

$CONFIG

$TABLE

$KEY

$NAME

$TYPE

$DBI

$EACH

$TIE_HASH

%DBI_connect_cache

%DBI_connect_count

%DBI_connect_bad

/;

($CONFIG, $TABLE, $KEY, $NAME, $TYPE, $DBI, $EACH) = (0 .. 6);

$TIE_HASH = $DBI;

sub create {

my ($class, $config, $columns, $tablename) = @_;

#::logDebug("DBI_CompositeKey trying create table $tablename");

if(! $config->{COMPOSITE_KEY}) {

die ::errmsg(

"Class %s: requires COMPOSITE_KEY setting\n",

$class,

);

}

if(! $config->{_Key_columns}) {

my @keycols = grep length($_), split /[\s,\0]+/, $config->{COMPOSITE_KEY};

$config->{_Key_columns} = \@keycols;

$config->{_Key_where} = 'WHERE ';

my $hash = {};

my @what;

for(@keycols) {

push @what, "$_ = ?";

$hash->{$_} = 1;

}

$config->{_Key_where} .= join " AND ", @what;

$config->{_Key_is} = $hash;

if($config->{KEY_SPLITTOR}) {

$config->{_Key_splittor} = qr($config->{KEY_SPLITTOR});

}

else {

$config->{_Key_splittor} = qr([\0,]);

}

}

if(

(! $config->{INDEX} or @{$config->{INDEX}} == 0)

and

! $config->{POSTCREATE}

)

{

my $fields = $config->{COMPOSITE_KEY};

$fields =~ s/^\s+//;

$fields =~ s/\s+$//;

$fields =~ s/\s+/,/g;

my $tabname = $config->{REAL_NAME} || $config->{name};

$config->{POSTCREATE} =

["CREATE UNIQUE INDEX ${tabname}_index ON $tabname($fields)"];

#::logDebug("did POSTCREATE: $config->{POSTCREATE}");

}

#::logDebug("open_table config=" . ::uneval($config));

return Vend::Table::DBI::create($class, $config, $columns, $tablename);

}

sub open_table {

my ($class, $config, $tablename) = @_;

#::logDebug("DBI_CompositeKey trying to open table $tablename");

if(! $config->{COMPOSITE_KEY}) {

die ::errmsg(

"Class %s: requires COMPOSITE_KEY setting\n",

$class,

);

}

if(! $config->{_Key_columns}) {

my @keycols = grep length($_), split /[\s,\0]+/, $config->{COMPOSITE_KEY};

$config->{_Key_columns} = \@keycols;

$config->{_Key_where} = 'WHERE ';

my $hash = {};

my @what;

for(@keycols) {

push @what, "$_ = ?";

$hash->{$_} = 1;

}

$config->{_Key_where} .= join " AND ", @what;

$config->{_Key_is} = $hash;

if($config->{KEY_SPLITTOR}) {

$config->{_Key_splittor} = qr($config->{KEY_SPLITTOR});

}

else {

$config->{_Key_splittor} = qr([\0,]);

}

}

#::logDebug("open_table config=" . ::uneval($config));

return Vend::Table::DBI::open_table($class, $config, $tablename);

}

sub new {

my ($class, $obj) = @_;

$obj->{type} = 11;

#::logDebug("DBI_CompositeKey new object of" . ::uneval($obj));

bless [$obj], $class;

}

sub key_values {

my $s = shift;

my $key = shift;

my @key;

if(ref($key) eq 'HASH') {

for(@{$s->[$CONFIG]{_Key_columns}}) {

push @key, $key->{$_};

}

}

elsif(! ref($key)) {

@key = split $s->[$CONFIG]{_Key_splittor}, $key;

}

else {

@key = @$key;

}

#::logDebug("DBI_CompositeKey keys = " . ::uneval(\@key));

return @key;

}

sub autonumber { return '' }

sub inc_field {

my ($s, $key, $column, $value) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

$column = $s->[$NAME][ $s->column_index($column) ];

my @key = $s->key_values($key);

my $q1 = "select $column from $s->[$TABLE] $s->[$CONFIG]->{_Key_where}";

my $q2 = "update $s->[$TABLE] set $column = ? $s->[$CONFIG]->{_Key_where}";

my $sth1 = $s->[$DBI]->prepare($q1)

or $s->log_error("%s query (%s) failed: %s", 'inc_field', $q1, $DBI::errstr)

and return undef;

my $sth2 = $s->[$DBI]->prepare($q2)

or $s->log_error("%s query (%s) failed: %s", 'inc_field', $q2, $DBI::errstr)

and return undef;

$sth1->execute(@key)

or $s->log_error("%s query (%s) failed: %s", 'inc_field', $q1, $DBI::errstr)

and return undef;

$value += ($sth1->fetchrow_array)[0];

$sth2->execute($value, @key)

or $s->log_error("%s query (%s) failed: %s", 'inc_field', $q2, $DBI::errstr)

and return undef;

$value;

}

sub field_accessor {

my ($s, $column) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

$column = $s->[$NAME][ $s->column_index($column) ];

my $q = "select $column from $s->[$TABLE] $s->[$CONFIG]{_Key_where}";

my $sth = $s->[$DBI]->prepare($q)

or $s->log_error("field_accessor statement (%s) -- bad result.", $q)

and return undef;

#::logDebug("binding sub to $q");

return sub {

my ($key) = @_;

my @key = $s->key_values($key);

$sth->execute(@key);

my ($return) = $sth->fetchrow_array();

return $return;

};

}

sub clone_row {

my ($s, $old, $new, $change) = @_;

#::logDebug("called clone_row old=$old new=$new change=$change");

$s = $s->ref();

my @old = $s->key_values($old);

return undef unless $s->record_exists(@old);

my @ary = $s->row(@old);

#::logDebug("called clone_row ary=" . join "|", @ary);

if($change and ref $change) {

for (keys %$change) {

my $pos = $s->column_index($_)

or next;

$ary[$pos] = $change->{$_};

}

}

my @new = $s->key_values($new);

for(@{$s->[$CONFIG]{_Key_columns}}) {

my $i = $s->column_index($_);

$ary[$i] = shift @new;

}

$ary[$s->[$CONFIG]{KEY_INDEX}] = $new;

#::logDebug("called clone_row now=" . join "|", @ary);

my $k = $s->set_row(@ary);

#::logDebug("cloned, key=$k");

return $k;

}

sub clone_set {

#### Can't yet be used

my ($s, $col, $old, $new) = @_;

#::logDebug("called clone_set col=$col old=$old new=$new");

return unless $s->column_exists($col);

my $sel = $s->quote($old, $col);

my $name = $s->[$CONFIG]{name};

my ($ary, $nh, $na) = $s->query("select * from $name where $col = $sel");

my $fpos = $nh->{$col} || return undef;

$s->config('AUTO_NUMBER', '000001') unless $s->config('AUTO_NUMBER');

for(@$ary) {

my $line = $_;

$line->[$s->[$CONFIG]{KEY_INDEX}] = '';

$line->[$fpos] = $new;

my $k = $s->set_row(@$line);

#::logDebug("cloned, key=$k");

}

return $new;

}

sub get_slice {

my ($s, $key, $fary) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

my $tkey;

my $sql;

my @key = $s->key_values($key);

#::logDebug("key values for get_slice=" . ::uneval(\@key));

return undef unless $s->record_exists(\@key);

#::logDebug("tkey now $tkey");

# Better than failing on a bad ref...

if(ref $fary ne 'ARRAY') {

shift; shift;

$fary = [ @_ ];

}

my $fstring = join ",", @$fary;

$sql = "SELECT $fstring from $s->[$TABLE] $s->[$CONFIG]{_Key_where}";

#::logDebug("get_slice query: $sql");

#::logDebug("get_slice key/fields:\nkey=$key\n" . ::uneval($fary));

my $sth;

my $ary;

eval {

$sth = $s->[$DBI]->prepare($sql)

or die ::errmsg("prepare %s: %s", $sql, $DBI::errstr);

$sth->execute(@key);

};

if($@) {

my $msg = $@;

$s->log_error("failed %s::%s routine: %s", __PACKAGE__, 'get_slice', $msg);

return undef;

}

return wantarray ? $sth->fetchrow_array() : $sth->fetchrow_arrayref();

}

sub set_slice {

my ($s, $key, $fin, $vin) = @_;

#::logDebug("set_slice key/fin/vin=\n" . ::uneval($key, $fin, $vin));

my ($opt, @key, $fary, $vary, $exists, $sql);

$s = $s->import_db() if ! defined $s->[$DBI];

if (ref($key) eq 'ARRAY' && ref($key->[0]) eq 'HASH') {

$opt = shift @$key;

}

$opt ||= {};

$opt->{dml} = 'upsert'

unless defined $opt->{dml};

@key = $s->key_values($key) if $key;

# A key made up only of NULLs is empty but in composite keys, looks like it exists,

# so needs to be removed for the empty key checks below.

# Using List::Util::all would be prettier, but this way we avoid another dependency:

@key = () if @key and @key == grep { !defined } @key;

#::logDebug("\$key=" . ::uneval($key));

#::logDebug("\@key=" . ::uneval(\@key));

#::logDebug("opt=" . ::uneval($opt));

if($s->[$CONFIG]{Read_only}) {

$s->log_error(

"Attempt to set slice of %s in read-only table %s",

join('/', @key),

$s->[$CONFIG]{name},

);

return undef;

}

$exists = $s->record_exists($key) if $key;

#::logDebug("exists=$exists");

if (ref $fin eq 'ARRAY') {

$fary = [@$fin];

$vary = [@$vin];

}

else {

my $href;

if (ref $fin eq 'HASH') {

$href = { %$fin };

}

else {

$href = { splice (@_, 2) };

}

if (! @key) {

for( @{$s->[$CONFIG]{_Key_columns}} ) {

push @key, delete $href->{$_};

}

$key = \@key;

$exists = $s->record_exists($key);

}

$vary = [ values %$href ];

$fary = [ keys %$href ];

}

#::logDebug("set_slice \$key/\@key/\$fary/\$vary=\n" . ::uneval($key, \@key, $fary, $vary));

if (! @key) {

for my $kp (@{$s->[$CONFIG]{_Key_columns}}) {

my $idx;

my $i = -1;

for(@$fary) {

$i++;

next unless $_ eq $kp;

$idx = $i;

last;

}

if(! defined $idx) {

my $caller = caller();

$s->log_error(

'%s error as called by %s: %s',

'set_slice',

$caller,

'unable to find key in field array',

);

return undef;

}

push @key, $vary->[$idx];

}

$key = \@key;

#::logDebug("No key, key now=" . ::uneval($key));

$exists = $s->record_exists($key);

}

if ($s->[$CONFIG]->{PREFER_NULL}) {

my $prefer_null = $s->[$CONFIG]->{PREFER_NULL};

my $i = 0;

for (@$fary) {

undef $vary->[$i]

if exists $prefer_null->{$_} and $vary->[$i] eq '';

++$i;

}

}

if($s->[$CONFIG]->{LENGTH_EXCEPTION_DEFAULT}) {

my $lcfg = $s->[$CONFIG]{FIELD_LENGTH_DATA}

or $s->log_error("No field length data with LENGTH_EXCEPTION defined!")

and return undef;

for (my $i=0; $i < @$fary; $i++){

next unless defined $lcfg->{$fary->[$i]};

$vary->[$i] = $s->length_exception($fary->[$i], $vary->[$i])

if length($vary->[$i]) > $lcfg->{$fary->[$i]}{LENGTH};

}

}

my $force_insert = $opt->{dml} eq 'insert';

my $force_update = $opt->{dml} eq 'update';

if ( $force_update or !$force_insert and $exists ) {

unless (@$fary) {

# as there are no data columns, we can safely skip the update

return $key;

}

my $fstring = join ",", map { "$_=?" } @$fary;

$sql = "update $s->[$TABLE] SET $fstring $s->[$CONFIG]{_Key_where}";

}

else {

my %found;

for(my $i = 0; $i < @$fary; $i++) {

next unless $s->[$CONFIG]{_Key_is}{$fary->[$i]};

$found{$fary->[$i]} = 1;

}

for(@{$s->[$CONFIG]{_Key_columns}}) {

if($found{$_}) {

shift(@key);

}

else {

unshift @$fary, $_;

unshift @$vary, shift(@key);

}

}

my $fstring = join ",", @$fary;

my $vstring = join ",", map {"?"} @$vary;

$sql = "insert into $s->[$TABLE] ($fstring) VALUES ($vstring)";

}

#::logDebug("exists=$exists set_slice query: $sql");

#::logDebug("set_slice key/fields/values:\n" . ::uneval($key, $fary, $vary));

my $val;

eval {

my $sth = $s->[$DBI]->prepare($sql)

or die ::errmsg("prepare %s: %s", $sql, $DBI::errstr);

my $rc = $sth->execute(@$vary,@key)

or die ::errmsg("execute %s: %s", $sql, $DBI::errstr);

$val = $key;

};

#::logDebug("set_slice key=" . ::uneval($val));

if($@) {

my $err = $@;

my $caller = caller();

$s->log_error(

"%s error as called by %s: %s\nquery was:%s\nvalues were:'%s'",

'set_slice',

$caller,

$err,

$sql,

join("','", @$vary),

);

return undef;

}

return $val;

}

sub set_row {

my ($s, @fields) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

my $cfg = $s->[$CONFIG];

my $ki = $cfg->{KEY_INDEX};

$s->filter(\@fields, $s->[$CONFIG]{COLUMN_INDEX}, $s->[$CONFIG]{FILTER_TO})

if $cfg->{FILTER_TO};

if ($cfg->{PREFER_NULL}) {

for (keys %{$cfg->{PREFER_NULL}}) {

my $i = $cfg->{COLUMN_INDEX}{$_};

undef $fields[$i] if $fields[$i] eq '';

}

}

my $val;

my @key;

my @vals;

my @flds;

my $force_key;

if(scalar @fields == 1) {

$force_key = 1;

@key = $s->key_values($fields[0]);

for(@{$cfg->{_Key_columns}}) {

$vals[$s->column_index($_)] = shift @key;

}

}

else {

for(@{$cfg->{_Key_columns}}) {

push @key, $fields[$s->column_index($_)];

}

}

if($force_key) {

my $key_string;

my $val_string;

my $ary;

if($cfg->{_Default_ary} || $cfg->{_Default_session_ary}) {

my $ary = $cfg->{_Default_ary} || [];

my $sary = $cfg->{_Default_session_ary} || [];

my $max = $#$ary > $#$sary ? $#$ary : $#$sary;

for (my $i = 0; $i <= $max; $i++) {

if($sary->[$i] and ! defined $vals[$i]) {

push @flds, $s->[$NAME][$i];

$vals[$i] = $sary->[$i]->($s);

next;

}

next unless defined $ary->[$i];

$flds[$i] = $s->[$NAME][$i];

$vals[$i] = $ary->[$i];

}

}

my @f;

my @v;

for( my $i = 0; $i < @flds; $i++) {

next unless $flds[$i];

push @f, $flds[$i];

push @v, $vals[$i];

}

$key_string = join ",", @f;

$val_string = join ",", @v;

#::logDebug("def_ary query will be: insert into $s->[$TABLE] ($key_string) VALUES ($val_string)");

eval {

$s->delete_record(\@key);

$s->[$DBI]->do("insert into $s->[$TABLE] ($key_string) VALUES ($val_string)");

};

if($@) {

my $err = $@;

my $caller = caller();

$s->log_error(

"%s error as called by %s: %s\nfields=%s\nvalues=%s",

'set_row',

$caller,

$err,

$key_string,

$val_string,

);

return undef;

}

return \@key;

}

if (! $s->[$CONFIG]{Clean_start}) {

eval {

$s->delete_record(\@key);

};

}

#::logDebug("set_row fields='" . join(',', @fields) . "'" );

if(! $cfg->{_Insert_h}) {

my (@ins_mark);

my $i = 0;

for(@{$s->[$NAME]}) {

push @ins_mark, '?';

$i++;

}

my $fstring = '';

my $ins_string = join ", ", @ins_mark;

my $query = "INSERT INTO $s->[$TABLE]$fstring VALUES ($ins_string)";

#::logDebug("set_row query=$query");

$cfg->{_Insert_h} = $s->[$DBI]->prepare($query)

or die $s->log_error(

"%s error on %s: $DBI::errstr",

'set_row',

$query,

$DBI::errstr,

);

}

#::logDebug("set_row fields='" . join(',', @fields) . "'" );

$s->bind_entire_row($cfg->{_Insert_h}, @fields);

my $rc = $cfg->{_Insert_h}->execute()

or die $s->log_error("%s error: $DBI::errstr", 'set_row', $DBI::errstr);

#::logDebug("set_row rc=$rc key=" . ::uneval_it(\@key));

return \@key;

}

sub last_sequence_value {

die ::errmsg("No last_sequence_value with DBI_CompositeKey");

}

sub row {

my ($s, $key) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

my $q = "select * from $s->[$TABLE] $s->[$CONFIG]{_Key_where}";

my @key = $s->key_values($key);

my $sth = $s->[$DBI]->prepare($q)

or $s->log_error("%s prepare error for %s: %s", 'row', $q, $DBI::errstr)

and return undef;

$sth->execute(@key)

or $s->log_error("%s execute error for %s: %s", 'row', $q, $DBI::errstr)

and return undef;

return @{ $sth->fetchrow_arrayref() || [] };

}

sub row_hash {

my ($s, $key) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

my $q = "select * from $s->[$TABLE] $s->[$CONFIG]{_Key_where}";

my @key = $s->key_values($key);

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 field_settor {

my ($s, $column) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

my $q = "update $s->[$TABLE] SET $column = ? $s->[$CONFIG]{_Key_where}";

my $sth = $s->[$DBI]->prepare($q)

or $s->log_error("Unable to prepare query for field_settor: %s", $q)

and return undef;

return sub {

my ($key, $value) = @_;

my @key = $s->key_values($key);

$sth->execute($value, @key);

};

}

sub foreign {

die "Foreign keys not supported for multiple-key database tables\n";

}

sub field {

my ($s, $key, $column) = @_;

#::logDebug("Called DBI_CompositeKey field");

$s = $s->import_db() if ! defined $s->[$DBI];

my @key = $s->key_values($key);

my $idx;

if( $s->[$TYPE] and $idx = $s->column_index($column) ) {

$column = $s->[$NAME][$idx];

}

my $query = "select $column from $s->[$TABLE] $s->[$CONFIG]{_Key_where}";

#::logDebug("DBI field: key=$key column=$column query=$query");

my $sth;

eval {

$sth = $s->[$DBI]->prepare($query);

$sth->execute(@key);

};

if($@) {

$s->log_error("field: failed to execute %s", $query);

return '';

}

my $data = ($sth->fetchrow_array())[0];

return '' unless $data =~ /\S/;

$data;

}

sub set_field {

my ($s, $key, $column, $value) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

if($s->[$CONFIG]{Read_only}) {

$s->log_error("Attempt to set %s in read-only table",

"$s->[$CONFIG]{name}::${column}::$key",

);

return undef;

}

my $lcfg;

if(

$s->[$CONFIG]->{LENGTH_EXCEPTION_DEFAULT}

and $s->[$CONFIG]{FIELD_LENGTH_DATA}

and $lcfg = $s->[$CONFIG]{FIELD_LENGTH_DATA}{$column}

and $lcfg->{LENGTH} < length($value)

)

{

$value = $s->length_exception($column, $value);

}

my @key = $s->key_values($key);

undef $value if $value eq '' and exists $s->[$CONFIG]{PREFER_NULL}{$column};

$s->set_slice($key, [$column], [$value])

and return $value;

return undef;

}

sub ref {

return $_[0] if defined $_[0]->[$DBI];

return $_[0]->import_db();

}

sub test_record {

1;

}

sub record_exists {

my ($s, $key) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

my @key = $s->key_values($key);

my $query;

# Don't allow undef or empty key parts unless configuration specifies

return '' if grep { !defined or !length } @key and ! $s->[$CONFIG]{ALLOW_EMPTY_KEY};

my $mainkey = $s->[$CONFIG]{_Key_columns}[0];

#::logDebug("record_exists for mainkey=$mainkey key=" . ::uneval(\@key));

$query = $s->[$CONFIG]{Exists_handle}

or

$query = $s->[$DBI]->prepare(

"select $mainkey from $s->[$TABLE] $s->[$CONFIG]{_Key_where}"

)

and

$s->[$CONFIG]{Exists_handle} = $query;

my $status;

#::logDebug("record_exists query=$query");

eval {

$status = defined $s->[$DBI]->selectrow_array($query, undef, @key);

};

if($@) {

$s->log_error("Bad execution of record_exists query: $@");

return undef;

}

#::logDebug("record_exists status=$status");

return $status;

}

sub delete_record {

my ($s, $key) = @_;

$s = $s->import_db() if ! defined $s->[$DBI];

if($s->[$CONFIG]{Read_only}) {

$s->log_error("Attempt to delete record '%s' from read-only database %s",

$key,

$s->[$CONFIG]{name},

);

return undef;

}

my @key = $s->key_values($key);

my $sth = $s->[$DBI]->prepare("delete from $s->[$TABLE] $s->[$CONFIG]{_Key_where}");

my $rc = $sth->execute(@key);

return $rc > 0 ? $rc : 0;

}

*import_db = \&Vend::Table::DBI::import_db;

*suicide = \&Vend::Table::DBI::suicide;

*close_table = \&Vend::Table::DBI::close_table;

*dbh = \&Vend::Table::DBI::dbh;

*name = \&Vend::Table::DBI::name;

*columns = \&Vend::Table::DBI::columns;

*test_column = \&Vend::Table::DBI::test_column;

*quote = \&Vend::Table::DBI::quote;

*numeric = \&Vend::Table::DBI::numeric;

*filter = \&Vend::Table::DBI::filter;

*commit = \&Vend::Table::DBI::commit;

*rollback = \&Vend::Table::DBI::rollback;

*isopen = \&Vend::Table::DBI::isopen;

*column_index = \&Vend::Table::DBI::column_index;

*column_exists = \&Vend::Table::DBI::column_exists;

*bind_entire_row = \&Vend::Table::DBI::bind_entire_row;

*length_exception = \&Vend::Table::DBI::length_exception;

*fields_index = \&Vend::Table::DBI::fields_index;

*list_fields = \&Vend::Table::DBI::list_fields;

*touch = \&Vend::Table::DBI::touch;

*sort_each = \&Vend::Table::DBI::sort_each;

*each_record = \&Vend::Table::DBI::each_record;

*each_nokey = \&Vend::Table::DBI::each_nokey;

*sprintf_substitute = \&Vend::Table::DBI::sprintf_substitute;

*hash_query = \&Vend::Table::DBI::hash_query;

*query = \&Vend::Table::DBI::query;

*auto_config = \&Vend::Table::DBI::auto_config;

*config = \&Vend::Table::DBI::config;

*reset = \&Vend::Table::Common::reset;

*log_error = \&Vend::Table::Common::log_error;

*errstr = \&Vend::Table::Common::errstr;

1;

__END__