File Coverage

blib/lib/DBIx/SearchBuilder/Handle/SQLite.pm
Criterion Covered Total %
statement 61 72 84.7
branch 15 28 53.5
condition 10 20 50.0
subroutine 13 14 92.8
pod 8 9 88.8
total 107 143 74.8


line stmt bran cond sub pod time code
1              
2             package DBIx::SearchBuilder::Handle::SQLite;
3              
4 23     23   36078 use strict;
  23         66  
  23         703  
5 23     23   645 use warnings;
  23         49  
  23         683  
6              
7 23     23   121 use base qw(DBIx::SearchBuilder::Handle);
  23         48  
  23         18280  
8              
9             =head1 NAME
10              
11             DBIx::SearchBuilder::Handle::SQLite -- A SQLite specific Handle object
12              
13             =head1 SYNOPSIS
14              
15              
16             =head1 DESCRIPTION
17              
18             This module provides a subclass of DBIx::SearchBuilder::Handle that
19             compensates for some of the idiosyncrasies of SQLite.
20              
21             =head1 METHODS
22              
23             =head2 DatabaseVersion
24              
25             Returns the version of the SQLite library which is used, e.g., "2.8.0".
26             SQLite can only return short variant.
27              
28             =cut
29              
30             sub DatabaseVersion {
31 23     23 1 485 my $self = shift;
32 23 50       91 return '' unless $self->dbh;
33 23   50     71 return $self->dbh->{sqlite_version} || '';
34             }
35              
36             =head2 Insert
37              
38             Takes a table name as the first argument and assumes that the rest of the arguments
39             are an array of key-value pairs to be inserted.
40              
41             If the insert succeeds, returns the id of the insert, otherwise, returns
42             a Class::ReturnValue object with the error reported.
43              
44             =cut
45              
46             sub _last_insert_rowid {
47 160     160   373 my $self = shift;
48 160         419 my $table = shift;
49              
50 160         658 return $self->dbh->func('last_insert_rowid');
51              
52             # XXX: this is workaround nesty sqlite problem that
53             # last_insert_rowid in transaction is inaccurrate with multiple
54             # inserts.
55              
56 0 0       0 return $self->dbh->func('last_insert_rowid')
57             unless $self->TransactionDepth;
58              
59             # XXX: is the name of the column always id ?
60              
61 0         0 my $ret = $self->FetchResult("select max(id) from $table");
62 0         0 return $ret;
63             }
64              
65             sub Insert {
66 160     160 1 390 my $self = shift;
67 160         358 my $table = shift;
68              
69 160         670 my %args = ( id => undef, @_);
70             # We really don't want an empty id
71              
72 160         875 my $sth = $self->SUPER::Insert($table, %args);
73 160 50       937 return unless $sth;
74              
75             # If we have set an id, then we want to use that, otherwise, we want to lookup the last _new_ rowid
76 160   33     984 $self->{'id'}= $args{'id'} || $self->_last_insert_rowid($table);
77              
78 160 50       655 warn "$self no row id returned on row creation" unless ($self->{'id'});
79 160         3823 return( $self->{'id'}); #Add Succeded. return the id
80             }
81              
82              
83              
84             =head2 CaseSensitive
85              
86             Returns undef, since SQLite's searches are not case sensitive by default
87              
88             =cut
89              
90             sub CaseSensitive {
91 113     113 1 196 my $self = shift;
92 113         1347 return(1);
93             }
94              
95             sub BinarySafeBLOBs {
96 0     0 1 0 return undef;
97             }
98              
99             sub DistinctQuery {
100 96     96 1 161 my $self = shift;
101 96         177 my $statementref = shift;
102 96         139 my $sb = shift;
103              
104 96 100       250 return $self->SUPER::DistinctQuery( $statementref, $sb, @_ )
105             if $sb->_OrderClause !~ /(?
106              
107 32         127 local $sb->{'group_by'} = [{FIELD => 'id'}];
108             local $sb->{'order_by'} = [
109             map {
110             ($_->{'ALIAS'}||'') ne "main"
111 32 100 50     98 ? { %{$_}, FIELD => ((($_->{'ORDER'}||'') =~ /^des/i)?'MAX':'MIN') ."(".$_->{FIELD}.")" }
  32 50 50     326  
112             : $_
113             }
114 32         55 @{$sb->{'order_by'}}
  32         67  
115             ];
116 32         94 $$statementref = "SELECT main.* FROM $$statementref";
117 32         93 $$statementref .= $sb->_GroupClause;
118 32         91 $$statementref .= $sb->_OrderClause;
119             }
120              
121             =head2 DistinctCount STATEMENTREF
122              
123             takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result count
124              
125              
126             =cut
127              
128             sub DistinctCount {
129 41     41 1 75 my $self = shift;
130 41         1104 my $statementref = shift;
131 41         68 my $sb = shift;
132              
133 41         161 $$statementref = "SELECT count(*) FROM (SELECT DISTINCT main.id FROM $$statementref )";
134             }
135              
136             sub Fields {
137 2     2 0 586 my $self = shift;
138 2         6 my $table = shift;
139              
140 2         7 my $cache = \%DBIx::SearchBuilder::Handle::FIELDS_IN_TABLE;
141 2 50       40 unless ( $cache->{lc $table} ) {
142 2 50       31 my $info = $self->dbh->selectall_arrayref("PRAGMA table_info('$table')")
143             or return ();
144              
145 2         401 foreach my $e ( @$info ) {
146 4   100     10 push @{ $cache->{ lc $table } ||= [] }, lc $e->[1];
  4         31  
147             }
148             }
149              
150 2 100       7 return @{ $cache->{ lc $table } || [] };
  2         33  
151             }
152              
153             =head2 SimpleDateTimeFunctions
154              
155             Returns hash reference with specific date time functions of this
156             database for L.
157              
158             =cut
159              
160             sub SimpleDateTimeFunctions {
161 20     20 1 33 my $self = shift;
162             return $self->{'_simple_date_time_functions'} ||= {
163 20   100     101 %{ $self->SUPER::SimpleDateTimeFunctions(@_) },
  1         8  
164             datetime => 'datetime(?)',
165             time => 'time(?)',
166              
167             hourly => "strftime('%Y-%m-%d %H', ?)",
168             hour => "strftime('%H', ?)",
169              
170             date => 'date(?)',
171             daily => 'date(?)',
172              
173             day => "strftime('%d', ?)",
174             dayofmonth => "strftime('%d', ?)",
175              
176             monthly => "strftime('%Y-%m', ?)",
177             month => "strftime('%m', ?)",
178              
179             annually => "strftime('%Y', ?)",
180             year => "strftime('%Y', ?)",
181              
182             dayofweek => "strftime('%w', ?)",
183             dayofyear => "strftime('%j', ?)",
184             weekofyear => "strftime('%W', ?)",
185             };
186             }
187              
188             sub ConvertTimezoneFunction {
189 2     2 1 5 my $self = shift;
190 2         11 my %args = (
191             From => 'UTC',
192             To => undef,
193             Field => '',
194             @_
195             );
196 2 100 66     22 return $args{'Field'} unless $args{From} && $args{'To'};
197 1 50       15 return $args{'Field'} if lc $args{From} eq lc $args{'To'};
198              
199 0         0 my $res;
200 0 0 0     0 if ( lc($args{'To'}||'') eq 'utc' ) {
    0 0        
201 0         0 $res = "datetime($args{'Field'}, 'utc')";
202             }
203             elsif ( lc($args{'From'}||'') eq 'utc' ) {
204 0         0 $res = "datetime($args{'Field'}, 'localtime')";
205             }
206             else {
207 0         0 warn "SQLite only supports TZ convesion from UTC or to UTC";
208 0         0 $res = $args{'Field'};
209             }
210 0         0 return $res;
211             }
212              
213             sub _DateTimeIntervalFunction {
214 2     2   4 my $self = shift;
215 2         7 my %args = ( From => undef, To => undef, @_ );
216              
217 2         17 return "strftime('%s',$args{'To'}) - strftime('%s',$args{'From'})";
218             }
219              
220             1;