# Copyright (c) 2003-2004 Kavod Technologies, Dan Browning. All rights reserved.
# This program is free software; you may redistribute it and/or modify it under
# the same terms as Perl itself. See LICENSE for more info.
=head1 NAME
Business::Shipping::Data - Database interface
=head1 VERSION
$Rev: 190 $
=head1 DESCRIPTION
Uses DBI for CSV file access.
=head1 METHODS
=cut
$VERSION = do { my $r = q$Rev: 190 $; $r =~ /\d+/; $&; };
@EXPORT = qw( record );
use strict;
use base ( 'Exporter' );
use DBI;
=head2 record( $table, $field, $key, $opt )
Performs a single-record lookup. Analagous to Interchange tag_data() function.
=cut
sub record
{
my ( $table, $field, $key, $opt ) = @_;
trace( 'called' );
my $key_column = $opt->{ foreign } || get_primary_key( $table );
return unless $key_column;
debug3( "key_column = $key_column" );
# Apparently, with DBD::CSV, '*' is required instead of the field name.
my $query = "SELECT * FROM $table WHERE $key_column = \'$key\'";
debug( $query );
my $sth = sth( $query )
or logdie "Could not get sth: $@";
my $hashref = $sth->fetchrow_hashref();
#debug3( "hashref = " . Dumper( $hashref ) );
return $hashref->{ $field };
}
=head2 sth()
Returns statement handle.
=cut
sub sth
{
my ( $query ) = @_;
return unless $query;
my $dbh = dbh();
my $sth = $dbh->prepare( $query )
or logdie "Cannot prepare: " . $dbh->errstr();
$sth->execute() or logdie "Cannot execute: " . $sth->errstr();;
return $sth;
}
=head2 dbh()
Returns database handle
=cut
sub dbh
{
if ( ! defined $::dbh_store ) {
$::dbh_store = {};
my $support_files = Business::Shipping::Config::support_files();
my $data_dir = Business::Shipping::Config::data_dir();
my $dsn = cfg()->{Database}{DSN} || "DBI:CSV:f_dir=$data_dir";
$dsn .= ";csv_eol=\n;";
my $dbh = DBI->connect( $dsn )
or logdie "Cannot connect: " . $DBI::errstr;
if ( $dsn =~ /^DBI:CSV/ ) {
# Try to find tables in the configuration that have
# extra settings.
foreach my $section ( cfg_obj()->Sections() ) {
if ( $section =~ /^Table_/ ) {
my $table = $section;
$table =~ s/^Table_.+_//;
my $table_attributes_hash = cfg()->{ $section };
$table_attributes_hash->{ file } ||= "$table.csv";
$table_attributes_hash->{ eol } =~ s/cr/\r/;
$table_attributes_hash->{ eol } =~ s/nl/\n/;
$table_attributes_hash->{ eol } ||= "\n";
#debug3( "adding special csv attributes for $table. They are:" . Dumper( $table_attributes_hash ) );
# TODO: only allow a restricted list of attributes to be set
# instead of letting anything in the config file be set.
$dbh->{ csv_tables }->{ $table } = $table_attributes_hash;
}
}
}
# Currently, only one DBH is allowed.
$::dbh_store->{ main } = $dbh;
}
return $::dbh_store->{ main };
}
=head2 get_primary_key
Takes a table and returns the name of the column that is the primary key.
=cut
sub get_primary_key
{
my ( $table ) = @_;
my $sth = sth( "select * from $table limit 1" );
# TODO: Use some DBI method to determine the real primary key
# Or, allow the primary key to be specified in the config.
#
# For now, we assume that the first column is the primary key.
return $sth->{ NAME }->[ 0 ];
}
1;
__END__
=head1 AUTHOR
Dan Browning E<lt>F<db@kavod.com>E<gt>, Kavod Technologies, L<http://www.kavod.com>.
=head1 COPYRIGHT AND LICENCE
Copyright (c) 2003-2004 Kavod Technologies, Dan Browning. All rights reserved.
This program is free software; you may redistribute it and/or modify it under
the same terms as Perl itself. See LICENSE for more info.
=cut