File Coverage

blib/lib/ClearPress/driver.pm

Criterion	Covered	Total	%
statement	74	79	93.6
branch	6	6	100.0
condition	9	12	75.0
subroutine	17	19	89.4
pod	10	10	100.0
total	116	126	92.0

# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
# vim:ts=8:sw=2:et:sta:sts=2
#########
# Author: rmp
# Created: 2006-10-31
#
package ClearPress::driver;
use strict;
use warnings;
use Carp;
use ClearPress::driver::mysql;
use ClearPress::driver::SQLite;
use DBI;
use English qw(-no_match_vars);
use Carp;

our $VERSION = q[477.1.4];

sub new {
  my ($class, $ref) = @_;
  $ref ||= {};
  bless $ref, $class;
  return $ref;
}

sub dbh {
  my $self = shift;
  carp q[dbh unimplemented];
  return;
}

sub new_driver {
  my ($self, $drivername, $ref) = @_;

  my $drvpkg = "ClearPress::driver::$drivername";
  return $drvpkg->new({
		       drivername => $drivername,
		       %{$ref},
		      });
}

sub DESTROY {
  my $self = shift;

  if($self->{dbh} && $self->{dbh}->ping()) {
    #########
    # flush down any uncommitted transactions & locks
    #
    $self->{dbh}->rollback();
    $self->{dbh}->disconnect();
  }

  return 1;
}

sub create_table {
  my ($self, $t_name, $ref, $t_attrs) = @_;
  my $dbh    = $self->dbh();
  $t_attrs ||= {};
  $ref     ||= {};

  my %values = reverse %{$ref};
  my $pk     = $values{'primary key'};

  if(!$pk) {
    croak qq[Could not determine primary key for table $t_name];
  }

  my @fields = (qq[$pk @{[$self->type_map('primary key')]}]);

  for my $f (grep { $_ ne $pk } keys %{$ref}) {
    push @fields, qq[$f @{[$self->type_map($ref->{$f})]}];
  }

  my $desc  = join q[, ], @fields;
  my $attrs = join q[ ], map { "$_=$t_attrs->{$_}" } keys %{$t_attrs};

  $dbh->do(qq[CREATE TABLE $t_name($desc) $attrs]);
  $dbh->commit();

  return 1;
}

sub drop_table {
  my ($self, $table_name) = @_;
  my $dbh = $self->dbh();

  $dbh->do(qq[DROP TABLE IF EXISTS $table_name]);
  $dbh->commit();

  return 1;
}

sub types {
  return {};
}

sub type_map {
  my ($self, $type) = @_;
  if(!defined $type) {
    return;
  }
  return $self->types->{$type} || $type;
}

sub create {
  return;
}

sub bounded_select {
  my ($self, $query, $start, $len) = @_;
  carp q[bounded_select unimplemented by driver ], ref $self;
  return q[];
}

sub sth_has_warnings {
  my ($self, $sth) = @_;
  return;
}

1;
__END__