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   7635 use strict;
  10         22  
  10         315  
5 10     10   51 use warnings;
  10         18  
  10         301  
6 10     10   53 use Scalar::Util qw/weaken/;
  10         22  
  10         11729  
7              
8             our $VERSION = '1.72';
9             our @ISA;
10              
11              
12             #----------------------------------------------------------------------
13             # methods for registering/destroying the module
14             #----------------------------------------------------------------------
15              
16 13     13 1 4298 sub CREATE_MODULE { my ($class, $mod_name) = @_; }
17 10     10 1 1650 sub DESTROY_MODULE { my ($class, $mod_name) = @_; }
18              
19             #----------------------------------------------------------------------
20             # methods for creating/destroying instances
21             #----------------------------------------------------------------------
22              
23 18     18 1 105 sub CREATE { my $class = shift; return $class->NEW(@_); }
  18         119  
24 2     2 1 26 sub CONNECT { my $class = shift; return $class->NEW(@_); }
  2         14  
25              
26             sub _PREPARE_SELF {
27 20     20   140 my ($class, $dbh_ref, $module_name, $db_name, $vtab_name, @args) = @_;
28              
29 20         66 my @columns;
30             my %options;
31              
32             # args containing '=' are options; others are column declarations
33 20         50 foreach my $arg (@args) {
34 61 100       284 if ($arg =~ /^([^=\s]+)\s*=\s*(.*)/) {
35 20         86 my ($key, $val) = ($1, $2);
36 20         125 $val =~ s/^"(.*)"$/$1/;
37 20         137 $options{$key} = $val;
38             }
39             else {
40 41         106 push @columns, $arg;
41             }
42             }
43              
44             # build $self
45 20         132 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         130 weaken $self->{dbh_ref};
54              
55 20         82 return $self;
56             }
57              
58             sub NEW {
59 5     5 1 13 my $class = shift;
60              
61 5         19 my $self = $class->_PREPARE_SELF(@_);
62 5         32 bless $self, $class;
63             }
64              
65              
66             sub VTAB_TO_DECLARE {
67 20     20 1 49 my $self = shift;
68              
69 20         43 local $" = ", ";
70 20         98 my $sql = "CREATE TABLE $self->{vtab_name}(@{$self->{columns}})";
  20         102  
71              
72 20         1937 return $sql;
73             }
74              
75 1     1 1 36 sub DROP { my $self = shift; }
76 16     16 1 13943 sub DISCONNECT { my $self = shift; }
77              
78              
79             #----------------------------------------------------------------------
80             # methods for initiating a search
81             #----------------------------------------------------------------------
82              
83             sub BEST_INDEX {
84 1     1 1 8 my ($self, $constraints, $order_by) = @_;
85              
86 1         3 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         7 my $outputs = {
94             idxNum => 1,
95             idxStr => "",
96             orderByConsumed => 0,
97             estimatedCost => 1.0,
98             estimatedRows => undef,
99             };
100              
101 1         29 return $outputs;
102             }
103              
104              
105             sub OPEN {
106 122     122   5315 my $self = shift;
107 122         270 my $class = ref $self;
108              
109 122         292 my $cursor_class = $class . "::Cursor";
110 122         633 return $cursor_class->NEW($self, @_);
111             }
112              
113              
114             #----------------------------------------------------------------------
115             # methods for insert/delete/update
116             #----------------------------------------------------------------------
117              
118             sub _SQLITE_UPDATE {
119 5     5   18 my ($self, $old_rowid, $new_rowid, @values) = @_;
120              
121 5 50       13 if (! defined $old_rowid) {
    0          
122 5         16 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 24 sub BEGIN_TRANSACTION {return 0}
155 21     21 1 37348 sub SYNC_TRANSACTION {return 0}
156 21     21 0 291 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 23 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 133 my $self = shift;
171 72         100 return ${$self->{dbh_ref}};
  72         346  
172             }
173              
174              
175             sub sqlite_table_info {
176 14     14 0 24 my $self = shift;
177              
178 14         57 my $sql = "PRAGMA table_info($self->{vtab_name})";
179 14         62 return $self->dbh->selectall_arrayref($sql, {Slice => {}});
180             }
181              
182             #======================================================================
183             package DBD::SQLite::VirtualTable::Cursor;
184             #======================================================================
185 10     10   96 use strict;
  10         23  
  10         294  
186 10     10   73 use warnings;
  10         23  
  10         2367  
187              
188             sub NEW {
189 122     122   327 my ($class, $vtable, @args) = @_;
190 122         394 my $self = {vtable => $vtable,
191             args => \@args};
192 122         1134 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__