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; |