package DBManager;
use strict;
use warnings;
use DBI;
use Date::Manip;
use Class::Singleton;
our @ISA = qw(Class::Singleton);
1;
sub _new_instance {
my $type = shift;
my $class = ref $type || $type;
die "DBManager::instance must be invoked as DBManager->instance" if ! defined $class;
my $dbh = DBI->connect("dbi:SQLite:databasefilename", "", "");
die "Cannot connect to database: $DBI::errstr\n"
unless defined $dbh;
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;
return bless {dbh => $dbh}, $class;
}
sub DESTROY {
my $self = shift;
$self->{dbh}->disconnect () if defined $self->{dbh};
}
package DBObject;
require Exporter;
our @ISA = ('Exporter');
our @EXPORT = qw(new);
sub new {
my ($class, %params) = @_;
die "DBObject::new must be invoked as DBObject->new"
unless defined $class;
die "A table definition (tableDef => ['name', 'column info'] is required by $class->new ()"
unless 'ARRAY' eq ref $params{tableDef};
die "database handle must be from a DBManager derived object"
if exists $params{db} and ! $params{db}->isa ('DBManager');
my $self = bless {%params}, $class;
my %cols = map {s/^\s*//; s/\s*$//; /(\w+)\s*(.*)/; $1 => $2}
split /,/, $params{tableDef}[1];
$self->{cols} = \%cols;
$self->setDbh ();
return $self;
}
sub DESTROY {
my $self = shift;
$self->{db} = undef;
}
####
sub setDbh {
my ($self) = @_;
$self->{db} = DBManager->instance ();
my $dbh = $self->{db}->{dbh};
my ($tableName, $columns) = @{$self->{tableDef}};
eval {
$dbh->do ("CREATE TABLE IF NOT EXISTS $tableName ($columns)");
$dbh->commit ();
$self->{tableName} = $tableName;
};
die "$@" if $@;
}
sub dbh {
my $self = shift;
my $db = $self->{db};
die ref($self) . " requires a database handle to complete an action"
unless defined $db and $db->isa ('DBManager');
return $db->{dbh};
}
sub insert {
my ($self, %params) = @_;
my $dbh = $self->dbh ();
my $mustCreate = 0;
for (keys %params) {
if (lc eq 'create') {
$mustCreate = 1;
delete $params{create};
next;
}
$self->{values}{$_} ||= $params{$_};
}
my $colVals = '';
my $colList = '';
# Build column and value compare strings
for my $col (keys %{$self->{cols}}) {
my $type = $self->{cols}{$col};
next if $col eq 'id';
if (! exists $self->{values}{$col} or ! defined $self->{values}{$col}) {
die "Value for $col missing in " . ref ($self) . "->insert ()\n"
if $type =~ /NOT NULL/i;
next;
}
$colVals .= "'$self->{values}{$col}',";
$colList .= "$col, ";
}
# Trim bogus trailing stuff
s/,\s*$// for $colList, $colVals;
my $results = $self->fetch_all (%params);
die "Record to be inserted exists in " . ref ($self) . "->insert ()\n"
if %$results and $mustCreate;
# create record if it doesn't exist already
if (! %$results) {
# Insert the record
my $stmt = "INSERT INTO $self->{tableName} ($colList) VALUES ($colVals)";
$dbh->do ($stmt);
$dbh->commit ();
# Fetch newly inserted record
$results = $self->fetch_all (%params);
}
($self->{id}) = keys %$results;
delete $self->{values};
return $self->{id};
}
sub delete {
my ($self) = @_;
my $dbh = $self->dbh ();
die "id required for delete" if ! defined $self->{id};
eval {
$dbh->do ("DELETE FROM $self->{tableDef}[0] WHERE id = '$self->{id}'");
$dbh->commit ();
$self->{id} = undef;
};
if ($@) {
$dbh->rollback ();
die "Delete failed: $@";
}
}
sub update {
my ($self, %params) = @_;
my $dbh = $self->dbh ();
die "Assignment pairs must be provided in a values hash for Update"
if ! exists $params{values};
$params{match}{id} = $self->{id}
unless exists $params{match} and defined $params{match};
eval {
my $results = $self->fetch_all (%{$params{match}});
die "Record matching update spec not found" if ! %$results;
my $assignments = '';
for my $col (keys %{$params{values}}) {
die "Bogus column name $col" unless exists $self->{cols}{$col};
$assignments .= "$col = '$params{values}{$col}', ";
}
# Trim bogus trailing stuff
$assignments =~ s/,\s*$//;
# Update the record
my ($id) = keys %$results;
my $stmt = "UPDATE $self->{tableName} SET $assignments WHERE id = $id";
$dbh->do ($stmt);
$dbh->commit ();
};
if ($@) {
$dbh->rollback ();
die "update failed: $@";
}
return $self->{id};
}
sub fetch {
my ($self, %params) = @_;
$params{id} = '$self->{id}' unless %params;
my $colMatch = $self->BuildMatchList (%params);
my $stmt = "SELECT ALL * FROM $self->{tableDef}[0] $colMatch";
my $sth = $self->dbh ()->prepare ($stmt);
$sth->execute ();
return $sth->fetchrow_hashref ();
}
sub fetch_all {
my ($self, %params) = @_;
my $colMatch = '';
$colMatch = $self->BuildMatchList (%params)
unless exists $params{match} and $params{match} eq 'ALL';
my $stmt = "SELECT ALL * FROM $self->{tableDef}[0] $colMatch";
my $sth = $self->dbh ()->prepare ($stmt);
$sth->execute ();
return $sth->fetchall_hashref ('id');
}
sub BuildMatchList {
my ($self, %params) = @_;
my $colMatch = '';
# Build column compare strings
for my $col (keys %params) {
die "Bogus column name $col" unless exists $self->{cols}{$col};
$colMatch .= $col;
if ('ARRAY' eq ref $params{$col}) {
$colMatch .= $params{$col}[0];
} else {
$colMatch .= ' = ';
if ($params{$col} =~ /'/) {
$colMatch .= "$params{$col}";
} else {
$colMatch .= "'$params{$col}'";
}
}
$colMatch .= " AND ";
}
# Trim bogus trailing stuff
$colMatch =~ s/ AND $//;
$colMatch = "WHERE $colMatch" if length $colMatch;
return $colMatch;
}
####
1;
package Group;
use base 'DBObject';
require Exporter;
our @ISA = ('DBObject');
our @EXPORT = qw( );
my $groupTableDef = ['groups',
'id INTEGER PRIMARY KEY NOT NULL,
groupid INTEGER NOT NULL,
user INTEGER NOT NULL'
];
sub new {
my ($class, %params) = @_;
$params{tableDef} = $groupTableDef unless exists $params {tableDef};
return $class->SUPER::new (%params);
}
1;
####
my $task = Task->new;
my $now = Date::Manip::ParseDate ('today');
my $tasks = $task->fetch_all (starts => ["<= '$now'"]);
my @readyTasks =
sort {$a->{starts} cmp $b->{starts}} values %$tasks;