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