File Coverage

blib/lib/UnQLite.pm
Criterion Covered Total %
statement 89 126 70.6
branch 29 72 40.2
condition 5 9 55.5
subroutine 27 28 96.4
pod 3 3 100.0
total 153 238 64.2


line stmt bran cond sub pod time code
1             package UnQLite;
2 4     4   108302 use 5.008005;
  4         13  
  4         138  
3 4     4   15 use strict;
  4         6  
  4         106  
4 4     4   23 use warnings;
  4         6  
  4         105  
5 4     4   13 use Carp ();
  4         5  
  4         120  
6              
7             our $VERSION = "0.05";
8             our $rc = 0;
9              
10 4     4   15 use XSLoader;
  4         11  
  4         4355  
11             XSLoader::load(__PACKAGE__, $VERSION);
12              
13             sub TIEHASH {
14 1     1   8481 my $class = shift;
15 1 50       100 my $self = $class->open(@_) or Carp::croak $class->errstr;
16 1         4 $self->cursor_init;
17             }
18              
19             sub rc {
20 7     7 1 952402 my $self = shift;
21 7         44 my $_rc = _rc($self);
22 7 50       34 defined $_rc ? $rc = $_rc : $rc;
23             }
24              
25             sub errstr {
26 4     4 1 6 my $self = shift;
27 4         8 my $rc = $self->rc;
28 4 100       19 if ($rc==UnQLite::UNQLITE_OK()) { return "UNQLITE_OK" }
  1         3  
29 3 50       12 if ($rc==UNQLITE_NOMEM()) { return "UNQLITE_NOMEM" }
  0         0  
30 3 50       19 if ($rc==UNQLITE_ABORT()) { return "UNQLITE_ABORT" }
  0         0  
31 3 100       9 if ($rc==UNQLITE_IOERR()) { return "UNQLITE_IOERR" }
  1         7  
32 2 50       6 if ($rc==UNQLITE_CORRUPT()) { return "UNQLITE_CORRUPT" }
  0         0  
33 2 50       4 if ($rc==UNQLITE_LOCKED()) { return "UNQLITE_LOCKED" }
  0         0  
34 2 50       7 if ($rc==UNQLITE_BUSY()) { return "UNQLITE_BUSY" }
  0         0  
35 2 50       7 if ($rc==UNQLITE_DONE()) { return "UNQLITE_DONE" }
  0         0  
36 2 50       7 if ($rc==UNQLITE_PERM()) { return "UNQLITE_PERM" }
  0         0  
37 2 50       4 if ($rc==UNQLITE_NOTIMPLEMENTED()) { return "UNQLITE_NOTIMPLEMENTED" }
  0         0  
38 2 50       4 if ($rc==UNQLITE_NOTFOUND()) { return "UNQLITE_NOTFOUND" }
  2         4  
39 0 0       0 if ($rc==UNQLITE_NOOP()) { return "UNQLITE_NOOP" }
  0         0  
40 0 0       0 if ($rc==UNQLITE_INVALID()) { return "UNQLITE_INVALID" }
  0         0  
41 0 0       0 if ($rc==UNQLITE_EOF()) { return "UNQLITE_EOF" }
  0         0  
42 0 0       0 if ($rc==UNQLITE_UNKNOWN()) { return "UNQLITE_UNKNOWN" }
  0         0  
43 0 0       0 if ($rc==UNQLITE_LIMIT()) { return "UNQLITE_LIMIT" }
  0         0  
44 0 0       0 if ($rc==UNQLITE_EXISTS()) { return "UNQLITE_EXISTS" }
  0         0  
45 0 0       0 if ($rc==UNQLITE_EMPTY()) { return "UNQLITE_EMPTY" }
  0         0  
46 0 0       0 if ($rc==UNQLITE_COMPILE_ERR()) { return "UNQLITE_COMPILE_ERR" }
  0         0  
47 0 0       0 if ($rc==UNQLITE_VM_ERR()) { return "UNQLITE_VM_ERR" }
  0         0  
48 0 0       0 if ($rc==UNQLITE_FULL()) { return "UNQLITE_FULL" }
  0         0  
49 0 0       0 if ($rc==UNQLITE_CANTOPEN()) { return "UNQLITE_CANTOPEN" }
  0         0  
50 0 0       0 if ($rc==UNQLITE_READ_ONLY()) { return "UNQLITE_READ_ONLY" }
  0         0  
51 0 0       0 if ($rc==UNQLITE_LOCKERR()) { return "UNQLITE_LOCKERR" }
  0         0  
52             }
53              
54             sub cursor_init {
55 5     5 1 35243 my $self = shift;
56 5         50 bless [$self->_cursor_init(), $self], 'UnQLite::Cursor';
57             }
58              
59             package UnQLite::Cursor;
60              
61             sub rc {
62 0     0   0 my $self = shift;
63 0         0 my $_rc = _rc($self->[0]);
64 0 0       0 defined $_rc ? $UnQLite::rc = $_rc : $UnQLite::rc;
65             }
66              
67             sub first_entry {
68 9     9   14 my $self = shift;
69 9         74 _first_entry($self->[0]);
70             }
71              
72             sub key {
73 10     10   11 my $self = shift;
74 10         60 _key($self->[0]);
75             }
76              
77             sub data {
78 6     6   9 my $self = shift;
79 6         37 _data ($self->[0]);
80             }
81              
82             sub next_entry {
83 10     10   10 my $self = shift;
84 10         49 _next_entry($self->[0]);
85             }
86              
87             sub valid_entry {
88 14     14   18 my $self = shift;
89 14         57 _valid_entry($self->[0]);
90             }
91              
92             sub seek {
93 2     2   5 my $self = shift;
94 2         15 _seek($self->[0], @_);
95             }
96              
97             sub delete_entry {
98 3     3   5 my $self = shift;
99 3         22 _delete_entry($self->[0]);
100             }
101              
102             sub prev_entry {
103 2     2   3 my $self = shift;
104 2         12 _prev_entry($self->[0]);
105             }
106              
107             sub last_entry {
108 1     1   4 my $self = shift;
109 1         6 _last_entry($self->[0]);
110             }
111              
112             sub DESTROY {
113 5     5   1302 my $self = shift;
114 5         6820 _release($self->[0], $self->[1]);
115             }
116              
117             # tie interface
118              
119             sub FETCH {
120 4     4   43 my ($self, $key) = @_;
121 4         175 $self->[1]->kv_fetch($key);
122             }
123              
124             sub STORE {
125 2     2   665 my ($self, $key, $value) = @_;
126 2 50       232 $self->[1]->kv_store($key, $value) or Carp::croak $self->[1]->errstr;
127 2         11 $value;
128             }
129              
130             sub DELETE {
131 2     2   9 my ($self, $key) = @_;
132 2         11 my $prev = $self->[1]->kv_fetch($key);
133 2         6 my $errstr = $self->[1]->errstr;
134 2 100 66     15 return unless $errstr && $errstr eq 'UNQLITE_OK';
135 1 50       6 $self->[1]->kv_delete($key) or Carp::croak $self->[1]->errstr;
136 1         6 $prev;
137             }
138              
139             sub FIRSTKEY {
140 4     4   8 my $self = shift;
141 4 100       31 $self->first_entry or return;
142 2         6 $self->key;
143             }
144              
145             sub NEXTKEY {
146 4     4   5 my $self = shift;
147 4 100       8 $self->next_entry or return;
148 2         4 $self->key;
149             }
150              
151             sub EXISTS {
152 2     2   3 my ($self, $key) = @_;
153 2 100       16 $self->[1]->kv_fetch($key) and return 1;
154 1         23 my $errstr = $self->[1]->errstr;
155 1 50 33     12 return $errstr && $errstr eq 'UNQLITE_OK' ? 1 : 0;
156             }
157              
158             sub CLEAR {
159 1     1   3 my $self = shift;
160 1 50       2 $self->first_entry or return;
161 1         2 $self->delete_entry while $self->valid_entry;
162 1         3 return;
163             }
164              
165             sub SCALAR {
166 2     2   4 my $self = shift;
167 2 100       3 $self->first_entry or return;
168 1         1 my $ct = 1;
169 1   66     3 $ct++ while $self->next_entry && $self->valid_entry;
170 1         3 return $ct;
171             }
172              
173             1;
174             __END__