File Coverage

blib/lib/Brackup/Dict/SQLite.pm
Criterion Covered Total %
statement 54 59 91.5
branch 12 20 60.0
condition 2 3 66.6
subroutine 12 14 85.7
pod 0 8 0.0
total 80 104 76.9


line stmt bran cond sub pod time code
1             package Brackup::Dict::SQLite;
2 13     13   71 use strict;
  13         28  
  13         1589  
3 13     13   77 use warnings;
  13         27  
  13         293  
4 13     13   38845 use DBI;
  13         337553  
  13         1074  
5 13     13   21099 use DBD::SQLite;
  13         126601  
  13         10476  
6              
7             sub new {
8 15     15 0 177 my ($class, %opts) = @_;
9 15         345 my $self = bless {
10             table => $opts{table},
11             file => $opts{file},
12             data => {},
13             }, $class;
14              
15 15 50       443 my $dbh = $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$opts{file}","","", { RaiseError => 1, PrintError => 0 }) or
16             die "Failed to connect to SQLite filesystem digest cache database at $opts{file}: " . DBI->errstr;
17              
18 15         40776 eval {
19 15         184 $dbh->do("CREATE TABLE $opts{table} (key TEXT PRIMARY KEY, value TEXT)");
20             };
21 15 50 66     5111824 die "Error: $@" if $@ && $@ !~ /table \w+ already exists/;
22              
23 15         272 return $self;
24             }
25              
26             sub _reset {
27 15     15   28 my $self = shift;
28 15         49 $self->{data} = {};
29 15         61 $self->{keys} = [];
30 15         48 $self->{_loaded_keys} = 0;
31             }
32              
33             sub _load_all
34             {
35 15     15   29 my $self = shift;
36 15 50       420 unless ($self->{_loaded_all}++) {
37             # SQLite sucks at doing anything quickly (likes hundred thousand
38             # selects back-to-back), so we just suck the whole damn thing into
39             # a perl hash. cute, huh? then it doesn't have to
40             # open/read/seek/seek/seek/read/close for each select later.
41 15         62 $self->_reset;
42 15         663 my $sth = $self->{dbh}->prepare("SELECT key, value FROM $self->{table}");
43 15         5159 $sth->execute;
44 15         648 while (my ($k, $v) = $sth->fetchrow_array) {
45 43         1469 $self->{data}{$k} = $v;
46             }
47             }
48             }
49              
50             sub get {
51 322     322 0 1302 my ($self, $key) = @_;
52 322 100       2097 $self->_load_all unless $self->{_loaded_all};
53 322         4402 return $self->{data}{$key};
54             }
55              
56             sub set {
57 178     178 0 509 my ($self, $key, $val) = @_;
58 178         5526 $self->{dbh}->do("REPLACE INTO $self->{table} VALUES (?,?)", undef, $key, $val);
59 178         6120906 $self->{data}{$key} = $val;
60 178         3342 return 1;
61             }
62              
63             # Iterator interface, returning ($key, $value), and () on eod
64             sub each {
65 145     145 0 270 my $self = shift;
66 145 50       2208 $self->_load_all unless $self->{_loaded_all};
67 145 100       596 $self->{keys} = [ keys %{$self->{data}} ] unless $self->{_loaded_keys}++;
  11         148  
68 145 100       222 if (! @{$self->{keys}}) {
  145         508  
69 11         47 $self->{_loaded_keys} = 0;
70 11 50       142 return wantarray ? () : undef;
71             }
72 134         208 my $next = shift @{$self->{keys}};
  134         492  
73 134 50       1287 return wantarray ? ($next, $self->{data}{$next}) : $next;
74             }
75              
76             sub delete {
77 3     3 0 6 my ($self, $key) = @_;
78 3         56 $self->{dbh}->do("DELETE FROM $self->{table} WHERE key = ?", undef, $key);
79 3         60361 delete $self->{data}{$key};
80 3         48 return 1;
81             }
82              
83             sub count {
84 0     0 0 0 my $self = shift;
85 0 0       0 $self->_load_all unless $self->{_loaded_all};
86 0         0 return scalar keys %{$self->{data}};
  0         0  
87             }
88              
89             sub backing_file {
90 26     26 0 59 my $self = shift;
91 26         219 return $self->{file};
92             }
93              
94             sub wipe {
95 0     0 0   die "not implemented";
96             }
97              
98             1;
99              
100             __END__