← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/mnt/catalyst/koha/C4/SQLHelper.pm
StatementsExecuted 25 statements in 4.31ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111493µs508µsC4::SQLHelper::::BEGIN@21C4::SQLHelper::BEGIN@21
11147µs47µsC4::SQLHelper::::BEGIN@47C4::SQLHelper::BEGIN@47
11112µs40µsC4::SQLHelper::::BEGIN@23C4::SQLHelper::BEGIN@23
1119µs18µsC4::SQLHelper::::BEGIN@22C4::SQLHelper::BEGIN@22
1118µs10µsC4::SQLHelper::::BEGIN@24C4::SQLHelper::BEGIN@24
1118µs59µsC4::SQLHelper::::BEGIN@26C4::SQLHelper::BEGIN@26
1117µs48µsC4::SQLHelper::::BEGIN@28C4::SQLHelper::BEGIN@28
1117µs26µsC4::SQLHelper::::BEGIN@25C4::SQLHelper::BEGIN@25
0000s0sC4::SQLHelper::::DeleteInTableC4::SQLHelper::DeleteInTable
0000s0sC4::SQLHelper::::GetPrimaryKeysC4::SQLHelper::GetPrimaryKeys
0000s0sC4::SQLHelper::::InsertInTableC4::SQLHelper::InsertInTable
0000s0sC4::SQLHelper::::SearchInTableC4::SQLHelper::SearchInTable
0000s0sC4::SQLHelper::::UpdateInTableC4::SQLHelper::UpdateInTable
0000s0sC4::SQLHelper::::_Process_OperandsC4::SQLHelper::_Process_Operands
0000s0sC4::SQLHelper::::__ANON__[:328]C4::SQLHelper::__ANON__[:328]
0000s0sC4::SQLHelper::::_filter_columnsC4::SQLHelper::_filter_columns
0000s0sC4::SQLHelper::::_filter_fieldsC4::SQLHelper::_filter_fields
0000s0sC4::SQLHelper::::_filter_hashC4::SQLHelper::_filter_hash
0000s0sC4::SQLHelper::::_filter_stringC4::SQLHelper::_filter_string
0000s0sC4::SQLHelper::::_get_columnsC4::SQLHelper::_get_columns
0000s0sC4::SQLHelper::::clear_columns_cacheC4::SQLHelper::clear_columns_cache
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::SQLHelper;
2
3# Copyright 2009 Biblibre SARL
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
21229µs2524µs
# spent 508µs (493+16) within C4::SQLHelper::BEGIN@21 which was called: # once (493µs+16µs) by C4::Members::BEGIN@35 at line 21
use strict;
# spent 508µs making 1 call to C4::SQLHelper::BEGIN@21 # spent 16µs making 1 call to strict::import
22226µs228µs
# spent 18µs (9+9) within C4::SQLHelper::BEGIN@22 which was called: # once (9µs+9µs) by C4::Members::BEGIN@35 at line 22
use warnings;
# spent 18µs making 1 call to C4::SQLHelper::BEGIN@22 # spent 9µs making 1 call to warnings::import
23224µs269µs
# spent 40µs (12+28) within C4::SQLHelper::BEGIN@23 which was called: # once (12µs+28µs) by C4::Members::BEGIN@35 at line 23
use List::MoreUtils qw(first_value any);
# spent 40µs making 1 call to C4::SQLHelper::BEGIN@23 # spent 28µs making 1 call to Exporter::import
24226µs213µs
# spent 10µs (8+2) within C4::SQLHelper::BEGIN@24 which was called: # once (8µs+2µs) by C4::Members::BEGIN@35 at line 24
use C4::Context;
# spent 10µs making 1 call to C4::SQLHelper::BEGIN@24 # spent 2µs making 1 call to C4::Context::import
25221µs245µs
# spent 26µs (7+19) within C4::SQLHelper::BEGIN@25 which was called: # once (7µs+19µs) by C4::Members::BEGIN@35 at line 25
use C4::Dates qw(format_date_in_iso);
# spent 26µs making 1 call to C4::SQLHelper::BEGIN@25 # spent 19µs making 1 call to Exporter::import
26230µs2110µs
# spent 59µs (8+51) within C4::SQLHelper::BEGIN@26 which was called: # once (8µs+51µs) by C4::Members::BEGIN@35 at line 26
use C4::Debug;
# spent 59µs making 1 call to C4::SQLHelper::BEGIN@26 # spent 51µs making 1 call to Exporter::import
2712µsrequire Exporter;
282609µs289µs
# spent 48µs (7+41) within C4::SQLHelper::BEGIN@28 which was called: # once (7µs+41µs) by C4::Members::BEGIN@35 at line 28
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
# spent 48µs making 1 call to C4::SQLHelper::BEGIN@28 # spent 41µs making 1 call to vars::import
29
301700nseval {
3116µs116µs my $servers = C4::Context->config('memcached_servers');
# spent 16µs making 1 call to C4::Context::config
321400ns if ($servers) {
33 require Memoize::Memcached;
34 import Memoize::Memcached qw(memoize_memcached);
35
36 my $memcached = {
37 servers => [$servers],
38 key_prefix => C4::Context->config('memcached_namespace') || 'koha',
39 expire_time => 600
40 }; # cache for 10 mins
41
42 memoize_memcached( '_get_columns', memcached => $memcached );
43 memoize_memcached( 'GetPrimaryKeys', memcached => $memcached );
44 }
45};
46
47
# spent 47µs within C4::SQLHelper::BEGIN@47 which was called: # once (47µs+0s) by C4::Members::BEGIN@35 at line 62
BEGIN {
48 # set the version for version checking
4917µs $VERSION = 3.07.00.049;
5016µs require Exporter;
51111µs @ISA = qw(Exporter);
5215µs@EXPORT_OK=qw(
53 InsertInTable
54 DeleteInTable
55 SearchInTable
56 UpdateInTable
57 GetPrimaryKeys
58 clear_columns_cache
59);
60114µs %EXPORT_TAGS = ( all =>[qw( InsertInTable DeleteInTable SearchInTable UpdateInTable GetPrimaryKeys)]
61 );
6213.49ms147µs}
# spent 47µs making 1 call to C4::SQLHelper::BEGIN@47
63
641100nsmy $tablename;
65my $hashref;
66
67=head1 NAME
68
69C4::SQLHelper - Perl Module containing convenience functions for SQL Handling
70
71=head1 SYNOPSIS
72
73use C4::SQLHelper;
74
75=head1 DESCRIPTION
76
77This module contains routines for adding, modifying and Searching Data in MysqlDB
78
79=head1 FUNCTIONS
80
81=head2 SearchInTable
82
83 $hashref = &SearchInTable($tablename,$data, $orderby, $limit,
84 $columns_out, $filtercolumns, $searchtype);
85
86
87$tablename Name of the table (string)
88
89$data may contain
90 - string
91
92 - data_hashref : will be considered as an AND of all the data searched
93
94 - data_array_ref on hashrefs : Will be considered as an OR of Datahasref elements
95
96$orderby is an arrayref of hashref with fieldnames as key and 0 or 1 as values (ASCENDING or DESCENDING order)
97
98$limit is an array ref on 2 values in order to limit results to MIN..MAX
99
100$columns_out is an array ref on field names is used to limit results on those fields (* by default)
101
102$filtercolums is an array ref on field names : is used to limit expansion of research for strings
103
104$searchtype is string Can be "start_with" or "exact"
105
106This query builder is very limited, it should be replaced with DBIx::Class
107or similar very soon
108Meanwhile adding support for special key '' in case of a data_hashref to
109support filters of type
110
111 ( f1 = a OR f2 = a ) AND fx = b AND fy = c
112
113Call for the query above is:
114
115 SearchInTable($tablename, {'' => a, fx => b, fy => c}, $orderby, $limit,
116 $columns_out, [f1, f2], 'exact');
117
118NOTE: Current implementation may remove parts of the iinput hashrefs. If that is a problem
119a copy needs to be created in _filter_fields() below
120
121=cut
122
123sub SearchInTable{
124 my ($tablename,$filters,$orderby, $limit, $columns_out, $filter_columns,$searchtype) = @_;
125 $searchtype||="exact";
126 my $dbh = C4::Context->dbh;
127 $columns_out||=["*"];
128 my $sql = do { local $"=', ';
129 qq{ SELECT @$columns_out from $tablename}
130 };
131 my $row;
132 my $sth;
133 my ($keys,$values)=_filter_fields($tablename,$filters,$searchtype,$filter_columns);
134 if ($keys){
135 my @criteria=grep{defined($_) && $_ !~/^\W$/ }@$keys;
136 if (@criteria) {
137 $sql.= do { local $"=') OR (';
138 qq{ WHERE (@criteria) }
139 };
140 }
141 }
142 if ($orderby){
143 #Order by desc by default
144 my @orders;
145 foreach my $order ( ref($orderby) ? @$orderby : $orderby ){
146 if (ref $order) {
147 push @orders,map{ "$_".($order->{$_}? " DESC " : "") } keys %$order;
148 } else {
149 push @orders,$order;
150 }
151 }
152 $sql.= do { local $"=', ';
153 qq{ ORDER BY @orders}
154 };
155 }
156 if ($limit){
157 $sql.=qq{ LIMIT }.join(",",@$limit);
158 }
159
160 $debug && $values && warn $sql," ",join(",",@$values);
161 $sth = $dbh->prepare_cached($sql);
162 eval{$sth->execute(@$values)};
163 warn $@ if ($@ && $debug);
164 my $results = $sth->fetchall_arrayref( {} );
165 return $results;
166}
167
168=head2 InsertInTable
169
170 $data_id_in_table = &InsertInTable($tablename,$data_hashref,$withprimarykeys);
171
172Insert Data in table and returns the id of the row inserted
173
174=cut
175
176sub InsertInTable{
177 my ($tablename,$data,$withprimarykeys) = @_;
178 my $dbh = C4::Context->dbh;
179 my ($keys,$values)=_filter_hash($tablename,$data,($withprimarykeys?"exact":0));
180 my $query = qq{ INSERT INTO $tablename SET }.join(", ",@$keys);
181
182 $debug && warn $query, join(",",@$values);
183 my $sth = $dbh->prepare_cached($query);
184 eval{$sth->execute(@$values)};
185 warn $@ if ($@ && $debug);
186
187 return $dbh->last_insert_id(undef, undef, $tablename, undef);
188}
189
190=head2 UpdateInTable
191
192 $status = &UpdateInTable($tablename,$data_hashref);
193
194Update Data in table and returns the status of the operation
195
196=cut
197
198sub UpdateInTable{
199 my ($tablename,$data) = @_;
200 my @field_ids=GetPrimaryKeys($tablename);
201 my @ids=@$data{@field_ids};
202 my $dbh = C4::Context->dbh;
203 my ($keys,$values)=_filter_hash($tablename,$data,0);
204 return unless ($keys);
205 my $query =
206 qq{ UPDATE $tablename
207 SET }.join(",",@$keys).qq{
208 WHERE }.join (" AND ",map{ "$_=?" }@field_ids);
209 $debug && warn $query, join(",",@$values,@ids);
210
211 my $sth = $dbh->prepare_cached($query);
212 my $result;
213 eval{$result=$sth->execute(@$values,@ids)};
214 warn $@ if ($@ && $debug);
215 return $result;
216}
217
218=head2 DeleteInTable
219
220 $status = &DeleteInTable($tablename,$data_hashref);
221
222Delete Data in table and returns the status of the operation
223
224=cut
225
226sub DeleteInTable{
227 my ($tablename,$data) = @_;
228 my $dbh = C4::Context->dbh;
229 my ($keys,$values)=_filter_fields($tablename,$data,1);
230 if ($keys){
231 my $query = do { local $"=') AND (';
232 qq{ DELETE FROM $tablename WHERE (@$keys)};
233 };
234 $debug && warn $query, join(",",@$values);
235 my $sth = $dbh->prepare_cached($query);
236 my $result;
237 eval{$result=$sth->execute(@$values)};
238 warn $@ if ($@ && $debug);
239 return $result;
240 }
241}
242
243=head2 GetPrimaryKeys
244
245 @primarykeys = &GetPrimaryKeys($tablename)
246
247Get the Primary Key field names of the table
248
249=cut
250
251sub GetPrimaryKeys {
252 my $tablename=shift;
253 my $hash_columns=_get_columns($tablename);
254 return grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns;
255}
256
257
258=head2 clear_columns_cache
259
260 C4::SQLHelper->clear_columns_cache();
261
262cleans the internal cache of sysprefs. Please call this method if
263you update a tables structure. Otherwise, your new changes
264will not be seen by this process.
265
266=cut
267
268sub clear_columns_cache {
269 %$hashref = ();
270}
271
- -
274=head2 _get_columns
275
276 _get_columns($tablename)
277
278Given a tablename
279Returns a hashref of all the fieldnames of the table
280With
281 Key
282 Type
283 Default
284
285=cut
286
287sub _get_columns {
288 my ($tablename) = @_;
289 unless ( exists( $hashref->{$tablename} ) ) {
290 my $dbh = C4::Context->dbh;
291 my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename });
292 $sth->execute;
293 my $columns = $sth->fetchall_hashref(qw(Field));
294 $hashref->{$tablename} = $columns;
295 }
296 return $hashref->{$tablename};
297}
298
299=head2 _filter_columns
300
301=over 4
302
303_filter_columns($tablename,$research, $filtercolumns)
304
305=back
306
307Given
308 - a tablename
309 - indicator on purpose whether all fields should be returned or only non Primary keys
310 - array_ref to columns to limit to
311
312Returns an array of all the fieldnames of the table
313If it is not for research purpose, filter primary keys
314
315=cut
316
317sub _filter_columns {
318 my ($tablename,$research, $filtercolumns)=@_;
319 if ($filtercolumns){
320 return (@$filtercolumns);
321 }
322 else {
323 my $columns=_get_columns($tablename);
324 if ($research){
325 return keys %$columns;
326 }
327 else {
328 return grep {my $column=$_; any {$_ ne $column }GetPrimaryKeys($tablename) } keys %$columns;
329 }
330 }
331}
332=head2 _filter_fields
333
334 _filter_fields
335
336Given
337 - a tablename
338 - a string or a hashref (containing, fieldnames and datatofilter) or an arrayref to one of those elements
339 - an indicator of operation whether it is a wide research or a narrow one
340 - an array ref to columns to restrict string filter to.
341
342Returns a ref of key array to use in SQL functions
343and a ref to value array
344
345=cut
346
347sub _filter_fields{
348 my ($tablename,$filter_input,$searchtype,$filtercolumns)=@_;
349 my @keys;
350 my @values;
351 if (ref($filter_input) eq "HASH"){
352 my ($keys, $values);
353 if (my $special = delete $filter_input->{''}) { # XXX destroyes '' key
354 ($keys, $values) = _filter_fields($tablename,$special, $searchtype,$filtercolumns);
355 }
356 my ($hkeys, $hvalues) = _filter_hash($tablename,$filter_input, $searchtype);
357 if ($hkeys){
358 push @$keys, @$hkeys;
359 push @$values, @$hvalues;
360 }
361 if ($keys){
362 my $stringkey="(".join (") AND (",@$keys).")";
363 return [$stringkey],$values;
364 }
365 else {
366 return ();
367 }
368 } elsif (ref($filter_input) eq "ARRAY"){
369 foreach my $element_data (@$filter_input){
370 my ($localkeys,$localvalues)=_filter_fields($tablename,$element_data,$searchtype,$filtercolumns);
371 if ($localkeys){
372 @$localkeys=grep{defined($_) && $_ !~/^\W*$/}@$localkeys;
373 my $string=do{
374 local $"=") OR (";
375 qq{(@$localkeys)}
376 };
377 push @keys, $string;
378 push @values, @$localvalues;
379 }
380 }
381 }
382 else{
383 $debug && warn "filterstring : $filter_input";
384 my ($keys, $values) = _filter_string($tablename,$filter_input, $searchtype,$filtercolumns);
385 if ($keys){
386 my $stringkey="(".join (") AND (",@$keys).")";
387 return [$stringkey],$values;
388 }
389 else {
390 return ();
391 }
392 }
393
394 return (\@keys,\@values);
395}
396
397sub _filter_hash{
398 my ($tablename,$filter_input, $searchtype)=@_;
399 my (@values, @keys);
400 my $columns= _get_columns($tablename);
401 my @columns_filtered= _filter_columns($tablename,$searchtype);
402
403 #Filter Primary Keys of table
404 my $elements=join "|",@columns_filtered;
405 foreach my $field (grep {/\b($elements)\b/} keys %$filter_input){
406 ## supposed to be a hash of simple values, hashes of arrays could be implemented
407 if ( $columns->{$field}{Type}=~/date/ ) {
408 if ( defined $filter_input->{$field} ) {
409 if ( $filter_input->{$field} eq q{} ) {
410 $filter_input->{$field} = undef;
411 } elsif ( $filter_input->{$field} !~ C4::Dates->regexp("iso") ) {
412 $filter_input->{$field} = format_date_in_iso($filter_input->{$field});
413 }
414 }
415 }
416 my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns);
417 if (@$tmpkeys){
418 push @values, @$localvalues;
419 push @keys, @$tmpkeys;
420 }
421 }
422 if (@keys){
423 return (\@keys,\@values);
424 }
425 else {
426 return ();
427 }
428}
429
430sub _filter_string{
431 my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_;
432 return () unless($filter_input);
433 my @operands=split /\s+/,$filter_input;
434
435 # An act of desperation
436 $searchtype = 'contain' if @operands > 1 && $searchtype =~ /start_with/o;
437
438 my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns);
439 my $columns= _get_columns($tablename);
440 my (@values,@keys);
441 foreach my $operand (@operands){
442 my @localkeys;
443 foreach my $field (@columns_filtered){
444 my ($tmpkeys, $localvalues)=_Process_Operands($operand,"$tablename.$field",$searchtype,$columns);
445 if ($tmpkeys){
446 push @values,@$localvalues;
447 push @localkeys,@$tmpkeys;
448 }
449 }
450 my $sql= join (' OR ', @localkeys);
451 push @keys, $sql;
452 }
453
454 if (@keys){
455 return (\@keys,\@values);
456 }
457 else {
458 return ();
459 }
460}
461sub _Process_Operands{
462 my ($operand, $field, $searchtype,$columns)=@_;
463 my @values;
464 my @tmpkeys;
465 my @localkeys;
466
467 $operand = [$operand] unless ref $operand eq 'ARRAY';
468 foreach (@$operand) {
469 push @tmpkeys, " $field = ? ";
470 push @values, $_;
471 }
472 #By default, exact search
473 if (!$searchtype ||$searchtype eq "exact"){
474 return \@tmpkeys,\@values;
475 }
476 my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field);
477 if ($field=~/(?<!zip)code|(?<!card)number/ && $searchtype ne "exact"){
478 push @tmpkeys,(" $field= '' ","$field IS NULL");
479 }
480 if ($columns->{$col_field}->{Type}=~/varchar|text/i){
481 my @localvaluesextended;
482 if ($searchtype eq "contain"){
483 foreach (@$operand) {
484 push @tmpkeys,(" $field LIKE ? ");
485 push @localvaluesextended,("\%$_\%") ;
486 }
487 }
488 if ($searchtype eq "field_start_with"){
489 foreach (@$operand) {
490 push @tmpkeys,("$field LIKE ?");
491 push @localvaluesextended, ("$_\%") ;
492 }
493 }
494 if ($searchtype eq "start_with"){
495 foreach (@$operand) {
496 push @tmpkeys,("$field LIKE ?","$field LIKE ?");
497 push @localvaluesextended, ("$_\%", " $_\%") ;
498 }
499 }
500 push @values,@localvaluesextended;
501 }
502 push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) };
503 return (\@localkeys,\@values);
504}
50518µs1;
506
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.