package Simple::Abstraction;
use Carp;
use DBI;
use strict;
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();
our $VERSION = '0.33';
sub commit {
my ($parent, $args) = @_;
my ($self) = {};
bless ($self);
return undef unless (defined($parent->{dbh}));
print STDERR "Simple::Abstraction->commit - Not implemented at thi
+s time\n" if ($parent->{debug});
return;
};
sub connect {
my ($param) = shift;
my ($class) = ref($param) || $param;
my ($parent) = {};
bless ($parent, $class);
my (%args) = @_;
$parent->{debug} = ($args{'debug'} =~ /^\d+$/) ? $args{'debug'} :
+0;
$parent->{driver} = (length($args{'driver'})) ? $args{'driver'} :
+"Pg";
$parent->{username} = (length($args{'username'})) ? $args{'usernam
+e'} : undef;
$parent->{password} = (length($args{'password'})) ? $args{'passwor
+d'} : undef;
$parent->{database} = (length($args{'database'})) ? $args{'databas
+e'} : "test";
$parent->{hostname} = (length($args{'hostname'})) ? $args{'hostnam
+e'} : "localhost";
$parent->{dsn} = "DBI:" . $parent->{driver} . ":dbname=" . $parent
+->{database} . ";host=" . $parent->{hostname};
print STDERR "Simple::Abstraction->connect - Creating connection t
+o DSN '", $parent->{dsn}, "'\n" if ($parent->{debug});
unless ($parent->{dbh} = DBI->connect($parent->{dsn}, $parent->{us
+ername}, $parent->{password})) {
croak "Cannot connect to '", $parent->{dsn}, "' - ", $DBI::err
+str, "\n";
};
return ($parent);
};
sub disconnect {
my ($parent, $args) = @_;
unless ($parent->{dbh}->disconnect) {
croak "Cannot disconnect from '", $parent->{dsn}, "' - ", $DBI
+::errstr, "\n";
};
undef $parent;
return 1;
};
sub new {
my ($parent, $type, $args) = @_;
my ($self) = {};
bless ($self);
return undef unless (defined($parent->{dbh}));
$self->{type} = $type;
$self->{parent} = \$parent;
print STDERR "Simple::Abstraction->new - Creating new object of ty
+pe '", $self->{type}, "'\n" if (${$self->{parent}}->{debug});
if (ref($args) eq 'HASH') {
foreach my $param (keys(%{$args})) {
$$args{$param} =~ s/\"/\\\"/g;
eval qq/
\$self->{data}->{$param} = "$$args{$param}";
/;
print STDERR "Simple::Abstraction->new - Setting parameter
+ '", $param, "' for object of type '", $self->{type}, "'\n" if (${$se
+lf->{parent}}->{debug});
};
};
return ($self);
};
sub param {
my ($self) = shift;
my ($args) = @_;
return undef unless (defined($self->{type}));
if (ref($args) eq 'HASH') {
foreach my $param (keys(%{$args})) {
$$args{$param} =~ s/\"/\\\"/g;
eval qq/
\$self->{data}->{$param} = "$$args{$param}";
/;
print STDERR "Simple::Abstraction->param - Setting paramet
+er '", $param, "' for object of type '", $self->{type}, "'\n" if (${$
+self->{parent}}->{debug});
};
} elsif (defined($args)) {
my ($param) = $args;
if (defined($self->{data}->{$args})) {
print STDERR "Simple::Abstraction->param - Returning param
+eter '", $args, "' for object of type '", $self->{type}, "'\n" if (${
+$self->{parent}}->{debug});
return ($self->{data}->{$args});
};
} else {
return (keys (%{$self->{data}}));
};
return;
};
sub select_array {
my ($parent, $type, $args, $order) = @_;
my ($self) = {};
bless ($self);
return undef unless (defined($parent->{dbh}));
$self->{type} = $type;
my (@results);
print STDERR "Simple::Abstraction->select_array - Creating new arr
+ay for select results from table '", $self->{type}, "'\n" if ($parent
+->{debug});
my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}")
+;
$sth->execute;
my (@fields, @search);
for (my $index = 0; $index < $sth->{NUM_OF_FIELDS}; $index++) {
if (defined($$args{$sth->{NAME}->[$index]})) {
push (@search, $sth->{NAME}->[$index]." ~~ '".$$args{$sth-
+>{NAME}->[$index]}."'");
};
push (@fields, $sth->{NAME}->[$index]);
};
my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}"
+.
(($#search >= 0) ? " where ".join(" and ", @search) : undef) .
+
((ref($order) eq 'ARRAY') ? " order by ".join(", ", @{$order})
+ : undef)
);
$sth->execute;
while (my (@row) = $sth->fetchrow_array) {
my (%row);
foreach my $field (@fields) {
$row{$field} = shift(@row);
};
push (@results, $parent->new($self->{type}, \%row));
};
return (@results);
};
sub select_hash {
my ($parent, $type, $args) = @_;
my ($self) = {};
bless ($self);
return undef unless (defined($parent->{dbh}));
$self->{type} = $type;
my (%results);
print STDERR "Simple::Abstraction->select_hash - Creating new hash
+ for select results from table '", $self->{type}, "'\n" if ($parent->
+{debug});
my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}")
+;
$sth->execute;
my (@fields, @search);
for (my $index = 0; $index < $sth->{NUM_OF_FIELDS}; $index++) {
if (defined($$args{$sth->{NAME}->[$index]})) {
push (@search, $sth->{NAME}->[$index]." ~~ '".$$args{$sth-
+>{NAME}->[$index]}."'");
};
push (@fields, $sth->{NAME}->[$index]);
};
my ($sth) = $parent->{dbh}->prepare("select * from $self->{type}".
+(($#search >= 0) ? " where ".join(" and ", @search) : undef));
$sth->execute;
while (my (@row) = $sth->fetchrow_array) {
my (%row);
foreach my $field (@fields) {
$row{$field} = shift(@row);
};
my ($result) = $parent->new($self->{type}, \%row);
$results{$result->param($fields[0])} = $result;
};
return (%results);
};
1;
__END__