File Coverage

blib/lib/DBD/SQLite/VirtualTable.pm
Criterion Covered Total %
statement 67 93 72.0
branch 3 6 50.0
condition n/a
subroutine 24 37 64.8
pod 20 22 90.9
total 114 158 72.1


line stmt bran cond sub pod time code
1             #======================================================================
2             package DBD::SQLite::VirtualTable;
3             #======================================================================
4 10     10   7470 use strict;
  10         21  
  10         339  
5 10     10   56 use warnings;
  10         22  
  10         413  
6 10     10   66 use Scalar::Util qw/weaken/;
  10         25  
  10         13978  
7              
8             our $VERSION = '1.73_01';
9             our @ISA;
10              
11              
12             #----------------------------------------------------------------------
13             # methods for registering/destroying the module
14             #----------------------------------------------------------------------
15              
16 13     13 1 4321 sub CREATE_MODULE { my ($class, $mod_name) = @_; }
17 10     10 1 1713 sub DESTROY_MODULE { my ($class, $mod_name) = @_; }
18              
19             #----------------------------------------------------------------------
20             # methods for creating/destroying instances
21             #----------------------------------------------------------------------
22              
23 18     18 1 148 sub CREATE { my $class = shift; return $class->NEW(@_); }
  18         92  
24 2     2 1 20 sub CONNECT { my $class = shift; return $class->NEW(@_); }
  2         12  
