File Coverage

blib/lib/NNexus/DB.pm

Criterion	Covered	Total	%
statement	41	60	68.3
branch	5	12	41.6
condition	6	13	46.1
subroutine	8	15	53.3
pod	4	10	40.0
total	64	110	58.1

# /=====================================================================\ #
# |  NNexus Autolinker                                                  | #
# | Database Interface Module                                           | #
# |=====================================================================| #
# | Part of the Planetary project: http://trac.mathweb.org/planetary    | #
# |  Research software, produced as part of work done by:               | #
# |  the KWARC group at Jacobs University                               | #
# | Copyright (c) 2012                                                  | #
# | Released under the MIT License (MIT)                                | #
# |---------------------------------------------------------------------| #
# | Adapted from the original NNexus code by                            | #
# |                                  James Gardner and Aaron Krowne     | #
# |---------------------------------------------------------------------| #
# | Deyan Ginev                   #_#     | #
# | http://kwarc.info/people/dginev                            (o o)    | #
# \=========================================================ooo==U==ooo=/ #
package NNexus::DB;
use strict;
use warnings;
use DBI;
use NNexus::DB::API;
# Design: One database handle per NNexus::DB object
#  ideally lightweight, only store DB-specific data in the object

sub new {
  my ($class,%input)=@_;
  # White-list the options we care about:
  my %options;
  $options{dbuser} = $input{dbuser};
  $options{dbpass} = $input{dbpass};
  $options{dbname} = $input{dbname};
  $options{dbhost} = $input{dbhost};
  $options{dbms} = $input{dbms};
  $options{query_cache} = $input{query_cache} || {};
  $options{handle} = $input{handle};
  my $self = bless \%options, $class;
  if (($options{dbms} eq 'SQLite') && ((! -f $options{dbname})||(-z $options{dbname}))) {
    # Auto-vivify a new SQLite database, if not already created
    if (! -f $options{dbname}) {
      # Touch a file if it doesn't exist
      my $now = time;
      utime $now, $now, $options{dbname};
    }
    $self->reset_db;
  }
  return $self;
}

# Methods:

# safe - adverb for connection to the database and returning a handle for further "deeds"
sub safe {
  my ($self)=@_;
  if (defined $self->{handle} && $self->{handle}->ping) {
    return $self->{handle};
  } else {
    my $dbh = DBI->connect("DBI:". $self->{dbms} .
			   ":" . $self->{dbname},
			   $self->{dbuser},
			   $self->{dbpass},
			   {
			    host => $self->{'dbhost'},
			    RaiseError => 1,
          AutoCommit => 1
			   }) || die "Could not connect to database: $DBI::errstr";
    $dbh->do('PRAGMA cache_size=50000;') if $self->{dbms} eq 'SQLite';
    $self->{handle}=$dbh;
    $self->_recover_cache;
    return $dbh;
  }
}

# done - adverb for cleaning up. Disconnects and deletes the statement cache

sub done {
  my ($self,$dbh)=@_;
  $dbh = $self->{handle} unless defined $dbh;
  $dbh->disconnect();
  $self->{handle}=undef;
}

###  Safe interfaces for the DBI methods

sub disconnect { done(@_); } # Synonym for done
sub do {
  my ($self,@args) = @_;
  $self->safe->do(@args); }
sub execute {
  my ($self,@args) = @_;
  $self->safe->execute(@args); }
sub ping {
  my ($self,@args) = @_;
  $self->safe->ping(@args); }
sub selectrow_array {
  my ($self,@args) = @_;
  $self->safe->selectrow_array(@args); }
sub selectall_arrayref {
  my ($self,@args) = @_;
  $self->safe->selectall_arrayref(@args); }

sub prepare {
  # Performs an SQL statement prepare and returns, maintaining a cache of already
  # prepared statements for potential re-use..
  #
  # NOTE: it is only useful to use these for immutable statements, with bind
  # variables or no variables.
  my ($self,$statement) = @_;
  my $query_cache = $self->{query_cache};
  if (! exists $query_cache->{$statement}) {
    $query_cache->{$statement} = $self->safe->prepare($statement);
  }
  return $query_cache->{$statement};
}

### Internal helper routines:

sub _recover_cache {
  my ($self) = @_;
  my $query_cache = $self->{query_cache};
  foreach my $statement (keys %$query_cache) {
    $query_cache->{$statement} = $self->safe->prepare($statement);
  }
}

1;
__END__