$VERSION
=
do
{
my
@r
=(
q$Revision: 1.2 $
=~/\d+/g);
sprintf
"%d."
.
"%03d"
x
$#r
,
@r
};
@EXPORT
=
qw( record )
;
use
base (
'Exporter'
,
'Business::Shipping'
);
sub
record
{
trace(
'called'
);
my
(
$table
,
$field
,
$key
,
$opt
) =
@_
;
my
$key_column
=
$opt
->{ foreign } || get_primary_key(
$table
);
return
unless
$key_column
;
debug3(
"key_column = $key_column"
);
my
$query
=
"SELECT * FROM $table WHERE $key_column = \'$key\'"
;
debug(
$query
);
my
$sth
= sth(
$query
)
or
die
"Could not get sth: $@"
;
my
$hashref
=
$sth
->fetchrow_hashref();
debug3(
"hashref = "
. Dumper(
$hashref
) );
return
$hashref
->{
$field
};
}
sub
sth
{
my
(
$query
) =
@_
;
return
unless
$query
;
my
$dbh
= dbh();
my
$sth
=
$dbh
->prepare(
$query
)
or
die
"Cannot prepare: "
.
$dbh
->errstr();
$sth
->execute() or
die
"Cannot execute: "
.
$sth
->errstr();;
return
$sth
;
}
sub
dbh
{
if
( !
defined
$::dbh_store ) {
$::dbh_store = {};
my
$support_files
= Business::Shipping::Config::support_files();
my
$dsn
= cfg()->{Database}{DSN} ||
"DBI:CSV:f_dir=$support_files/data"
;
$dsn
.=
";csv_eol=\n;"
;
my
$dbh
= DBI->
connect
(
$dsn
)
or
die
"Cannot connect: "
.
$DBI::errstr
;
if
(
$dsn
=~ /^DBI:CSV/ ) {
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
) );
$dbh
->{ csv_tables }->{
$table
} =
$table_attributes_hash
;
}
}
}
$::dbh_store->{ main } =
$dbh
;
}
return
$::dbh_store->{ main };
}
sub
get_primary_key
{
my
(
$table
) =
@_
;
my
$sth
= sth(
"SELECT * FROM $table LIMIT 1"
);
return
$sth
->{ NAME }->[ 0 ];
}
1;