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


line stmt bran cond sub pod time code
1             # /=====================================================================\ #
2             # | NNexus Autolinker | #
3             # | Database Interface Module | #
4             # |=====================================================================| #
5             # | Part of the Planetary project: http://trac.mathweb.org/planetary | #
6             # | Research software, produced as part of work done by: | #
7             # | the KWARC group at Jacobs University | #
8             # | Copyright (c) 2012 | #
9             # | Released under the MIT License (MIT) | #
10             # |---------------------------------------------------------------------| #
11             # | Adapted from the original NNexus code by | #
12             # | James Gardner and Aaron Krowne | #
13             # |---------------------------------------------------------------------| #
14             # | Deyan Ginev #_# | #
15             # | http://kwarc.info/people/dginev (o o) | #
16             # \=========================================================ooo==U==ooo=/ #
17             package NNexus::DB;
18 3     3   17924 use strict;
  3         4  
  3         99  
19 3     3   10 use warnings;
  3         4  
  3         67  
20 3     3   4210 use DBI;
  3         39007  
  3         218  
21 3     3   1469 use NNexus::DB::API;
  3         9  
  3         1935  
22             # Design: One database handle per NNexus::DB object
23             # ideally lightweight, only store DB-specific data in the object
24              
25             sub new {
26 1     1 1 21 my ($class,%input)=@_;
27             # White-list the options we care about:
28 1         2 my %options;
29 1         3 $options{dbuser} = $input{dbuser};
30 1         3 $options{dbpass} = $input{dbpass};
31 1         1 $options{dbname} = $input{dbname};
32 1         2 $options{dbhost} = $input{dbhost};
33 1         17 $options{dbms} = $input{dbms};
34 1   50     10 $options{query_cache} = $input{query_cache} || {};
35 1         2 $options{handle} = $input{handle};
36 1         2 my $self = bless \%options, $class;
37 1 50 33     18 if (($options{dbms} eq 'SQLite') && ((! -f $options{dbname})||(-z $options{dbname}))) {
      33        
38             # Auto-vivify a new SQLite database, if not already created
39 1 50       4 if (! -f $options{dbname}) {
40             # Touch a file if it doesn't exist
41 1         9 my $now = time;
42 1         18 utime $now, $now, $options{dbname};
43             }
44 1         5 $self->reset_db;
45             }
46 1         142 return $self;
47             }
48              
49             # Methods:
50              
51             # safe - adverb for connection to the database and returning a handle for further "deeds"
52             sub safe {
53 2     2 1 4 my ($self)=@_;
54 2 100 66     19 if (defined $self->{handle} && $self->{handle}->ping) {
55 1         57 return $self->{handle};
56             } else {
57 1   50     14 my $dbh = DBI->connect("DBI:". $self->{dbms} .
58             ":" . $self->{dbname},
59             $self->{dbuser},
60             $self->{dbpass},
61             {
62             host => $self->{'dbhost'},
63             RaiseError => 1,
64             AutoCommit => 1
65             }) || die "Could not connect to database: $DBI::errstr";
66 1 50       8916 $dbh->do('PRAGMA cache_size=50000;') if $self->{dbms} eq 'SQLite';
67 1         256 $self->{handle}=$dbh;
68 1         5 $self->_recover_cache;
69 1         4 return $dbh;
70             }
71             }
72              
73             # done - adverb for cleaning up. Disconnects and deletes the statement cache
74              
75             sub done {
76 0     0 1 0 my ($self,$dbh)=@_;
77 0 0       0 $dbh = $self->{handle} unless defined $dbh;
78 0         0 $dbh->disconnect();
79 0         0 $self->{handle}=undef;
80             }
81              
82             ### Safe interfaces for the DBI methods
83              
84 0     0 0 0 sub disconnect { done(@_); } # Synonym for done
85             sub do {
86 0     0 0 0 my ($self,@args) = @_;
87 0         0 $self->safe->do(@args); }
88             sub execute {
89 0     0 0 0 my ($self,@args) = @_;
90 0         0 $self->safe->execute(@args); }
91             sub ping {
92 1     1 0 334 my ($self,@args) = @_;
93 1         3 $self->safe->ping(@args); }
94             sub selectrow_array {
95 0     0 0 0 my ($self,@args) = @_;
96 0         0 $self->safe->selectrow_array(@args); }
97             sub selectall_arrayref {
98 0     0 0 0 my ($self,@args) = @_;
99 0         0 $self->safe->selectall_arrayref(@args); }
100              
101             sub prepare {
102             # Performs an SQL statement prepare and returns, maintaining a cache of already
103             # prepared statements for potential re-use..
104             #
105             # NOTE: it is only useful to use these for immutable statements, with bind
106             # variables or no variables.
107 0     0 1 0 my ($self,$statement) = @_;
108 0         0 my $query_cache = $self->{query_cache};
109 0 0       0 if (! exists $query_cache->{$statement}) {
110 0         0 $query_cache->{$statement} = $self->safe->prepare($statement);
111             }
112 0         0 return $query_cache->{$statement};
113             }
114              
115             ### Internal helper routines:
116              
117             sub _recover_cache {
118 1     1   2 my ($self) = @_;
119 1         2 my $query_cache = $self->{query_cache};
120 1         4 foreach my $statement (keys %$query_cache) {
121 0           $query_cache->{$statement} = $self->safe->prepare($statement);
122             }
123             }
124              
125             1;
126             __END__