← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:24 2013

Filename/usr/share/koha/lib/C4/SQLHelper.pm
StatementsExecuted 33 statements in 2.83ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111734µs1.29msC4::SQLHelper::::BEGIN@23C4::SQLHelper::BEGIN@23
11121µs21µsC4::SQLHelper::::BEGIN@47C4::SQLHelper::BEGIN@47
11116µs20µsC4::SQLHelper::::BEGIN@21C4::SQLHelper::BEGIN@21
11112µs34µsC4::SQLHelper::::BEGIN@22C4::SQLHelper::BEGIN@22
11112µs125µsC4::SQLHelper::::BEGIN@26C4::SQLHelper::BEGIN@26
11110µs12µsC4::SQLHelper::::BEGIN@24C4::SQLHelper::BEGIN@24
1119µs42µsC4::SQLHelper::::BEGIN@25C4::SQLHelper::BEGIN@25
1119µs70µsC4::SQLHelper::::BEGIN@28C4::SQLHelper::BEGIN@28
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
21329µs224µs
# spent 20µs (16+4) within C4::SQLHelper::BEGIN@21 which was called: # once (16µs+4µs) by C4::Budgets::BEGIN@24 at line 21
use strict;
# spent 20µs making 1 call to C4::SQLHelper::BEGIN@21 # spent 4µs making 1 call to strict::import
22335µs255µs
# spent 34µs (12+21) within C4::SQLHelper::BEGIN@22 which was called: # once (12µs+21µs) by C4::Budgets::BEGIN@24 at line 22
use warnings;
# spent 34µs making 1 call to C4::SQLHelper::BEGIN@22 # spent 21µs making 1 call to warnings::import
233117µs21.41ms
# spent 1.29ms (734µs+561µs) within C4::SQLHelper::BEGIN@23 which was called: # once (734µs+561µs) by C4::Budgets::BEGIN@24 at line 23
use List::MoreUtils qw(first_value any);
# spent 1.29ms making 1 call to C4::SQLHelper::BEGIN@23 # spent 119µs making 1 call to Exporter::import
24329µs214µs
# spent 12µs (10+2) within C4::SQLHelper::BEGIN@24 which was called: # once (10µs+2µs) by C4::Budgets::BEGIN@24 at line 24
use C4::Context;
# spent 12µs making 1 call to C4::SQLHelper::BEGIN@24 # spent 2µs making 1 call to C4::Context::import
25327µs274µs
# spent 42µs (9+32) within C4::SQLHelper::BEGIN@25 which was called: # once (9µs+32µs) by C4::Budgets::BEGIN@24 at line 25
use C4::Dates qw(format_date_in_iso);
# spent 42µs making 1 call to C4::SQLHelper::BEGIN@25 # spent 32µs making 1 call to Exporter::import
26341µs2239µs
# spent 125µs (12+113) within C4::SQLHelper::BEGIN@26 which was called: # once (12µs+113µs) by C4::Budgets::BEGIN@24 at line 26
use C4::Debug;
# spent 125µs making 1 call to C4::SQLHelper::BEGIN@26 # spent 113µs making 1 call to Exporter::import
2711µsrequire Exporter;
283202µs2131µs
# spent 70µs (9+61) within C4::SQLHelper::BEGIN@28 which was called: # once (9µs+61µs) by C4::Budgets::BEGIN@24 at line 28
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
# spent 70µs making 1 call to C4::SQLHelper::BEGIN@28 # spent 61µs making 1 call to vars::import
29
301600nseval {
3117µs122µs my $servers = C4::Context->config('memcached_servers');
# spent 22µs making 1 call to C4::Context::config
321600ns 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 21µs within C4::SQLHelper::BEGIN@47 which was called: # once (21µs+0s) by C4::Budgets::BEGIN@24 at line 62
BEGIN {
48 # set the version for version checking
4911µs $VERSION = 3.07.00.049;
501900ns require Exporter;
5119µs @ISA = qw(Exporter);
5211µs@EXPORT_OK=qw(
53 InsertInTable
54 DeleteInTable
55 SearchInTable
56 UpdateInTable
57 GetPrimaryKeys
58 clear_columns_cache
59);
6018µs %EXPORT_TAGS = ( all =>[qw( InsertInTable DeleteInTable SearchInTable UpdateInTable GetPrimaryKeys)]
61 );
6212.31ms121µs}
# spent 21µs making 1 call to C4::SQLHelper::BEGIN@47
63
641200nsmy $tablename;
651200nsmy $hashref;
66
67=head1 NAME
68
- -
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
- -
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
- -
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
- -
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
- -
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
- -
268sub clear_columns_cache {
269 %$hashref = ();
270}
271
- -
274=head2 _get_columns
275
- -
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
- -
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
- -
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 $filter_input->{$field}=format_date_in_iso($filter_input->{$field})
408 if $columns->{$field}{Type}=~/date/ &&
409 $filter_input->{$field} !~C4::Dates->regexp("iso");
410 my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns);
411 if (@$tmpkeys){
412 push @values, @$localvalues;
413 push @keys, @$tmpkeys;
414 }
415 }
416 if (@keys){
417 return (\@keys,\@values);
418 }
419 else {
420 return ();
421 }
422}
423
424sub _filter_string{
425 my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_;
426 return () unless($filter_input);
427 my @operands=split /\s+/,$filter_input;
428
429 # An act of desperation
430 $searchtype = 'contain' if @operands > 1 && $searchtype =~ /start_with/o;
431
432 my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns);
433 my $columns= _get_columns($tablename);
434 my (@values,@keys);
435 foreach my $operand (@operands){
436 my @localkeys;
437 foreach my $field (@columns_filtered){
438 my ($tmpkeys, $localvalues)=_Process_Operands($operand,"$tablename.$field",$searchtype,$columns);
439 if ($tmpkeys){
440 push @values,@$localvalues;
441 push @localkeys,@$tmpkeys;
442 }
443 }
444 my $sql= join (' OR ', @localkeys);
445 push @keys, $sql;
446 }
447
448 if (@keys){
449 return (\@keys,\@values);
450 }
451 else {
452 return ();
453 }
454}
455sub _Process_Operands{
456 my ($operand, $field, $searchtype,$columns)=@_;
457 my @values;
458 my @tmpkeys;
459 my @localkeys;
460
461 $operand = [$operand] unless ref $operand eq 'ARRAY';
462 foreach (@$operand) {
463 push @tmpkeys, " $field = ? ";
464 push @values, $_;
465 }
466 #By default, exact search
467 if (!$searchtype ||$searchtype eq "exact"){
468 return \@tmpkeys,\@values;
469 }
470 my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field);
471 if ($field=~/(?<!zip)code|(?<!card)number/ && $searchtype ne "exact"){
472 push @tmpkeys,(" $field= '' ","$field IS NULL");
473 }
474 if ($columns->{$col_field}->{Type}=~/varchar|text/i){
475 my @localvaluesextended;
476 if ($searchtype eq "contain"){
477 foreach (@$operand) {
478 push @tmpkeys,(" $field LIKE ? ");
479 push @localvaluesextended,("\%$_\%") ;
480 }
481 }
482 if ($searchtype eq "field_start_with"){
483 foreach (@$operand) {
484 push @tmpkeys,("$field LIKE ?");
485 push @localvaluesextended, ("$_\%") ;
486 }
487 }
488 if ($searchtype eq "start_with"){
489 foreach (@$operand) {
490 push @tmpkeys,("$field LIKE ?","$field LIKE ?");
491 push @localvaluesextended, ("$_\%", " $_\%") ;
492 }
493 }
494 push @values,@localvaluesextended;
495 }
496 push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) };
497 return (\@localkeys,\@values);
498}
499110µs1;
500
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.