X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FSQLHelper.pm;h=21f5fa179b0799f05f3fe6f8cea79e1f80897d0e;hb=6bad4db6a76d719ad6ac7fec2d4c7ec87ec8aa95;hp=d2df0a533ef39ad8fddd1a46181163a793b3b6fd;hpb=8ad2c7d7acc3cb0033426bd78928214a22ad9dd1;p=koha.git diff --git a/C4/SQLHelper.pm b/C4/SQLHelper.pm index d2df0a533e..21f5fa179b 100644 --- a/C4/SQLHelper.pm +++ b/C4/SQLHelper.pm @@ -13,9 +13,9 @@ package C4::SQLHelper; # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; @@ -24,13 +24,29 @@ use List::MoreUtils qw(first_value any); use C4::Context; use C4::Dates qw(format_date_in_iso); use C4::Debug; -use YAML; require Exporter; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); +eval { + my $servers = C4::Context->config('memcached_servers'); + if ($servers) { + require Memoize::Memcached; + import Memoize::Memcached qw(memoize_memcached); + + my $memcached = { + servers => [$servers], + key_prefix => C4::Context->config('memcached_namespace') || 'koha', + expire_time => 600 + }; # cache for 10 mins + + memoize_memcached( '_get_columns', memcached => $memcached ); + memoize_memcached( 'GetPrimaryKeys', memcached => $memcached ); + } +}; + BEGIN { # set the version for version checking - $VERSION = 0.5; + $VERSION = 3.07.00.049; require Exporter; @ISA = qw(Exporter); @EXPORT_OK=qw( @@ -39,13 +55,14 @@ BEGIN { SearchInTable UpdateInTable GetPrimaryKeys + clear_columns_cache ); %EXPORT_TAGS = ( all =>[qw( InsertInTable DeleteInTable SearchInTable UpdateInTable GetPrimaryKeys)] ); } my $tablename; -my $hash; +my $hashref; =head1 NAME @@ -61,18 +78,11 @@ This module contains routines for adding, modifying and Searching Data in MysqlD =head1 FUNCTIONS -=over 2 - -=back - - =head2 SearchInTable -=over 4 + $hashref = &SearchInTable($tablename,$data, $orderby, $limit, + $columns_out, $filtercolumns, $searchtype); - $hashref = &SearchInTable($tablename,$data, $orderby, $limit, $columns_out, $filtercolumns, $searchtype); - -=back $tablename Name of the table (string) @@ -93,11 +103,26 @@ $filtercolums is an array ref on field names : is used to limit expansion of res $searchtype is string Can be "start_with" or "exact" +This query builder is very limited, it should be replaced with DBIx::Class +or similar very soon +Meanwhile adding support for special key '' in case of a data_hashref to +support filters of type + + ( f1 = a OR f2 = a ) AND fx = b AND fy = c + +Call for the query above is: + + SearchInTable($tablename, {'' => a, fx => b, fy => c}, $orderby, $limit, + $columns_out, [f1, f2], 'exact'); + +NOTE: Current implementation may remove parts of the iinput hashrefs. If that is a problem +a copy needs to be created in _filter_fields() below + =cut sub SearchInTable{ my ($tablename,$filters,$orderby, $limit, $columns_out, $filter_columns,$searchtype) = @_; -# $searchtype||="start_with"; + $searchtype||="exact"; my $dbh = C4::Context->dbh; $columns_out||=["*"]; my $sql = do { local $"=', '; @@ -109,17 +134,24 @@ sub SearchInTable{ if ($keys){ my @criteria=grep{defined($_) && $_ !~/^\W$/ }@$keys; if (@criteria) { - $sql.= do { local $"=') AND ('; + $sql.= do { local $"=') OR ('; qq{ WHERE (@criteria) } }; } } if ($orderby){ #Order by desc by default - my @orders=map{ "$_".($$orderby{$_}? " DESC" : "") } keys %$orderby; - $sql.= do { local $"=', '; - qq{ ORDER BY @orders} - }; + my @orders; + foreach my $order ( ref($orderby) ? @$orderby : $orderby ){ + if (ref $order) { + push @orders,map{ "$_".($order->{$_}? " DESC " : "") } keys %$order; + } else { + push @orders,$order; + } + } + $sql.= do { local $"=', '; + qq{ ORDER BY @orders} + }; } if ($limit){ $sql.=qq{ LIMIT }.join(",",@$limit); @@ -135,20 +167,16 @@ sub SearchInTable{ =head2 InsertInTable -=over 4 - - $data_id_in_table = &InsertInTable($tablename,$data_hashref); + $data_id_in_table = &InsertInTable($tablename,$data_hashref,$withprimarykeys); -=back +Insert Data in table and returns the id of the row inserted - Insert Data in table - and returns the id of the row inserted =cut sub InsertInTable{ - my ($tablename,$data) = @_; + my ($tablename,$data,$withprimarykeys) = @_; my $dbh = C4::Context->dbh; - my ($keys,$values)=_filter_hash($tablename,$data,0); + my ($keys,$values)=_filter_hash($tablename,$data,($withprimarykeys?"exact":0)); my $query = qq{ INSERT INTO $tablename SET }.join(", ",@$keys); $debug && warn $query, join(",",@$values); @@ -161,14 +189,10 @@ sub InsertInTable{ =head2 UpdateInTable -=over 4 - $status = &UpdateInTable($tablename,$data_hashref); -=back +Update Data in table and returns the status of the operation - Update Data in table - and returns the status of the operation =cut sub UpdateInTable{ @@ -177,6 +201,7 @@ sub UpdateInTable{ my @ids=@$data{@field_ids}; my $dbh = C4::Context->dbh; my ($keys,$values)=_filter_hash($tablename,$data,0); + return unless ($keys); my $query = qq{ UPDATE $tablename SET }.join(",",@$keys).qq{ @@ -192,14 +217,10 @@ sub UpdateInTable{ =head2 DeleteInTable -=over 4 - $status = &DeleteInTable($tablename,$data_hashref); -=back +Delete Data in table and returns the status of the operation - Delete Data in table - and returns the status of the operation =cut sub DeleteInTable{ @@ -221,28 +242,38 @@ sub DeleteInTable{ =head2 GetPrimaryKeys -=over 4 - @primarykeys = &GetPrimaryKeys($tablename) -=back +Get the Primary Key field names of the table - Get the Primary Key field names of the table =cut -sub GetPrimaryKeys($) { +sub GetPrimaryKeys { my $tablename=shift; my $hash_columns=_get_columns($tablename); - return grep { $$hash_columns{$_}{'Key'} =~/PRI/i} keys %$hash_columns; + return grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns; } -=head2 _get_columns -=over 4 +=head2 clear_columns_cache -_get_columns($tablename) + C4::SQLHelper->clear_columns_cache(); + +cleans the internal cache of sysprefs. Please call this method if +you update a tables structure. Otherwise, your new changes +will not be seen by this process. + +=cut + +sub clear_columns_cache { + %$hashref = (); +} -=back + + +=head2 _get_columns + + _get_columns($tablename) Given a tablename Returns a hashref of all the fieldnames of the table @@ -253,12 +284,16 @@ With =cut -sub _get_columns($) { - my ($tablename)=@_; - my $dbh=C4::Context->dbh; - my $sth=$dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename }); - $sth->execute; - my $columns= $sth->fetchall_hashref(qw(Field)); +sub _get_columns { + my ($tablename) = @_; + unless ( exists( $hashref->{$tablename} ) ) { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename }); + $sth->execute; + my $columns = $sth->fetchall_hashref(qw(Field)); + $hashref->{$tablename} = $columns; + } + return $hashref->{$tablename}; } =head2 _filter_columns @@ -279,7 +314,7 @@ If it is not for research purpose, filter primary keys =cut -sub _filter_columns ($$;$) { +sub _filter_columns { my ($tablename,$research, $filtercolumns)=@_; if ($filtercolumns){ return (@$filtercolumns); @@ -296,11 +331,7 @@ sub _filter_columns ($$;$) { } =head2 _filter_fields -=over 4 - -_filter_fields - -=back + _filter_fields Given - a tablename @@ -318,13 +349,21 @@ sub _filter_fields{ my @keys; my @values; if (ref($filter_input) eq "HASH"){ - my ($keys, $values) = _filter_hash($tablename,$filter_input, $searchtype); + my ($keys, $values); + if (my $special = delete $filter_input->{''}) { # XXX destroyes '' key + ($keys, $values) = _filter_fields($tablename,$special, $searchtype,$filtercolumns); + } + my ($hkeys, $hvalues) = _filter_hash($tablename,$filter_input, $searchtype); + if ($hkeys){ + push @$keys, @$hkeys; + push @$values, @$hvalues; + } if ($keys){ - my $stringkey="(".join (") AND (",@$keys).")"; - return [$stringkey],$values; + my $stringkey="(".join (") AND (",@$keys).")"; + return [$stringkey],$values; } else { - return (); + return (); } } elsif (ref($filter_input) eq "ARRAY"){ foreach my $element_data (@$filter_input){ @@ -341,6 +380,7 @@ sub _filter_fields{ } } else{ + $debug && warn "filterstring : $filter_input"; my ($keys, $values) = _filter_string($tablename,$filter_input, $searchtype,$filtercolumns); if ($keys){ my $stringkey="(".join (") AND (",@$keys).")"; @@ -364,8 +404,10 @@ sub _filter_hash{ my $elements=join "|",@columns_filtered; foreach my $field (grep {/\b($elements)\b/} keys %$filter_input){ ## supposed to be a hash of simple values, hashes of arrays could be implemented - $$filter_input{$field}=format_date_in_iso($$filter_input{$field}) if ($$columns{$field}{Type}=~/date/ && $$filter_input{$field} !~C4::Dates->regexp("iso")); - my ($tmpkeys, $localvalues)=_Process_Operands($$filter_input{$field},"$tablename.$field",$searchtype,$columns); + $filter_input->{$field}=format_date_in_iso($filter_input->{$field}) + if $columns->{$field}{Type}=~/date/ && + $filter_input->{$field} !~C4::Dates->regexp("iso"); + my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns); if (@$tmpkeys){ push @values, @$localvalues; push @keys, @$tmpkeys; @@ -382,7 +424,11 @@ sub _filter_hash{ sub _filter_string{ my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_; return () unless($filter_input); - my @operands=split / /,$filter_input; + my @operands=split /\s+/,$filter_input; + + # An act of desperation + $searchtype = 'contain' if @operands > 1 && $searchtype =~ /start_with/o; + my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns); my $columns= _get_columns($tablename); my (@values,@keys); @@ -411,31 +457,41 @@ sub _Process_Operands{ my @values; my @tmpkeys; my @localkeys; - push @tmpkeys, " $field = ? "; - push @values, $operand; + + $operand = [$operand] unless ref $operand eq 'ARRAY'; + foreach (@$operand) { + push @tmpkeys, " $field = ? "; + push @values, $_; + } #By default, exact search - unless ($searchtype){ + if (!$searchtype ||$searchtype eq "exact"){ return \@tmpkeys,\@values; } - if ($searchtype eq "contain"){ - my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field); - if ($field=~/(?0?substr($field, index($field,".")+1):$field); + if ($field=~/(?0?substr($field, index($field,".")+1):$field); - if ($field=~/(?{$col_field}->{Type}=~/varchar|text/i){ + my @localvaluesextended; + if ($searchtype eq "contain"){ + foreach (@$operand) { + push @tmpkeys,(" $field LIKE ? "); + push @localvaluesextended,("\%$_\%") ; + } + } + if ($searchtype eq "field_start_with"){ + foreach (@$operand) { + push @tmpkeys,("$field LIKE ?"); + push @localvaluesextended, ("$_\%") ; + } + } + if ($searchtype eq "start_with"){ + foreach (@$operand) { + push @tmpkeys,("$field LIKE ?","$field LIKE ?"); + push @localvaluesextended, ("$_\%", " $_\%") ; + } + } + push @values,@localvaluesextended; } push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) }; return (\@localkeys,\@values);