25              
26             sub _PREPARE_SELF {
27 20     20   153 my ($class, $dbh_ref, $module_name, $db_name, $vtab_name, @args) = @_;
28              
29 20         52 my @columns;
30             my %options;
31              
32             # args containing '=' are options; others are column declarations
33 20         62 foreach my $arg (@args) {
34 61 100       385 if ($arg =~ /^([^=\s]+)\s*=\s*(.*)/) {
35 20         97 my ($key, $val) = ($1, $2);
36 20         139 $val =~ s/^"(.*)"$/$1/;
37 20         143 $options{$key} = $val;
38             }
39             else {
40 41         100 push @columns, $arg;
41             }
42             }
43              
44             # build $self
45 20         128 my $self = {
46             dbh_ref => $dbh_ref,
47             module_name => $module_name,
48             db_name => $db_name,
49             vtab_name => $vtab_name,
50             columns => \@columns,
51             options => \%options,
52             };
53 20         110 weaken $self->{dbh_ref};
54              
55 20         75 return $self;
56             }
57              
58             sub NEW {
59 5     5 1 10 my $class = shift;
60              
61 5         18 my $self = $class->_PREPARE_SELF(@_);
62 5         33 bless $self, $class;
63             }
64              
65              
66             sub VTAB_TO_DECLARE {
67 20     20 1 42 my $self = shift;
68              
69 20         44 local $" = ", ";
70 20         93 my $sql = "CREATE TABLE $self->{vtab_name}(@{$self->{columns}})";
  20         92  
71              
72 20         989 return $sql;
73             }
74              
75 1     1 1 32 sub DROP { my $self = shift; }
76 16     16 1 14479 sub DISCONNECT { my $self = shift; }
77              
78              
79             #----------------------------------------------------------------------
80             # methods for initiating a search
81             #----------------------------------------------------------------------
82              
83             sub BEST_INDEX {
84 1     1 1 6 my ($self, $constraints, $order_by) = @_;
85              
86 1         2 my $ix = 0;
87 1         4 foreach my $constraint (grep {$_->{usable}} @$constraints) {
  0         0  
88 0         0 $constraint->{argvIndex} = $ix++;
89 0         0 $constraint->{omit} = 0;
90             }
91              
92             # stupid default values -- subclasses should put real values instead
93 1         6 my $outputs = {
94             idxNum => 1,
95             idxStr => "",
96             orderByConsumed => 0,
97             estimatedCost => 1.0,
98             estimatedRows => undef,
99             };
100              
101 1         27 return $outputs;
102             }
103              
104              
105             sub OPEN {
106 122     122   6167 my $self = shift;
107 122         290 my $class = ref $self;
108              
109 122         286 my $cursor_class = $class . "::Cursor";
110 122         680 return $cursor_class->NEW($self, @_);
111             }
112              
113              
114             #----------------------------------------------------------------------
115             # methods for insert/delete/update
116             #----------------------------------------------------------------------
117              
118             sub _SQLITE_UPDATE {
119 5     5   16 my ($self, $old_rowid, $new_rowid, @values) = @_;
120              
121 5 50       13 if (! defined $old_rowid) {
    0          
122 5         25 return $self->INSERT($new_rowid, @values);
123             }
124             elsif (!@values) {
125 0         0 return $self->DELETE($old_rowid);
126             }
127             else {
128 0         0 return $self->UPDATE($old_rowid, $new_rowid, @values);
129             }
130             }
131              
132             sub INSERT {
133 0     0 1 0 my ($self, $new_rowid, @values) = @_;
134              
135 0         0 die "INSERT() should be redefined in subclass";
136             }
137              
138             sub DELETE {
139 0     0   0 my ($self, $old_rowid) = @_;
140              
141 0         0 die "DELETE() should be redefined in subclass";
142             }
143              
144             sub UPDATE {
145 0     0 1 0 my ($self, $old_rowid, $new_rowid, @values) = @_;
146              
147 0         0 die "UPDATE() should be redefined in subclass";
148             }
149              
150             #----------------------------------------------------------------------
151             # remaining methods of the sqlite API
152             #----------------------------------------------------------------------
153              
154 3     3 1 27 sub BEGIN_TRANSACTION {return 0}
155 21     21 1 46475 sub SYNC_TRANSACTION {return 0}
156 21     21 0 335 sub COMMIT_TRANSACTION {return 0}
157 0     0 1 0 sub ROLLBACK_TRANSACTION {return 0}
158 0     0 1 0 sub SAVEPOINT {return 0}
159 0     0 1 0 sub RELEASE {return 0}
160 0     0 1 0 sub ROLLBACK_TO {return 0}
161 1     1 1 21 sub FIND_FUNCTION {return 0}
162 0     0 1 0 sub RENAME {return 0}
163              
164              
165             #----------------------------------------------------------------------
166             # utility methods
167             #----------------------------------------------------------------------
168              
169             sub dbh {
170 72     72 1 148 my $self = shift;
171 72         114 return ${$self->{dbh_ref}};
  72         414  
172             }
173              
174              
175             sub sqlite_table_info {
176 14     14 0 27 my $self = shift;
177              
178 14         58 my $sql = "PRAGMA table_info($self->{vtab_name})";
179 14         60 return $self->dbh->selectall_arrayref($sql, {Slice => {}});
180             }
181              
182             #======================================================================
183             package DBD::SQLite::VirtualTable::Cursor;
184             #======================================================================
185 10     10   91 use strict;
  10         23  
  10         355  
186 10     10   66 use warnings;
  10         24  
  10         2854  
187              
188             sub NEW {
189 122     122   342 my ($class, $vtable, @args) = @_;
190 122         403 my $self = {vtable => $vtable,
191             args => \@args};
192 122         1232 bless $self, $class;
193             }
194              
195              
196             sub FILTER {
197 0     0     my ($self, $idxNum, $idxStr, @values) = @_;
198 0           die "FILTER() should be redefined in cursor subclass";
199             }
200              
201             sub EOF {
202 0     0     my ($self) = @_;
203 0           die "EOF() should be redefined in cursor subclass";
204             }
205              
206             sub NEXT {
207 0     0     my ($self) = @_;
208 0           die "NEXT() should be redefined in cursor subclass";
209             }
210              
211             sub COLUMN {
212 0     0     my ($self, $idxCol) = @_;
213 0           die "COLUMN() should be redefined in cursor subclass";
214             }
215              
216             sub ROWID {
217 0     0     my ($self) = @_;
218 0           die "ROWID() should be redefined in cursor subclass";
219             }
220              
221              
222             1;
223              
224             __END__