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   36155 use strict;
  23         61  
  23         707  
5 23     23   118 use warnings;
  23         48  
  23         764  
6              
7 23     23   125 use base qw(DBIx::SearchBuilder::Handle);
  23         91  
  23         18090  
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 465 my $self = shift;
32 23 50       90 return '' unless $self->dbh;
33 23   50     83 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 159     159   324 my $self = shift;
48 159         371 my $table = shift;
49              
50 159         617 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 159     159 1 357 my $self = shift;
67 159         287 my $table = shift;
68              
69 159         664 my %args = ( id => undef, @_);
70             # We really don't want an empty id
71              
72 159         755 my $sth = $self->SUPER::Insert($table, %args);
73 159 50       805 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 159   33     982 $self->{'id'}= $args{'id'} || $self->_last_insert_rowid($table);
77              
78 159 50       579 warn "$self no row id returned on row creation" unless ($self->{'id'});
79 159         3262 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 97     97 1 177 my $self = shift;
92 97         1189 return(1);
93             }
94              
95             sub BinarySafeBLOBs {
96 0     0 1 0 return undef;
97             }
98              
99             sub DistinctQuery {
100 80     80 1 136 my $self = shift;
101 80         122 my $statementref = shift;
102 80         120 my $sb = shift;
103              
104 80 100       182 return $self->SUPER::DistinctQuery( $statementref, $sb, @_ )
105             if $sb->_OrderClause !~ /(?
106              
107 32         134 local $sb->{'group_by'} = [{FIELD => 'id'}];
108             local $sb->{'order_by'} = [
109             map {
110             ($_->{'ALIAS'}||'') ne "main"
111 32 100 50     100 ? { %{$_}, FIELD => ((($_->{'ORDER'}||'') =~ /^des/i)?'MAX':'MIN') ."(".$_->{FIELD}.")" }
  32 50 50     266  
112             : $_
113             }
114 32         55 @{$sb->{'order_by'}}
  32         69  
115             ];
116 32         93 $$statementref = "SELECT main.* FROM $$statementref";
117 32         80 $$statementref .= $sb->_GroupClause;
118 32         110 $$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 29     29 1 54 my $self = shift;
130 29         48 my $statementref = shift;
131 29         48 my $sb = shift;
132              
133 29         111 $$statementref = "SELECT count(*) FROM (SELECT DISTINCT main.id FROM $$statementref )";
134             }
135              
136             sub Fields {
137 2     2 0 398 my $self = shift;
138 2         4 my $table = shift;
139              
140 2         4 my $cache = \%DBIx::SearchBuilder::Handle::FIELDS_IN_TABLE;
141 2 50       34 unless ( $cache->{lc $table} ) {
142 2 50       24 my $info = $self->dbh->selectall_arrayref("PRAGMA table_info('$table')")
143             or return ();
144              
145 2         299 foreach my $e ( @$info ) {
146 4   100     6 push @{ $cache->{ lc $table } ||= [] }, lc $e->[1];
  4         23  
147             }
148             }
149              
150 2 100       4 return @{ $cache->{ lc $table } || [] };
  2         22  
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 32 my $self = shift;
162             return $self->{'_simple_date_time_functions'} ||= {
163 20   100     91 %{ $self->SUPER::SimpleDateTimeFunctions(@_) },
  1         23  
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         12 my %args = (
191             From => 'UTC',
192             To => undef,
193             Field => '',
194             @_
195             );
196 2 100 66     17 return $args{'Field'} unless $args{From} && $args{'To'};
197 1 50       19 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   5 my $self = shift;
215 2         7 my %args = ( From => undef, To => undef, @_ );
216              
217 2         15 return "strftime('%s',$args{'To'}) - strftime('%s',$args{'From'})";
218             }
219              
220             1;