File Coverage

blib/lib/DBIx/SearchBuilder/Handle/mysql.pm
Criterion Covered Total %
statement 20 140 14.2
branch 4 66 6.0
condition 0 18 0.0
subroutine 6 21 28.5
pod 10 13 76.9
total 40 258 15.5


line stmt bran cond sub pod time code
1             package DBIx::SearchBuilder::Handle::mysql;
2              
3 2     2   2560 use strict;
  2         5  
  2         58  
4 2     2   10 use warnings;
  2         4  
  2         48  
5 2     2   10 use version;
  2         4  
  2         15  
6              
7 2     2   190 use base qw(DBIx::SearchBuilder::Handle);
  2         4  
  2         4407  
8              
9             =head1 NAME
10              
11             DBIx::SearchBuilder::Handle::mysql - A mysql 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 MySQL.
20              
21             =head1 METHODS
22              
23             =head2 Insert
24              
25             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.
26              
27             If the insert succeeds, returns the id of the insert, otherwise, returns
28             a Class::ReturnValue object with the error reported.
29              
30             =cut
31              
32             sub Insert {
33 0     0 1 0 my $self = shift;
34              
35 0         0 my $sth = $self->SUPER::Insert(@_);
36 0 0       0 if (!$sth) {
37 0         0 return ($sth);
38             }
39              
40 0         0 $self->{'id'}=$self->dbh->{'mysql_insertid'};
41              
42             # Yay. we get to work around mysql_insertid being null some of the time :/
43 0 0       0 unless ($self->{'id'}) {
44 0         0 $self->{'id'} = $self->FetchResult('SELECT LAST_INSERT_ID()');
45             }
46 0 0       0 warn "$self no row id returned on row creation" unless ($self->{'id'});
47              
48 0         0 return( $self->{'id'}); #Add Succeded. return the id
49             }
50              
51              
52             =head2 SimpleUpdateFromSelect
53              
54             Customization of L.
55             Mysql doesn't support update with subqueries when those fetch data from
56             the table that is updated.
57              
58             =cut
59              
60             sub SimpleUpdateFromSelect {
61 0     0 1 0 my ($self, $table, $values, $query, @query_binds) = @_;
62              
63 0 0       0 return $self->SUPER::SimpleUpdateFromSelect(
64             $table, $values, $query, @query_binds
65             ) unless $query =~ /\b\Q$table\E\b/i;
66              
67 0         0 my $sth = $self->SimpleQuery( $query, @query_binds );
68 0 0       0 return $sth unless $sth;
69              
70 0         0 my (@binds, @columns);
71 0         0 for my $k (sort keys %$values) {
72 0         0 push @columns, $k;
73 0         0 push @binds, $values->{$k};
74             }
75              
76 0 0       0 $table = $self->QuoteName($table) if $self->{'QuoteTableNames'};
77 0         0 my $update_query = "UPDATE $table SET "
78             . join( ', ', map "$_ = ?", @columns )
79             .' WHERE ID IN ';
80              
81 0         0 return $self->SimpleMassChangeFromSelect(
82             $update_query, \@binds,
83             $query, @query_binds
84             );
85             }
86              
87              
88             sub DeleteFromSelect {
89 0     0 0 0 my ($self, $table, $query, @query_binds) = @_;
90              
91 0 0       0 return $self->SUPER::DeleteFromSelect(
92             $table, $query, @query_binds
93             ) unless $query =~ /\b\Q$table\E\b/i;
94              
95 0 0       0 $table = $self->QuoteName($table) if $self->{'QuoteTableNames'};
96 0         0 return $self->SimpleMassChangeFromSelect(
97             "DELETE FROM $table WHERE id IN ", [],
98             $query, @query_binds
99             );
100             }
101              
102             sub SimpleMassChangeFromSelect {
103 0     0 0 0 my ($self, $update_query, $update_binds, $search, @search_binds) = @_;
104              
105 0         0 my $sth = $self->SimpleQuery( $search, @search_binds );
106 0 0       0 return $sth unless $sth;
107              
108              
109             # tried TEMPORARY tables, much slower than fetching and delete
110             # also size of ENGINE=MEMORY is limitted by option, on disk
111             # tables more slower than in memory
112 0         0 my $res = 0;
113              
114 0         0 my @ids;
115 0         0 while ( my $id = ($sth->fetchrow_array)[0] ) {
116 0         0 push @ids, $id;
117 0 0       0 next if @ids < 1000;
118              
119 0         0 my $q = $update_query .'('. join( ',', ('?')x@ids ) .')';
120 0         0 my $sth = $self->SimpleQuery( $q, @$update_binds, splice @ids );
121 0 0       0 return $sth unless $sth;
122              
123 0         0 $res += $sth->rows;
124             }
125 0 0       0 if ( @ids ) {
126 0         0 my $q = $update_query .'('. join( ',', ('?')x@ids ) .')';
127 0         0 my $sth = $self->SimpleQuery( $q, @$update_binds, splice @ids );
128 0 0       0 return $sth unless $sth;
129              
130 0         0 $res += $sth->rows;
131             }
132 0 0       0 return $res == 0? '0E0': $res;
133             }
134              
135             =head2 DatabaseVersion
136              
137             Returns the mysql version, trimming off any -foo identifier
138              
139             =cut
140              
141             sub DatabaseVersion {
142 0     0 1 0 my $self = shift;
143 0         0 my $v = $self->SUPER::DatabaseVersion();
144              
145 0         0 $v =~ s/\-.*$//;
146 0         0 return ($v);
147             }
148              
149             =head2 CaseSensitive
150              
151             Returns undef, since mysql's searches are not case sensitive by default
152              
153             =cut
154              
155             sub CaseSensitive {
156 0     0 1 0 my $self = shift;
157 0         0 return(undef);
158             }
159              
160             sub DistinctQuery {
161 0     0 1 0 my $self = shift;
162 0         0 my $statementref = shift;
163 0         0 my $sb = shift;
164              
165 0 0       0 return $self->SUPER::DistinctQuery( $statementref, $sb, @_ )
166             if $sb->_OrderClause !~ /(?
167              
168 0 0       0 if ( substr($self->DatabaseVersion, 0, 1) == 4 ) {
169 0         0 local $sb->{'group_by'} = [{FIELD => 'id'}];
170              
171 0         0 my ($idx, @tmp, @specials) = (0, ());
172 0         0 foreach ( @{$sb->{'order_by'}} ) {
  0         0  
173 0 0 0     0 if ( !exists $_->{'ALIAS'} || ($_->{'ALIAS'}||'') eq "main" ) {
      0        
174 0         0 push @tmp, $_; next;
  0         0  
175             }
176              
177             push @specials,
178             ((($_->{'ORDER'}||'') =~ /^des/i)?'MAX':'MIN')
179 0 0 0     0 ."(". $_->{'ALIAS'} .".". $_->{'FIELD'} .")"
180             ." __special_sort_$idx";
181 0         0 push @tmp, { ALIAS => '', FIELD => "__special_sort_$idx", ORDER => $_->{'ORDER'} };
182 0         0 $idx++;
183             }
184              
185 0         0 local $sb->{'order_by'} = \@tmp;
186 0         0 $$statementref = "SELECT ". join( ", ", 'main.*', @specials ) ." FROM $$statementref";
187 0         0 $$statementref .= $sb->_GroupClause;
188 0         0 $$statementref .= $sb->_OrderClause;
189             } else {
190 0         0 local $sb->{'group_by'} = [{FIELD => 'id'}];
191             local $sb->{'order_by'} = [
192             map {
193             ($_->{'ALIAS'}||'') ne "main"
194 0 0 0     0 ? { %{$_}, FIELD => ((($_->{'ORDER'}||'') =~ /^des/i)?'MAX':'MIN') ."(".$_->{FIELD}.")" }
  0 0 0     0  
195             : $_
196             }
197 0         0 @{$sb->{'order_by'}}
  0         0  
198             ];
199 0         0 $$statementref = "SELECT main.* FROM $$statementref";
200 0         0 $$statementref .= $sb->_GroupClause;
201 0         0 $$statementref .= $sb->_OrderClause;
202             }
203             }
204              
205             sub Fields {
206 0     0 0 0 my $self = shift;
207 0         0 my $table = shift;
208              
209 0         0 my $cache = \%DBIx::SearchBuilder::Handle::FIELDS_IN_TABLE;
210 0 0       0 unless ( $cache->{ lc $table } ) {
211 0 0       0 my $sth = $self->dbh->column_info( undef, undef, $table, '%' )
212             or return ();
213 0         0 my $info = $sth->fetchall_arrayref({});
214 0         0 foreach my $e ( sort {$a->{'ORDINAL_POSITION'} <=> $b->{'ORDINAL_POSITION'}} @$info ) {
  0         0  
215 0   0     0 push @{ $cache->{ lc $e->{'TABLE_NAME'} } ||= [] }, lc $e->{'COLUMN_NAME'};
  0         0  
216             }
217             }
218 0 0       0 return @{ $cache->{ lc $table } || [] };
  0         0  
219             }
220              
221             =head2 SimpleDateTimeFunctions
222              
223             Returns hash reference with specific date time functions of this
224             database for L.
225              
226             =cut
227              
228             sub SimpleDateTimeFunctions {
229 0     0 1 0 my $self = shift;
230             return $self->{'_simple_date_time_functions'} ||= {
231 0   0     0 %{ $self->SUPER::SimpleDateTimeFunctions(@_) },
  0         0  
232             datetime => '?',
233             time => 'TIME(?)',
234              
235             hourly => "DATE_FORMAT(?, '%Y-%m-%d %H')",
236             hour => 'HOUR(?)',
237              
238             date => 'DATE(?)',
239             daily => 'DATE(?)',
240              
241             day => 'DAYOFMONTH(?)',
242             dayofmonth => 'DAYOFMONTH(?)',
243              
244             monthly => "DATE_FORMAT(?, '%Y-%m')",
245             month => 'MONTH(?)',
246              
247             annually => 'YEAR(?)',
248             year => 'YEAR(?)',
249              
250             dayofweek => "DAYOFWEEK(?) - 1", # 1-7, 1 - Sunday
251             dayofyear => "DAYOFYEAR(?)", # 1-366
252             weekofyear => "WEEK(?)", # skip mode argument, so it can be controlled in mysql config
253             };
254             }
255              
256              
257             =head2 ConvertTimezoneFunction
258              
259             Custom implementation of L.
260              
261             Use the following query to get list of timezones:
262              
263             SELECT Name FROM mysql.time_zone_name;
264              
265             Read docs about keeping timezone data up to date:
266              
267             http://dev.mysql.com/doc/refman/5.5/en/time-zone-upgrades.html
268              
269             =cut
270              
271             sub ConvertTimezoneFunction {
272 0     0 1 0 my $self = shift;
273 0         0 my %args = (
274             From => 'UTC',
275             To => undef,
276             Field => '',
277             @_
278             );
279 0 0 0     0 return $args{'Field'} unless $args{From} && $args{'To'};
280 0 0       0 return $args{'Field'} if lc $args{From} eq lc $args{'To'};
281 0         0 my $dbh = $self->dbh;
282 0         0 $_ = $dbh->quote( $_ ) foreach @args{'From', 'To'};
283 0         0 return "CONVERT_TZ( $args{'Field'}, $args{'From'}, $args{'To'} )";
284             }
285              
286             sub _DateTimeIntervalFunction {
287 0     0   0 my $self = shift;
288 0         0 my %args = ( From => undef, To => undef, @_ );
289              
290 0         0 return "TIMESTAMPDIFF(SECOND, $args{'From'}, $args{'To'})";
291             }
292              
293              
294             =head2 QuoteName
295              
296             Quote table or column name to avoid reserved word errors.
297              
298             =cut
299              
300             # over-rides inherited method
301             sub QuoteName {
302 1     1 1 9 my ($self, $name) = @_;
303             # use dbi built in quoting if we have a connection,
304 1 50       7 if ($self->dbh) {
305 0         0 return $self->SUPER::QuoteName($name);
306             }
307              
308 1         10 return sprintf('`%s`', $name);
309             }
310              
311             sub DequoteName {
312 4     4 1 13 my ($self, $name) = @_;
313              
314             # If we have a handle, the base class can do it for us
315 4 50       13 if ($self->dbh) {
316 0         0 return $self->SUPER::DequoteName($name);
317             }
318              
319 4 100       19 if ($name =~ /^`(.*)`$/) {
320 1         6 return $1;
321             }
322 3         15 return $name;
323             }
324              
325             sub _ExtractBindValues {
326 0     0     my $self = shift;
327 0           my $value = shift;
328 0           return $self->SUPER::_ExtractBindValues( $value, '\\' );
329             }
330              
331             sub _IsMariaDB {
332 0     0     my $self = shift;
333              
334             # We override DatabaseVersion to chop off "-MariaDB-whatever", so
335             # call super here to get the original version
336 0           my $v = $self->SUPER::DatabaseVersion();
337              
338 0           return ($v =~ /mariadb/i);
339             }
340              
341             sub _RequireQuotedTables {
342 0     0     my $self = shift;
343              
344             # MariaDB version does not match mysql, and hasn't added new reserved words
345 0 0         return 0 if $self->_IsMariaDB;
346              
347 0           my $version = $self->DatabaseVersion;
348              
349             # Get major version number by chopping off everything after the first "."
350 0           $version =~ s/\..*//;
351 0 0         if ( $version >= 8 ) {
352 0           return 1;
353             }
354 0           return 0;
355             }
356              
357             =head2 HasSupportForCombineSearchAndCount
358              
359             MariaDB 10.2+ and MySQL 8+ support this.
360              
361             =cut
362              
363             sub HasSupportForCombineSearchAndCount {
364 0     0 1   my $self = shift;
365 0           my ($version) = $self->DatabaseVersion =~ /^(\d+\.\d+)/;
366              
367 0 0         if ( $self->_IsMariaDB ) {
368 0 0         return (version->parse('v'.$version) >= version->parse('v10.2')) ? 1 : 0;
369             }
370             else {
371 0 0         return (version->parse('v'.$version) >= version->parse('v8')) ? 1 : 0;
372             }
373             }
374              
375             1;