Merge branch 'patroncards-wip' of git://git.foundations.edu/koha into community
[koha.git] / C4 / Search.pm
1 package C4::Search;
2
3 # This file is part of Koha.
4 #
5 # Koha is free software; you can redistribute it and/or modify it under the
6 # terms of the GNU General Public License as published by the Free Software
7 # Foundation; either version 2 of the License, or (at your option) any later
8 # version.
9 #
10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License along with
15 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
16 # Suite 330, Boston, MA  02111-1307 USA
17
18 use strict;
19 # use warnings; # FIXME
20 require Exporter;
21 use C4::Context;
22 use C4::Biblio;    # GetMarcFromKohaField, GetBiblioData
23 use C4::Koha;      # getFacets
24 use Lingua::Stem;
25 use C4::Search::PazPar2;
26 use XML::Simple;
27 use C4::Dates qw(format_date);
28 use C4::XSLT;
29 use C4::Branch;
30 use C4::Debug;
31 use YAML;
32 use URI::Escape;
33
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
35
36 # set the version for version checking
37 BEGIN {
38     $VERSION = 3.01;
39     $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
40 }
41
42 =head1 NAME
43
44 C4::Search - Functions for searching the Koha catalog.
45
46 =head1 SYNOPSIS
47
48 See opac/opac-search.pl or catalogue/search.pl for example of usage
49
50 =head1 DESCRIPTION
51
52 This module provides searching functions for Koha's bibliographic databases
53
54 =head1 FUNCTIONS
55
56 =cut
57
58 @ISA    = qw(Exporter);
59 @EXPORT = qw(
60   &FindDuplicate
61   &SimpleSearch
62   &searchResults
63   &getRecords
64   &buildQuery
65   &NZgetRecords
66   &AddSearchHistory
67   &GetDistinctValues
68   &BiblioAddAuthorities
69 );
70 #FIXME: i had to add BiblioAddAuthorities here because in Biblios.pm it caused circular dependencies (C4::Search uses C4::Biblio, and BiblioAddAuthorities uses SimpleSearch from C4::Search)
71
72 # make all your functions, whether exported or not;
73
74 =head2 FindDuplicate
75
76 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
77
78 This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
79
80 =cut
81
82 sub FindDuplicate {
83     my ($record) = @_;
84     my $dbh = C4::Context->dbh;
85     my $result = TransformMarcToKoha( $dbh, $record, '' );
86     my $sth;
87     my $query;
88     my $search;
89     my $type;
90     my ( $biblionumber, $title );
91
92     # search duplicate on ISBN, easy and fast..
93     # ... normalize first
94     if ( $result->{isbn} ) {
95         $result->{isbn} =~ s/\(.*$//;
96         $result->{isbn} =~ s/\s+$//;
97         $query = "isbn=$result->{isbn}";
98     }
99     else {
100         $result->{title} =~ s /\\//g;
101         $result->{title} =~ s /\"//g;
102         $result->{title} =~ s /\(//g;
103         $result->{title} =~ s /\)//g;
104
105         # FIXME: instead of removing operators, could just do
106         # quotes around the value
107         $result->{title} =~ s/(and|or|not)//g;
108         $query = "ti,ext=$result->{title}";
109         $query .= " and itemtype=$result->{itemtype}"
110           if ( $result->{itemtype} );
111         if   ( $result->{author} ) {
112             $result->{author} =~ s /\\//g;
113             $result->{author} =~ s /\"//g;
114             $result->{author} =~ s /\(//g;
115             $result->{author} =~ s /\)//g;
116
117             # remove valid operators
118             $result->{author} =~ s/(and|or|not)//g;
119             $query .= " and au,ext=$result->{author}";
120         }
121     }
122
123     # FIXME: add error handling
124     my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
125     my @results;
126     foreach my $possible_duplicate_record (@$searchresults) {
127         my $marcrecord =
128           MARC::Record->new_from_usmarc($possible_duplicate_record);
129         my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
130
131         # FIXME :: why 2 $biblionumber ?
132         if ($result) {
133             push @results, $result->{'biblionumber'};
134             push @results, $result->{'title'};
135         }
136     }
137     return @results;
138 }
139
140 =head2 SimpleSearch
141
142 ( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] );
143
144 This function provides a simple search API on the bibliographic catalog
145
146 =over 2
147
148 =item C<input arg:>
149
150     * $query can be a simple keyword or a complete CCL query
151     * @servers is optional. Defaults to biblioserver as found in koha-conf.xml
152     * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0
153     * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef.
154
155
156 =item C<Output:>
157
158     * $error is a empty unless an error is detected
159     * \@results is an array of records.
160     * $total_hits is the number of hits that would have been returned with no limit
161
162 =item C<usage in the script:>
163
164 =back
165
166 my ( $error, $marcresults, $total_hits ) = SimpleSearch($query);
167
168 if (defined $error) {
169     $template->param(query_error => $error);
170     warn "error: ".$error;
171     output_html_with_http_headers $input, $cookie, $template->output;
172     exit;
173 }
174
175 my $hits = scalar @$marcresults;
176 my @results;
177
178 for my $i (0..$hits) {
179     my %resultsloop;
180     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
181     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
182
183     #build the hash for the template.
184     $resultsloop{title}           = $biblio->{'title'};
185     $resultsloop{subtitle}        = $biblio->{'subtitle'};
186     $resultsloop{biblionumber}    = $biblio->{'biblionumber'};
187     $resultsloop{author}          = $biblio->{'author'};
188     $resultsloop{publishercode}   = $biblio->{'publishercode'};
189     $resultsloop{publicationyear} = $biblio->{'publicationyear'};
190
191     push @results, \%resultsloop;
192 }
193
194 $template->param(result=>\@results);
195
196 =cut
197
198 sub SimpleSearch {
199     my ( $query, $offset, $max_results, $servers )  = @_;
200
201     if ( C4::Context->preference('NoZebra') ) {
202         my $result = NZorder( NZanalyse($query) )->{'biblioserver'};
203         my $search_result =
204           (      $result->{hits}
205               && $result->{hits} > 0 ? $result->{'RECORDS'} : [] );
206         return ( undef, $search_result, scalar($result->{hits}) );
207     }
208     else {
209         # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
210         my @servers = defined ( $servers ) ? @$servers : ( "biblioserver" );
211         my @results;
212         my @zoom_queries;
213         my @tmpresults;
214         my @zconns;
215         my $total_hits;
216         return ( "No query entered", undef, undef ) unless $query;
217
218         # Initialize & Search Zebra
219         for ( my $i = 0 ; $i < @servers ; $i++ ) {
220             eval {
221                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
222                 $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]);
223                 $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] );
224
225                 # error handling
226                 my $error =
227                     $zconns[$i]->errmsg() . " ("
228                   . $zconns[$i]->errcode() . ") "
229                   . $zconns[$i]->addinfo() . " "
230                   . $zconns[$i]->diagset();
231
232                 return ( $error, undef, undef ) if $zconns[$i]->errcode();
233             };
234             if ($@) {
235
236                 # caught a ZOOM::Exception
237                 my $error =
238                     $@->message() . " ("
239                   . $@->code() . ") "
240                   . $@->addinfo() . " "
241                   . $@->diagset();
242                 warn $error;
243                 return ( $error, undef, undef );
244             }
245         }
246         while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
247             my $event = $zconns[ $i - 1 ]->last_event();
248             if ( $event == ZOOM::Event::ZEND ) {
249
250                 my $first_record = defined( $offset ) ? $offset+1 : 1;
251                 my $hits = $tmpresults[ $i - 1 ]->size();
252                 $total_hits += $hits;
253                 my $last_record = $hits;
254                 if ( defined $max_results && $offset + $max_results < $hits ) {
255                     $last_record  = $offset + $max_results;
256                 }
257
258                 for my $j ( $first_record..$last_record ) {
259                     my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed
260                     push @results, $record;
261                 }
262             }
263         }
264
265         foreach my $result (@tmpresults) {
266             $result->destroy();
267         }
268         foreach my $zoom_query (@zoom_queries) {
269             $zoom_query->destroy();
270         }
271
272         return ( undef, \@results, $total_hits );
273     }
274 }
275
276 =head2 getRecords
277
278 ( undef, $results_hashref, \@facets_loop ) = getRecords (
279
280         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
281         $results_per_page, $offset,       $expanded_facet, $branches,
282         $query_type,       $scan
283     );
284
285 The all singing, all dancing, multi-server, asynchronous, scanning,
286 searching, record nabbing, facet-building
287
288 See verbse embedded documentation.
289
290 =cut
291
292 sub getRecords {
293     my (
294         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
295         $results_per_page, $offset,       $expanded_facet, $branches,
296         $query_type,       $scan
297     ) = @_;
298
299     my @servers = @$servers_ref;
300     my @sort_by = @$sort_by_ref;
301
302     # Initialize variables for the ZOOM connection and results object
303     my $zconn;
304     my @zconns;
305     my @results;
306     my $results_hashref = ();
307
308     # Initialize variables for the faceted results objects
309     my $facets_counter = ();
310     my $facets_info    = ();
311     my $facets         = getFacets();
312
313     my @facets_loop;    # stores the ref to array of hashes for template facets loop
314
315     ### LOOP THROUGH THE SERVERS
316     for ( my $i = 0 ; $i < @servers ; $i++ ) {
317         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
318
319 # perform the search, create the results objects
320 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
321         my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
322
323         #$query_to_use = $simple_query if $scan;
324         warn $simple_query if ( $scan and $DEBUG );
325
326         # Check if we've got a query_type defined, if so, use it
327         eval {
328             if ($query_type) {
329                 if ($query_type =~ /^ccl/) {
330                     $query_to_use =~ s/\:/\=/g;    # change : to = last minute (FIXME)
331                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
332                 } elsif ($query_type =~ /^cql/) {
333                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i]));
334                 } elsif ($query_type =~ /^pqf/) {
335                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i]));
336                 } else {
337                     warn "Unknown query_type '$query_type'.  Results undetermined.";
338                 }
339             } elsif ($scan) {
340                     $results[$i] = $zconns[$i]->scan(  new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
341             } else {
342                     $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i]));
343             }
344         };
345         if ($@) {
346             warn "WARNING: query problem with $query_to_use " . $@;
347         }
348
349         # Concatenate the sort_by limits and pass them to the results object
350         # Note: sort will override rank
351         my $sort_by;
352         foreach my $sort (@sort_by) {
353             if ( $sort eq "author_az" ) {
354                 $sort_by .= "1=1003 <i ";
355             }
356             elsif ( $sort eq "author_za" ) {
357                 $sort_by .= "1=1003 >i ";
358             }
359             elsif ( $sort eq "popularity_asc" ) {
360                 $sort_by .= "1=9003 <i ";
361             }
362             elsif ( $sort eq "popularity_dsc" ) {
363                 $sort_by .= "1=9003 >i ";
364             }
365             elsif ( $sort eq "call_number_asc" ) {
366                 $sort_by .= "1=20  <i ";
367             }
368             elsif ( $sort eq "call_number_dsc" ) {
369                 $sort_by .= "1=20 >i ";
370             }
371             elsif ( $sort eq "pubdate_asc" ) {
372                 $sort_by .= "1=31 <i ";
373             }
374             elsif ( $sort eq "pubdate_dsc" ) {
375                 $sort_by .= "1=31 >i ";
376             }
377             elsif ( $sort eq "acqdate_asc" ) {
378                 $sort_by .= "1=32 <i ";
379             }
380             elsif ( $sort eq "acqdate_dsc" ) {
381                 $sort_by .= "1=32 >i ";
382             }
383             elsif ( $sort eq "title_az" ) {
384                 $sort_by .= "1=4 <i ";
385             }
386             elsif ( $sort eq "title_za" ) {
387                 $sort_by .= "1=4 >i ";
388             }
389             else {
390                 warn "Ignoring unrecognized sort '$sort' requested" if $sort_by;
391             }
392         }
393         if ($sort_by) {
394             if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
395                 warn "WARNING sort $sort_by failed";
396             }
397         }
398     }    # finished looping through servers
399
400     # The big moment: asynchronously retrieve results from all servers
401     while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
402         my $ev = $zconns[ $i - 1 ]->last_event();
403         if ( $ev == ZOOM::Event::ZEND ) {
404             next unless $results[ $i - 1 ];
405             my $size = $results[ $i - 1 ]->size();
406             if ( $size > 0 ) {
407                 my $results_hash;
408
409                 # loop through the results
410                 $results_hash->{'hits'} = $size;
411                 my $times;
412                 if ( $offset + $results_per_page <= $size ) {
413                     $times = $offset + $results_per_page;
414                 }
415                 else {
416                     $times = $size;
417                 }
418                 for ( my $j = $offset ; $j < $times ; $j++ ) {
419                     my $records_hash;
420                     my $record;
421                     my $facet_record;
422
423                     ## Check if it's an index scan
424                     if ($scan) {
425                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
426
427                  # here we create a minimal MARC record and hand it off to the
428                  # template just like a normal result ... perhaps not ideal, but
429                  # it works for now
430                         my $tmprecord = MARC::Record->new();
431                         $tmprecord->encoding('UTF-8');
432                         my $tmptitle;
433                         my $tmpauthor;
434
435                 # the minimal record in author/title (depending on MARC flavour)
436                         if (C4::Context->preference("marcflavour") eq "UNIMARC") {
437                             $tmptitle = MARC::Field->new('200',' ',' ', a => $term, f => $occ);
438                             $tmprecord->append_fields($tmptitle);
439                         } else {
440                             $tmptitle  = MARC::Field->new('245',' ',' ', a => $term,);
441                             $tmpauthor = MARC::Field->new('100',' ',' ', a => $occ,);
442                             $tmprecord->append_fields($tmptitle);
443                             $tmprecord->append_fields($tmpauthor);
444                         }
445                         $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc();
446                     }
447
448                     # not an index scan
449                     else {
450                         $record = $results[ $i - 1 ]->record($j)->raw();
451
452                         # warn "RECORD $j:".$record;
453                         $results_hash->{'RECORDS'}[$j] = $record;
454
455             # Fill the facets while we're looping, but only for the biblioserver
456                         $facet_record = MARC::Record->new_from_usmarc($record)
457                           if $servers[ $i - 1 ] =~ /biblioserver/;
458
459                     #warn $servers[$i-1]."\n".$record; #.$facet_record->title();
460                         if ($facet_record) {
461                             for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
462                                 ($facets->[$k]) or next;
463                                 my @fields = map {$facet_record->field($_)} @{$facets->[$k]->{'tags'}} ;
464                                 for my $field (@fields) {
465                                     my @subfields = $field->subfields();
466                                     for my $subfield (@subfields) {
467                                         my ( $code, $data ) = @$subfield;
468                                         ($code eq $facets->[$k]->{'subfield'}) or next;
469                                         $facets_counter->{ $facets->[$k]->{'link_value'} }->{$data}++;
470                                     }
471                                 }
472                                 $facets_info->{ $facets->[$k]->{'link_value'} }->{'label_value'} =
473                                     $facets->[$k]->{'label_value'};
474                                 $facets_info->{ $facets->[$k]->{'link_value'} }->{'expanded'} =
475                                     $facets->[$k]->{'expanded'};
476                             }
477                         }
478                     }
479                 }
480                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
481             }
482
483             # warn "connection ", $i-1, ": $size hits";
484             # warn $results[$i-1]->record(0)->render() if $size > 0;
485
486             # BUILD FACETS
487             if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
488                 for my $link_value (
489                     sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
490                         keys %$facets_counter )
491                 {
492                     my $expandable;
493                     my $number_of_facets;
494                     my @this_facets_array;
495                     for my $one_facet (
496                         sort {
497                              $facets_counter->{$link_value}->{$b}
498                          <=> $facets_counter->{$link_value}->{$a}
499                         } keys %{ $facets_counter->{$link_value} }
500                       )
501                     {
502                         $number_of_facets++;
503                         if (   ( $number_of_facets < 6 )
504                             || ( $expanded_facet eq $link_value )
505                             || ( $facets_info->{$link_value}->{'expanded'} ) )
506                         {
507
508                       # Sanitize the link value ), ( will cause errors with CCL,
509                             my $facet_link_value = $one_facet;
510                             $facet_link_value =~ s/(\(|\))/ /g;
511
512                             # fix the length that will display in the label,
513                             my $facet_label_value = $one_facet;
514                             $facet_label_value =
515                               substr( $one_facet, 0, 20 ) . "..."
516                               unless length($facet_label_value) <= 20;
517
518                             # if it's a branch, label by the name, not the code,
519                             if ( $link_value =~ /branch/ ) {
520                                                                 if (defined $branches
521                                                                         && ref($branches) eq "HASH"
522                                                                         && defined $branches->{$one_facet}
523                                                                         && ref ($branches->{$one_facet}) eq "HASH")
524                                                                 {
525                                         $facet_label_value =
526                                                 $branches->{$one_facet}->{'branchname'};
527                                                                 }
528                                                                 else {
529                                                                         $facet_label_value = "*";
530                                                                 }
531                             }
532
533                             # but we're down with the whole label being in the link's title.
534                             push @this_facets_array, {
535                                 facet_count       => $facets_counter->{$link_value}->{$one_facet},
536                                 facet_label_value => $facet_label_value,
537                                 facet_title_value => $one_facet,
538                                 facet_link_value  => $facet_link_value,
539                                 type_link_value   => $link_value,
540                             };
541                         }
542                     }
543
544                     # handle expanded option
545                     unless ( $facets_info->{$link_value}->{'expanded'} ) {
546                         $expandable = 1
547                           if ( ( $number_of_facets > 6 )
548                             && ( $expanded_facet ne $link_value ) );
549                     }
550                     push @facets_loop, {
551                         type_link_value => $link_value,
552                         type_id         => $link_value . "_id",
553                         "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1,
554                         facets     => \@this_facets_array,
555                         expandable => $expandable,
556                         expand     => $link_value,
557                     } unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) );
558                 }
559             }
560         }
561     }
562     return ( undef, $results_hashref, \@facets_loop );
563 }
564
565 sub pazGetRecords {
566     my (
567         $koha_query,       $simple_query, $sort_by_ref,    $servers_ref,
568         $results_per_page, $offset,       $expanded_facet, $branches,
569         $query_type,       $scan
570     ) = @_;
571
572     my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url'));
573     $paz->init();
574     $paz->search($simple_query);
575     sleep 1;   # FIXME: WHY?
576
577     # do results
578     my $results_hashref = {};
579     my $stats = XMLin($paz->stat);
580     my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1);
581
582     # for a grouped search result, the number of hits
583     # is the number of groups returned; 'bib_hits' will have
584     # the total number of bibs.
585     $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0];
586     $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'};
587
588     HIT: foreach my $hit (@{ $results->{'hit'} }) {
589         my $recid = $hit->{recid}->[0];
590
591         my $work_title = $hit->{'md-work-title'}->[0];
592         my $work_author;
593         if (exists $hit->{'md-work-author'}) {
594             $work_author = $hit->{'md-work-author'}->[0];
595         }
596         my $group_label = (defined $work_author) ? "$work_title / $work_author" : $work_title;
597
598         my $result_group = {};
599         $result_group->{'group_label'} = $group_label;
600         $result_group->{'group_merge_key'} = $recid;
601
602         my $count = 1;
603         if (exists $hit->{count}) {
604             $count = $hit->{count}->[0];
605         }
606         $result_group->{'group_count'} = $count;
607
608         for (my $i = 0; $i < $count; $i++) {
609             # FIXME -- may need to worry about diacritics here
610             my $rec = $paz->record($recid, $i);
611             push @{ $result_group->{'RECORDS'} }, $rec;
612         }
613
614         push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group;
615     }
616
617     # pass through facets
618     my $termlist_xml = $paz->termlist('author,subject');
619     my $terms = XMLin($termlist_xml, forcearray => 1);
620     my @facets_loop = ();
621     #die Dumper($results);
622 #    foreach my $list (sort keys %{ $terms->{'list'} }) {
623 #        my @facets = ();
624 #        foreach my $facet (sort @{ $terms->{'list'}->{$list}->{'term'} } ) {
625 #            push @facets, {
626 #                facet_label_value => $facet->{'name'}->[0],
627 #            };
628 #        }
629 #        push @facets_loop, ( {
630 #            type_label => $list,
631 #            facets => \@facets,
632 #        } );
633 #    }
634
635     return ( undef, $results_hashref, \@facets_loop );
636 }
637
638 # STOPWORDS
639 sub _remove_stopwords {
640     my ( $operand, $index ) = @_;
641     my @stopwords_removed;
642
643     # phrase and exact-qualified indexes shouldn't have stopwords removed
644     if ( $index !~ m/phr|ext/ ) {
645
646 # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
647 #       we use IsAlpha unicode definition, to deal correctly with diacritics.
648 #       otherwise, a French word like "leçon" woudl be split into "le" "çon", "le"
649 #       is a stopword, we'd get "çon" and wouldn't find anything...
650 #
651                 foreach ( keys %{ C4::Context->stopwords } ) {
652                         next if ( $_ =~ /(and|or|not)/ );    # don't remove operators
653                         $debug && warn "$_ Dump($operand)";
654                         if ( my ($matched) = ($operand =~
655                                 /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi))
656                         {
657                                 $operand =~ s/\Q$matched\E/ /gi;
658                                 push @stopwords_removed, $_;
659                         }
660                 }
661         }
662     return ( $operand, \@stopwords_removed );
663 }
664
665 # TRUNCATION
666 sub _detect_truncation {
667     my ( $operand, $index ) = @_;
668     my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
669         @regexpr );
670     $operand =~ s/^ //g;
671     my @wordlist = split( /\s/, $operand );
672     foreach my $word (@wordlist) {
673         if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
674             push @rightlefttruncated, $word;
675         }
676         elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
677             push @lefttruncated, $word;
678         }
679         elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
680             push @righttruncated, $word;
681         }
682         elsif ( index( $word, "*" ) < 0 ) {
683             push @nontruncated, $word;
684         }
685         else {
686             push @regexpr, $word;
687         }
688     }
689     return (
690         \@nontruncated,       \@righttruncated, \@lefttruncated,
691         \@rightlefttruncated, \@regexpr
692     );
693 }
694
695 # STEMMING
696 sub _build_stemmed_operand {
697     my ($operand,$lang) = @_;
698     require Lingua::Stem::Snowball ;
699     my $stemmed_operand;
700
701     # If operand contains a digit, it is almost certainly an identifier, and should
702     # not be stemmed.  This is particularly relevant for ISBNs and ISSNs, which
703     # can contain the letter "X" - for example, _build_stemmend_operand would reduce
704     # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant
705     # results (e.g., "23 x 29 cm." from the 300$c).  Bug 2098.
706     return $operand if $operand =~ /\d/;
707
708 # FIXME: the locale should be set based on the user's language and/or search choice
709     #warn "$lang";
710     my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
711                                                encoding => "UTF-8" );
712
713     my @words = split( / /, $operand );
714     my @stems = $stemmer->stem(\@words);
715     for my $stem (@stems) {
716         $stemmed_operand .= "$stem";
717         $stemmed_operand .= "?"
718           unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
719         $stemmed_operand .= " ";
720     }
721     warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
722     return $stemmed_operand;
723 }
724
725 # FIELD WEIGHTING
726 sub _build_weighted_query {
727
728 # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
729 # pretty well but could work much better if we had a smarter query parser
730     my ( $operand, $stemmed_operand, $index ) = @_;
731     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
732     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
733     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")        || 0;
734
735     my $weighted_query .= "(rk=(";    # Specifies that we're applying rank
736
737     # Keyword, or, no index specified
738     if ( ( $index eq 'kw' ) || ( !$index ) ) {
739         $weighted_query .=
740           "Title-cover,ext,r1=\"$operand\"";    # exact title-cover
741         $weighted_query .= " or ti,ext,r2=\"$operand\"";    # exact title
742         $weighted_query .= " or ti,phr,r3=\"$operand\"";    # phrase title
743           #$weighted_query .= " or any,ext,r4=$operand";               # exact any
744           #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
745         $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
746           if $fuzzy_enabled;    # add fuzzy, word list
747         $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
748           if ( $stemming and $stemmed_operand )
749           ;                     # add stemming, right truncation
750         $weighted_query .= " or wrdl,r9=\"$operand\"";
751
752         # embedded sorting: 0 a-z; 1 z-a
753         # $weighted_query .= ") or (sort1,aut=1";
754     }
755
756     # Barcode searches should skip this process
757     elsif ( $index eq 'bc' ) {
758         $weighted_query .= "bc=\"$operand\"";
759     }
760
761     # Authority-number searches should skip this process
762     elsif ( $index eq 'an' ) {
763         $weighted_query .= "an=\"$operand\"";
764     }
765
766     # If the index already has more than one qualifier, wrap the operand
767     # in quotes and pass it back (assumption is that the user knows what they
768     # are doing and won't appreciate us mucking up their query
769     elsif ( $index =~ ',' ) {
770         $weighted_query .= " $index=\"$operand\"";
771     }
772
773     #TODO: build better cases based on specific search indexes
774     else {
775         $weighted_query .= " $index,ext,r1=\"$operand\"";    # exact index
776           #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
777         $weighted_query .= " or $index,phr,r3=\"$operand\"";    # phrase index
778         $weighted_query .=
779           " or $index,rt,wrdl,r3=\"$operand\"";    # word list index
780     }
781
782     $weighted_query .= "))";                       # close rank specification
783     return $weighted_query;
784 }
785
786 =head2 buildQuery
787
788 ( $error, $query,
789 $simple_query, $query_cgi,
790 $query_desc, $limit,
791 $limit_cgi, $limit_desc,
792 $stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang);
793
794 Build queries and limits in CCL, CGI, Human,
795 handle truncation, stemming, field weighting, stopwords, fuzziness, etc.
796
797 See verbose embedded documentation.
798
799
800 =cut
801
802 sub buildQuery {
803     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
804
805     warn "---------\nEnter buildQuery\n---------" if $DEBUG;
806
807     # dereference
808     my @operators = $operators ? @$operators : ();
809     my @indexes   = $indexes   ? @$indexes   : ();
810     my @operands  = $operands  ? @$operands  : ();
811     my @limits    = $limits    ? @$limits    : ();
812     my @sort_by   = $sort_by   ? @$sort_by   : ();
813
814     my $stemming         = C4::Context->preference("QueryStemming")        || 0;
815     my $auto_truncation  = C4::Context->preference("QueryAutoTruncate")    || 0;
816     my $weight_fields    = C4::Context->preference("QueryWeightFields")    || 0;
817     my $fuzzy_enabled    = C4::Context->preference("QueryFuzzy")           || 0;
818     my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
819
820     # no stemming/weight/fuzzy in NoZebra
821     if ( C4::Context->preference("NoZebra") ) {
822         $stemming      = 0;
823         $weight_fields = 0;
824         $fuzzy_enabled = 0;
825     }
826
827     my $query        = $operands[0];
828     my $simple_query = $operands[0];
829
830     # initialize the variables we're passing back
831     my $query_cgi;
832     my $query_desc;
833     my $query_type;
834
835     my $limit;
836     my $limit_cgi;
837     my $limit_desc;
838
839     my $stopwords_removed;    # flag to determine if stopwords have been removed
840
841 # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
842 # DIAGNOSTIC ONLY!!
843     if ( $query =~ /^ccl=/ ) {
844         return ( undef, $', $', "q=ccl=$'", $', '', '', '', '', 'ccl' );
845     }
846     if ( $query =~ /^cql=/ ) {
847         return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' );
848     }
849     if ( $query =~ /^pqf=/ ) {
850         return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' );
851     }
852
853     # pass nested queries directly
854     # FIXME: need better handling of some of these variables in this case
855     # Nested queries aren't handled well and this implementation is flawed and causes users to be
856     # unable to search for anything containing () commenting out, will be rewritten for 3.4.0
857 #    if ( $query =~ /(\(|\))/ ) {
858 #        return (
859 #            undef,              $query, $simple_query, $query_cgi,
860 #            $query,             $limit, $limit_cgi,    $limit_desc,
861 #            $stopwords_removed, 'ccl'
862 #        );
863 #    }
864
865 # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming
866 # query operands and indexes and add stemming, truncation, field weighting, etc.
867 # Once we do so, we'll end up with a value in $query, just like if we had an
868 # incoming $query from the user
869     else {
870         $query = ""
871           ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
872         my $previous_operand
873           ;    # a flag used to keep track if there was a previous query
874                # if there was, we can apply the current operator
875                # for every operand
876         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
877
878             # COMBINE OPERANDS, INDEXES AND OPERATORS
879             if ( $operands[$i] ) {
880
881               # A flag to determine whether or not to add the index to the query
882                 my $indexes_set;
883
884 # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
885                 if ( $operands[$i] =~ /(:|=)/ || $scan ) {
886                     $weight_fields    = 0;
887                     $stemming         = 0;
888                     $remove_stopwords = 0;
889                 }
890                 my $operand = $operands[$i];
891                 my $index   = $indexes[$i];
892
893                 # Add index-specific attributes
894                 # Date of Publication
895                 if ( $index eq 'yr' ) {
896                     $index .= ",st-numeric";
897                     $indexes_set++;
898                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
899                 }
900
901                 # Date of Acquisition
902                 elsif ( $index eq 'acqdate' ) {
903                     $index .= ",st-date-normalized";
904                     $indexes_set++;
905                                         $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0;
906                 }
907                 # ISBN,ISSN,Standard Number, don't need special treatment
908                 elsif ( $index eq 'nb' || $index eq 'ns' ) {
909                     $indexes_set++;
910                     (
911                         $stemming,      $auto_truncation,
912                         $weight_fields, $fuzzy_enabled,
913                         $remove_stopwords
914                     ) = ( 0, 0, 0, 0, 0 );
915
916                 }
917                 # Set default structure attribute (word list)
918                 my $struct_attr;
919                 unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
920                     $struct_attr = ",wrdl";
921                 }
922
923                 # Some helpful index variants
924                 my $index_plus       = $index . $struct_attr . ":" if $index;
925                 my $index_plus_comma = $index . $struct_attr . "," if $index;
926
927                 # Remove Stopwords
928                 if ($remove_stopwords) {
929                     ( $operand, $stopwords_removed ) =
930                       _remove_stopwords( $operand, $index );
931                     warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
932                     warn "REMOVED STOPWORDS: @$stopwords_removed"
933                       if ( $stopwords_removed && $DEBUG );
934                 }
935
936                 if ($auto_truncation){
937                    # join throws an error if there is a leading space
938                    $operand =~ s/^\s+//;
939                    $operand=~join(" ",map{ "$_*" }split (/\s+/,$operand));
940                 }
941
942                 # Detect Truncation
943                 my $truncated_operand;
944                 my( $nontruncated, $righttruncated, $lefttruncated,
945                     $rightlefttruncated, $regexpr
946                 ) = _detect_truncation( $operand, $index );
947                 warn
948 "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
949                   if $DEBUG;
950
951                 # Apply Truncation
952                 if (
953                     scalar(@$righttruncated) + scalar(@$lefttruncated) +
954                     scalar(@$rightlefttruncated) > 0 )
955                 {
956
957                # Don't field weight or add the index to the query, we do it here
958                     $indexes_set = 1;
959                     undef $weight_fields;
960                     my $previous_truncation_operand;
961                     if (scalar @$nontruncated) {
962                         $truncated_operand .= "$index_plus @$nontruncated ";
963                         $previous_truncation_operand = 1;
964                     }
965                     if (scalar @$righttruncated) {
966                         $truncated_operand .= "and " if $previous_truncation_operand;
967                         $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated ";
968                         $previous_truncation_operand = 1;
969                     }
970                     if (scalar @$lefttruncated) {
971                         $truncated_operand .= "and " if $previous_truncation_operand;
972                         $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated ";
973                         $previous_truncation_operand = 1;
974                     }
975                     if (scalar @$rightlefttruncated) {
976                         $truncated_operand .= "and " if $previous_truncation_operand;
977                         $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated ";
978                         $previous_truncation_operand = 1;
979                     }
980                 }
981                 $operand = $truncated_operand if $truncated_operand;
982                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
983
984                 # Handle Stemming
985                 my $stemmed_operand;
986                 $stemmed_operand = _build_stemmed_operand($operand, $lang)
987                                                                                 if $stemming;
988
989                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
990
991                 # Handle Field Weighting
992                 my $weighted_operand;
993                 if ($weight_fields) {
994                     $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index );
995                     $operand = $weighted_operand;
996                     $indexes_set = 1;
997                 }
998
999                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1000
1001                 # If there's a previous operand, we need to add an operator
1002                 if ($previous_operand) {
1003
1004                     # User-specified operator
1005                     if ( $operators[ $i - 1 ] ) {
1006                         $query     .= " $operators[$i-1] ";
1007                         $query     .= " $index_plus " unless $indexes_set;
1008                         $query     .= " $operand";
1009                         $query_cgi .= "&op=$operators[$i-1]";
1010                         $query_cgi .= "&idx=$index" if $index;
1011                         $query_cgi .= "&q=$operands[$i]" if $operands[$i];
1012                         $query_desc .=
1013                           " $operators[$i-1] $index_plus $operands[$i]";
1014                     }
1015
1016                     # Default operator is and
1017                     else {
1018                         $query      .= " and ";
1019                         $query      .= "$index_plus " unless $indexes_set;
1020                         $query      .= "$operand";
1021                         $query_cgi  .= "&op=and&idx=$index" if $index;
1022                         $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1023                         $query_desc .= " and $index_plus $operands[$i]";
1024                     }
1025                 }
1026
1027                 # There isn't a pervious operand, don't need an operator
1028                 else {
1029
1030                     # Field-weighted queries already have indexes set
1031                     $query .= " $index_plus " unless $indexes_set;
1032                     $query .= $operand;
1033                     $query_desc .= " $index_plus $operands[$i]";
1034                     $query_cgi  .= "&idx=$index" if $index;
1035                     $query_cgi  .= "&q=$operands[$i]" if $operands[$i];
1036                     $previous_operand = 1;
1037                 }
1038             }    #/if $operands
1039         }    # /for
1040     }
1041     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1042
1043     # add limits
1044     my $group_OR_limits;
1045     my $availability_limit;
1046     foreach my $this_limit (@limits) {
1047 #        if ( $this_limit =~ /available/ ) {
1048 #
1049 ## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0)
1050 ## In English:
1051 ## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0
1052 #            $availability_limit .=
1053 #"( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
1054 #            $limit_cgi  .= "&limit=available";
1055 #            $limit_desc .= "";
1056 #        }
1057 #
1058         # group_OR_limits, prefixed by mc-
1059         # OR every member of the group
1060 #        elsif ( $this_limit =~ /mc/ ) {
1061         if ( $this_limit =~ /mc/ ) {
1062             $group_OR_limits .= " or " if $group_OR_limits;
1063             $limit_desc      .= " or " if $group_OR_limits;
1064             $group_OR_limits .= "$this_limit";
1065             $limit_cgi       .= "&limit=$this_limit";
1066             $limit_desc      .= " $this_limit";
1067         }
1068
1069         # Regular old limits
1070         else {
1071             $limit .= " and " if $limit || $query;
1072             $limit      .= "$this_limit";
1073             $limit_cgi  .= "&limit=$this_limit";
1074             if ($this_limit =~ /^branch:(.+)/) {
1075                 my $branchcode = $1;
1076                 my $branchname = GetBranchName($branchcode);
1077                 if (defined $branchname) {
1078                     $limit_desc .= " branch:$branchname";
1079                 } else {
1080                     $limit_desc .= " $this_limit";
1081                 }
1082             } else {
1083                 $limit_desc .= " $this_limit";
1084             }
1085         }
1086     }
1087     if ($group_OR_limits) {
1088         $limit .= " and " if ( $query || $limit );
1089         $limit .= "($group_OR_limits)";
1090     }
1091     if ($availability_limit) {
1092         $limit .= " and " if ( $query || $limit );
1093         $limit .= "($availability_limit)";
1094     }
1095
1096     # Normalize the query and limit strings
1097     # This is flawed , means we can't search anything with : in it
1098     # if user wants to do ccl or cql, start the query with that
1099 #    $query =~ s/:/=/g;
1100     $limit =~ s/:/=/g;
1101     for ( $query, $query_desc, $limit, $limit_desc ) {
1102         s/  / /g;    # remove extra spaces
1103         s/^ //g;     # remove any beginning spaces
1104         s/ $//g;     # remove any ending spaces
1105         s/==/=/g;    # remove double == from query
1106     }
1107     $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
1108
1109     for ($query_cgi,$simple_query) {
1110         s/"//g;
1111     }
1112     # append the limit to the query
1113     $query .= " " . $limit;
1114
1115     # Warnings if DEBUG
1116     if ($DEBUG) {
1117         warn "QUERY:" . $query;
1118         warn "QUERY CGI:" . $query_cgi;
1119         warn "QUERY DESC:" . $query_desc;
1120         warn "LIMIT:" . $limit;
1121         warn "LIMIT CGI:" . $limit_cgi;
1122         warn "LIMIT DESC:" . $limit_desc;
1123         warn "---------\nLeave buildQuery\n---------";
1124     }
1125     return (
1126         undef,              $query, $simple_query, $query_cgi,
1127         $query_desc,        $limit, $limit_cgi,    $limit_desc,
1128         $stopwords_removed, $query_type
1129     );
1130 }
1131
1132 =head2 searchResults
1133
1134 Format results in a form suitable for passing to the template
1135
1136 =cut
1137
1138 # IMO this subroutine is pretty messy still -- it's responsible for
1139 # building the HTML output for the template
1140 sub searchResults {
1141     my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults, $hidelostitems ) = @_;
1142     my $dbh = C4::Context->dbh;
1143     my @newresults;
1144
1145     #Build branchnames hash
1146     #find branchname
1147     #get branch information.....
1148     my %branches;
1149     my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches
1150     $bsth->execute();
1151     while ( my $bdata = $bsth->fetchrow_hashref ) {
1152         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
1153     }
1154 # FIXME - We build an authorised values hash here, using the default framework
1155 # though it is possible to have different authvals for different fws.
1156
1157     my $shelflocations =GetKohaAuthorisedValues('items.location','');
1158
1159     # get notforloan authorised value list (see $shelflocations  FIXME)
1160     my $notforloan_authorised_value = GetAuthValCode('items.notforloan','');
1161
1162     #Build itemtype hash
1163     #find itemtype & itemtype image
1164     my %itemtypes;
1165     $bsth =
1166       $dbh->prepare(
1167         "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
1168       );
1169     $bsth->execute();
1170     while ( my $bdata = $bsth->fetchrow_hashref ) {
1171                 foreach (qw(description imageurl summary notforloan)) {
1172                 $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_};
1173                 }
1174     }
1175
1176     #search item field code
1177     my $sth =
1178       $dbh->prepare(
1179 "SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
1180       );
1181     $sth->execute;
1182     my ($itemtag) = $sth->fetchrow;
1183
1184     ## find column names of items related to MARC
1185     my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items");
1186     $sth2->execute;
1187     my %subfieldstosearch;
1188     while ( ( my $column ) = $sth2->fetchrow ) {
1189         my ( $tagfield, $tagsubfield ) =
1190           &GetMarcFromKohaField( "items." . $column, "" );
1191         $subfieldstosearch{$column} = $tagsubfield;
1192     }
1193
1194     # handle which records to actually retrieve
1195     my $times;
1196     if ( $hits && $offset + $results_per_page <= $hits ) {
1197         $times = $offset + $results_per_page;
1198     }
1199     else {
1200         $times = $hits;  # FIXME: if $hits is undefined, why do we want to equal it?
1201     }
1202
1203         my $marcflavour = C4::Context->preference("marcflavour");
1204     # We get the biblionumber position in MARC
1205     my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber','');
1206     my $fw;
1207
1208     # loop through all of the records we've retrieved
1209     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
1210         my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
1211
1212         if ($bibliotag<10){
1213             $fw = GetFrameworkCode($marcrecord->field($bibliotag)->data);
1214         }else{
1215             $fw = GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf));
1216         }
1217
1218         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw );
1219         $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw);
1220         $oldbiblio->{result_number} = $i + 1;
1221
1222         # add imageurl to itemtype if there is one
1223         $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
1224
1225         $oldbiblio->{'authorised_value_images'}  = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) );
1226                 $oldbiblio->{normalized_upc}  = GetNormalizedUPC(       $marcrecord,$marcflavour);
1227                 $oldbiblio->{normalized_ean}  = GetNormalizedEAN(       $marcrecord,$marcflavour);
1228                 $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour);
1229                 $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour);
1230                 $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc});
1231
1232                 # edition information, if any
1233         $oldbiblio->{edition} = $oldbiblio->{editionstatement};
1234                 $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description};
1235  # Build summary if there is one (the summary is defined in the itemtypes table)
1236  # FIXME: is this used anywhere, I think it can be commented out? -- JF
1237         if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) {
1238             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1239             my @fields  = $marcrecord->fields();
1240
1241             my $newsummary;
1242             foreach my $line ( "$summary\n" =~ /(.*)\n/g ){
1243                 my $tags = {};
1244                 foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) {
1245                     $tag =~ /(.{3})(.)/;
1246                     if($marcrecord->field($1)){
1247                         my @abc = $marcrecord->field($1)->subfield($2);
1248                         $tags->{$tag} = $#abc + 1 ;
1249                     }
1250                 }
1251
1252                 # We catch how many times to repeat this line
1253                 my $max = 0;
1254                 foreach my $tag (keys(%$tags)){
1255                     $max = $tags->{$tag} if($tags->{$tag} > $max);
1256                  }
1257
1258                 # we replace, and repeat each line
1259                 for (my $i = 0 ; $i < $max ; $i++){
1260                     my $newline = $line;
1261
1262                     foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) {
1263                         $tag =~ /(.{3})(.)/;
1264
1265                         if($marcrecord->field($1)){
1266                             my @repl = $marcrecord->field($1)->subfield($2);
1267                             my $subfieldvalue = $repl[$i];
1268
1269                             if (! utf8::is_utf8($subfieldvalue)) {
1270                                 utf8::decode($subfieldvalue);
1271                             }
1272
1273                              $newline =~ s/\[$tag\]/$subfieldvalue/g;
1274                         }
1275                     }
1276                     $newsummary .= "$newline\n";
1277                 }
1278             }
1279
1280             $newsummary =~ s/\[(.*?)]//g;
1281             $newsummary =~ s/\n/<br\/>/g;
1282             $oldbiblio->{summary} = $newsummary;
1283         }
1284
1285         # Pull out the items fields
1286         my @fields = $marcrecord->field($itemtag);
1287
1288         # Setting item statuses for display
1289         my @available_items_loop;
1290         my @onloan_items_loop;
1291         my @other_items_loop;
1292
1293         my $available_items;
1294         my $onloan_items;
1295         my $other_items;
1296
1297         my $ordered_count         = 0;
1298         my $available_count       = 0;
1299         my $onloan_count          = 0;
1300         my $longoverdue_count     = 0;
1301         my $other_count           = 0;
1302         my $wthdrawn_count        = 0;
1303         my $itemlost_count        = 0;
1304         my $itembinding_count     = 0;
1305         my $itemdamaged_count     = 0;
1306         my $item_in_transit_count = 0;
1307         my $can_place_holds       = 0;
1308         my $items_count           = scalar(@fields);
1309         my $maxitems =
1310           ( C4::Context->preference('maxItemsinSearchResults') )
1311           ? C4::Context->preference('maxItemsinSearchResults') - 1
1312           : 1;
1313
1314         # loop through every item
1315         foreach my $field (@fields) {
1316             my $item;
1317
1318             # populate the items hash
1319             foreach my $code ( keys %subfieldstosearch ) {
1320                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1321             }
1322
1323                         my $hbranch     = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch'    : 'holdingbranch';
1324                         my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch';
1325             # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one
1326             if ($item->{$hbranch}) {
1327                 $item->{'branchname'} = $branches{$item->{$hbranch}};
1328             }
1329             elsif ($item->{$otherbranch}) {     # Last resort
1330                 $item->{'branchname'} = $branches{$item->{$otherbranch}};
1331             }
1332
1333                         my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber};
1334 # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
1335             if ( $item->{onloan} ) {
1336                 $onloan_count++;
1337                                 my $key = $prefix . $item->{onloan} . $item->{barcode};
1338                                 $onloan_items->{$key}->{due_date} = format_date($item->{onloan});
1339                                 $onloan_items->{$key}->{count}++ if $item->{$hbranch};
1340                                 $onloan_items->{$key}->{branchname} = $item->{branchname};
1341                                 $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1342                                 $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber};
1343                                 $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1344                 # if something's checked out and lost, mark it as 'long overdue'
1345                 if ( $item->{itemlost} ) {
1346                     $onloan_items->{$prefix}->{longoverdue}++;
1347                     $longoverdue_count++;
1348                 } else {        # can place holds as long as item isn't lost
1349                     $can_place_holds = 1;
1350                 }
1351             }
1352
1353          # items not on loan, but still unavailable ( lost, withdrawn, damaged )
1354             else {
1355
1356                 # item is on order
1357                 if ( $item->{notforloan} == -1 ) {
1358                     $ordered_count++;
1359                 }
1360
1361                 # is item in transit?
1362                 my $transfertwhen = '';
1363                 my ($transfertfrom, $transfertto);
1364
1365                 unless ($item->{wthdrawn}
1366                         || $item->{itemlost}
1367                         || $item->{damaged}
1368                         || $item->{notforloan}
1369                         || $items_count > 20) {
1370
1371                     # A couple heuristics to limit how many times
1372                     # we query the database for item transfer information, sacrificing
1373                     # accuracy in some cases for speed;
1374                     #
1375                     # 1. don't query if item has one of the other statuses
1376                     # 2. don't check transit status if the bib has
1377                     #    more than 20 items
1378                     #
1379                     # FIXME: to avoid having the query the database like this, and to make
1380                     #        the in transit status count as unavailable for search limiting,
1381                     #        should map transit status to record indexed in Zebra.
1382                     #
1383                     ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber});
1384                 }
1385
1386                 # item is withdrawn, lost or damaged
1387                 if (   $item->{wthdrawn}
1388                     || $item->{itemlost}
1389                     || $item->{damaged}
1390                     || $item->{notforloan}
1391                     || ($transfertwhen ne ''))
1392                 {
1393                     $wthdrawn_count++        if $item->{wthdrawn};
1394                     $itemlost_count++        if $item->{itemlost};
1395                     $itemdamaged_count++     if $item->{damaged};
1396                     $item_in_transit_count++ if $transfertwhen ne '';
1397                     $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan};
1398                     $other_count++;
1399
1400                                         my $key = $prefix . $item->{status};
1401                                         foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) {
1402                         $other_items->{$key}->{$_} = $item->{$_};
1403                                         }
1404                     $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0;
1405                                         $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
1406                                         $other_items->{$key}->{count}++ if $item->{$hbranch};
1407                                         $other_items->{$key}->{location} = $shelflocations->{ $item->{location} };
1408                                         $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1409                 }
1410                 # item is available
1411                 else {
1412                     $can_place_holds = 1;
1413                     $available_count++;
1414                                         $available_items->{$prefix}->{count}++ if $item->{$hbranch};
1415                                         foreach (qw(branchname itemcallnumber)) {
1416                         $available_items->{$prefix}->{$_} = $item->{$_};
1417                                         }
1418                                         $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} };
1419                                         $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} );
1420                 }
1421             }
1422         }    # notforloan, item level and biblioitem level
1423         my ( $availableitemscount, $onloanitemscount, $otheritemscount );
1424         $maxitems =
1425           ( C4::Context->preference('maxItemsinSearchResults') )
1426           ? C4::Context->preference('maxItemsinSearchResults') - 1
1427           : 1;
1428         for my $key ( sort keys %$onloan_items ) {
1429             (++$onloanitemscount > $maxitems) and last;
1430             push @onloan_items_loop, $onloan_items->{$key};
1431         }
1432         for my $key ( sort keys %$other_items ) {
1433             (++$otheritemscount > $maxitems) and last;
1434             push @other_items_loop, $other_items->{$key};
1435         }
1436         for my $key ( sort keys %$available_items ) {
1437             (++$availableitemscount > $maxitems) and last;
1438             push @available_items_loop, $available_items->{$key}
1439         }
1440
1441         # XSLT processing of some stuff
1442         if (C4::Context->preference("XSLTResultsDisplay") && !$scan) {
1443             $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display(
1444                 $oldbiblio->{biblionumber}, $marcrecord, 'Results' );
1445         }
1446
1447         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1448         $can_place_holds = 0
1449           if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan};
1450         $oldbiblio->{norequests} = 1 unless $can_place_holds;
1451         $oldbiblio->{itemsplural}          = 1 if $items_count > 1;
1452         $oldbiblio->{items_count}          = $items_count;
1453         $oldbiblio->{available_items_loop} = \@available_items_loop;
1454         $oldbiblio->{onloan_items_loop}    = \@onloan_items_loop;
1455         $oldbiblio->{other_items_loop}     = \@other_items_loop;
1456         $oldbiblio->{availablecount}       = $available_count;
1457         $oldbiblio->{availableplural}      = 1 if $available_count > 1;
1458         $oldbiblio->{onloancount}          = $onloan_count;
1459         $oldbiblio->{onloanplural}         = 1 if $onloan_count > 1;
1460         $oldbiblio->{othercount}           = $other_count;
1461         $oldbiblio->{otherplural}          = 1 if $other_count > 1;
1462         $oldbiblio->{wthdrawncount}        = $wthdrawn_count;
1463         $oldbiblio->{itemlostcount}        = $itemlost_count;
1464         $oldbiblio->{damagedcount}         = $itemdamaged_count;
1465         $oldbiblio->{intransitcount}       = $item_in_transit_count;
1466         $oldbiblio->{orderedcount}         = $ordered_count;
1467         $oldbiblio->{isbn} =~
1468           s/-//g;    # deleting - in isbn to enable amazon content
1469         push( @newresults, $oldbiblio )
1470             if(not $hidelostitems
1471                or (($items_count > $itemlost_count )
1472                     && $hidelostitems));
1473     }
1474
1475     return @newresults;
1476 }
1477
1478 =head2 SearchAcquisitions
1479     Search for acquisitions
1480 =cut
1481
1482 sub SearchAcquisitions{
1483     my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_;
1484
1485     my $dbh=C4::Context->dbh;
1486     # Variable initialization
1487     my $str=qq|
1488     SELECT marcxml
1489     FROM biblio
1490     LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1491     LEFT JOIN items ON items.biblionumber=biblio.biblionumber
1492     WHERE dateaccessioned BETWEEN ? AND ?
1493     |;
1494
1495     my (@params,@loopcriteria);
1496
1497     push @params, $datebegin->output("iso");
1498     push @params, $dateend->output("iso");
1499
1500     if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){
1501         if(C4::Context->preference("item-level_itypes")){
1502             $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1503         }else{
1504             $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") ";
1505         }
1506         push @params, @$itemtypes;
1507     }
1508
1509     if ($criteria =~/itemtype/){
1510         if(C4::Context->preference("item-level_itypes")){
1511             $str .= "AND items.itype=? ";
1512         }else{
1513             $str .= "AND biblioitems.itemtype=? ";
1514         }
1515
1516         if(scalar(@$itemtypes) == 0){
1517             my $itypes = GetItemTypes();
1518             for my $key (keys %$itypes){
1519                 push @$itemtypes, $key;
1520             }
1521         }
1522
1523         @loopcriteria= @$itemtypes;
1524     }elsif ($criteria=~/itemcallnumber/){
1525         $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%')
1526                  OR items.itemcallnumber is NULL
1527                  OR items.itemcallnumber = '')";
1528
1529         @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0);
1530     }else {
1531         $str .= "AND biblio.title LIKE CONCAT(?,'%') ";
1532         @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0);
1533     }
1534
1535     if ($orderby =~ /date_desc/){
1536         $str.=" ORDER BY dateaccessioned DESC";
1537     } else {
1538         $str.=" ORDER BY title";
1539     }
1540
1541     my $qdataacquisitions=$dbh->prepare($str);
1542
1543     my @loopacquisitions;
1544     foreach my $value(@loopcriteria){
1545         push @params,$value;
1546         my %cell;
1547         $cell{"title"}=$value;
1548         $cell{"titlecode"}=$value;
1549
1550         eval{$qdataacquisitions->execute(@params);};
1551
1552         if ($@){ warn "recentacquisitions Error :$@";}
1553         else {
1554             my @loopdata;
1555             while (my $data=$qdataacquisitions->fetchrow_hashref){
1556                 push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) };
1557             }
1558             $cell{"loopdata"}=\@loopdata;
1559         }
1560         push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0);
1561         pop @params;
1562     }
1563     $qdataacquisitions->finish;
1564     return \@loopacquisitions;
1565 }
1566 #----------------------------------------------------------------------
1567 #
1568 # Non-Zebra GetRecords#
1569 #----------------------------------------------------------------------
1570
1571 =head2 NZgetRecords
1572
1573   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1574
1575 =cut
1576
1577 sub NZgetRecords {
1578     my (
1579         $query,            $simple_query, $sort_by_ref,    $servers_ref,
1580         $results_per_page, $offset,       $expanded_facet, $branches,
1581         $query_type,       $scan
1582     ) = @_;
1583     warn "query =$query" if $DEBUG;
1584     my $result = NZanalyse($query);
1585     warn "results =$result" if $DEBUG;
1586     return ( undef,
1587         NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
1588         undef );
1589 }
1590
1591 =head2 NZanalyse
1592
1593   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1594   the list is built from an inverted index in the nozebra SQL table
1595   note that title is here only for convenience : the sorting will be very fast when requested on title
1596   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1597
1598 =cut
1599
1600 sub NZanalyse {
1601     my ( $string, $server ) = @_;
1602 #     warn "---------"       if $DEBUG;
1603     warn " NZanalyse" if $DEBUG;
1604 #     warn "---------"       if $DEBUG;
1605
1606  # $server contains biblioserver or authorities, depending on what we search on.
1607  #warn "querying : $string on $server";
1608     $server = 'biblioserver' unless $server;
1609
1610 # if we have a ", replace the content to discard temporarily any and/or/not inside
1611     my $commacontent;
1612     if ( $string =~ /"/ ) {
1613         $string =~ s/"(.*?)"/__X__/;
1614         $commacontent = $1;
1615         warn "commacontent : $commacontent" if $DEBUG;
1616     }
1617
1618 # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1619 # then, call again NZanalyse with $left and $right
1620 # (recursive until we find a leaf (=> something without and/or/not)
1621 # delete repeated operator... Would then go in infinite loop
1622     while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
1623     }
1624
1625     #process parenthesis before.
1626     if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
1627         my $left     = $1;
1628         my $right    = $4;
1629         my $operator = lc($3);   # FIXME: and/or/not are operators, not operands
1630         warn
1631 "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
1632           if $DEBUG;
1633         my $leftresult = NZanalyse( $left, $server );
1634         if ($operator) {
1635             my $rightresult = NZanalyse( $right, $server );
1636
1637             # OK, we have the results for right and left part of the query
1638             # depending of operand, intersect, union or exclude both lists
1639             # to get a result list
1640             if ( $operator eq ' and ' ) {
1641                 return NZoperatorAND($leftresult,$rightresult);
1642             }
1643             elsif ( $operator eq ' or ' ) {
1644
1645                 # just merge the 2 strings
1646                 return $leftresult . $rightresult;
1647             }
1648             elsif ( $operator eq ' not ' ) {
1649                 return NZoperatorNOT($leftresult,$rightresult);
1650             }
1651         }
1652         else {
1653 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1654             return $leftresult;
1655         }
1656     }
1657     warn "string :" . $string if $DEBUG;
1658     my $left = "";
1659     my $right = "";
1660     my $operator = "";
1661     if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) {
1662         $left     = $1;
1663         $right    = $3;
1664         $operator = lc($2);    # FIXME: and/or/not are operators, not operands
1665     }
1666     warn "no parenthesis. left : $left operator: $operator right: $right"
1667       if $DEBUG;
1668
1669     # it's not a leaf, we have a and/or/not
1670     if ($operator) {
1671
1672         # reintroduce comma content if needed
1673         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1674         $left  =~ s/__X__/"$commacontent"/ if $commacontent;
1675         warn "node : $left / $operator / $right\n" if $DEBUG;
1676         my $leftresult  = NZanalyse( $left,  $server );
1677         my $rightresult = NZanalyse( $right, $server );
1678         warn " leftresult : $leftresult" if $DEBUG;
1679         warn " rightresult : $rightresult" if $DEBUG;
1680         # OK, we have the results for right and left part of the query
1681         # depending of operand, intersect, union or exclude both lists
1682         # to get a result list
1683         if ( $operator eq ' and ' ) {
1684             warn "NZAND";
1685             return NZoperatorAND($leftresult,$rightresult);
1686         }
1687         elsif ( $operator eq ' or ' ) {
1688
1689             # just merge the 2 strings
1690             return $leftresult . $rightresult;
1691         }
1692         elsif ( $operator eq ' not ' ) {
1693             return NZoperatorNOT($leftresult,$rightresult);
1694         }
1695         else {
1696
1697 # this error is impossible, because of the regexp that isolate the operand, but just in case...
1698             die "error : operand unknown : $operator for $string";
1699         }
1700
1701         # it's a leaf, do the real SQL query and return the result
1702     }
1703     else {
1704         $string =~ s/__X__/"$commacontent"/ if $commacontent;
1705         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1706         #remove trailing blank at the beginning
1707         $string =~ s/^ //g;
1708         warn "leaf:$string" if $DEBUG;
1709
1710         # parse the string in in operator/operand/value again
1711         my $left = "";
1712         my $operator = "";
1713         my $right = "";
1714         if ($string =~ /(.*)(>=|<=)(.*)/) {
1715             $left     = $1;
1716             $operator = $2;
1717             $right    = $3;
1718         } else {
1719             $left = $string;
1720         }
1721 #         warn "handling leaf... left:$left operator:$operator right:$right"
1722 #           if $DEBUG;
1723         unless ($operator) {
1724             if ($string =~ /(.*)(>|<|=)(.*)/) {
1725                 $left     = $1;
1726                 $operator = $2;
1727                 $right    = $3;
1728                 warn
1729     "handling unless (operator)... left:$left operator:$operator right:$right"
1730                 if $DEBUG;
1731             } else {
1732                 $left = $string;
1733             }
1734         }
1735         my $results;
1736
1737 # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
1738         $left =~ s/ .*$//;
1739
1740         # automatic replace for short operators
1741         $left = 'title'            if $left =~ '^ti$';
1742         $left = 'author'           if $left =~ '^au$';
1743         $left = 'publisher'        if $left =~ '^pb$';
1744         $left = 'subject'          if $left =~ '^su$';
1745         $left = 'koha-Auth-Number' if $left =~ '^an$';
1746         $left = 'keyword'          if $left =~ '^kw$';
1747         $left = 'itemtype'         if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra
1748         warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
1749         my $dbh = C4::Context->dbh;
1750         if ( $operator && $left ne 'keyword' ) {
1751             #do a specific search
1752             $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
1753             my $sth = $dbh->prepare(
1754 "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
1755             );
1756             warn "$left / $operator / $right\n" if $DEBUG;
1757
1758             # split each word, query the DB and build the biblionumbers result
1759             #sanitizing leftpart
1760             $left =~ s/^\s+|\s+$//;
1761             foreach ( split / /, $right ) {
1762                 my $biblionumbers;
1763                 $_ =~ s/^\s+|\s+$//;
1764                 next unless $_;
1765                 warn "EXECUTE : $server, $left, $_" if $DEBUG;
1766                 $sth->execute( $server, $left, $_ )
1767                   or warn "execute failed: $!";
1768                 while ( my ( $line, $value ) = $sth->fetchrow ) {
1769
1770 # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1771 # otherwise, fill the result
1772                     $biblionumbers .= $line
1773                       unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
1774                     warn "result : $value "
1775                       . ( $right  =~ /\d/ ) . "=="
1776                       . ( $value =~ /\D/?$line:"" ) if $DEBUG;         #= $line";
1777                 }
1778
1779 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1780                 if ($results) {
1781                     warn "NZAND" if $DEBUG;
1782                     $results = NZoperatorAND($biblionumbers,$results);
1783                 } else {
1784                     $results = $biblionumbers;
1785                 }
1786             }
1787         }
1788         else {
1789       #do a complete search (all indexes), if index='kw' do complete search too.
1790             my $sth = $dbh->prepare(
1791 "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?"
1792             );
1793
1794             # split each word, query the DB and build the biblionumbers result
1795             foreach ( split / /, $string ) {
1796                 next if C4::Context->stopwords->{ uc($_) };   # skip if stopword
1797                 warn "search on all indexes on $_" if $DEBUG;
1798                 my $biblionumbers;
1799                 next unless $_;
1800                 $sth->execute( $server, $_ );
1801                 while ( my $line = $sth->fetchrow ) {
1802                     $biblionumbers .= $line;
1803                 }
1804
1805 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1806                 if ($results) {
1807                     $results = NZoperatorAND($biblionumbers,$results);
1808                 }
1809                 else {
1810                     warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1811                     $results = $biblionumbers;
1812                 }
1813             }
1814         }
1815         warn "return : $results for LEAF : $string" if $DEBUG;
1816         return $results;
1817     }
1818     warn "---------\nLeave NZanalyse\n---------" if $DEBUG;
1819 }
1820
1821 sub NZoperatorAND{
1822     my ($rightresult, $leftresult)=@_;
1823
1824     my @leftresult = split /;/, $leftresult;
1825     warn " @leftresult / $rightresult \n" if $DEBUG;
1826
1827     #             my @rightresult = split /;/,$leftresult;
1828     my $finalresult;
1829
1830 # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1831 # the result is stored twice, to have the same weight for AND than OR.
1832 # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1833 # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1834     foreach (@leftresult) {
1835         my $value = $_;
1836         my $countvalue;
1837         ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/);
1838         if ( $rightresult =~ /\Q$value\E-(\d+);/ ) {
1839             $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
1840             $finalresult .=
1841                 "$value-$countvalue;$value-$countvalue;";
1842         }
1843     }
1844     warn "NZAND DONE : $finalresult \n" if $DEBUG;
1845     return $finalresult;
1846 }
1847
1848 sub NZoperatorOR{
1849     my ($rightresult, $leftresult)=@_;
1850     return $rightresult.$leftresult;
1851 }
1852
1853 sub NZoperatorNOT{
1854     my ($leftresult, $rightresult)=@_;
1855
1856     my @leftresult = split /;/, $leftresult;
1857
1858     #             my @rightresult = split /;/,$leftresult;
1859     my $finalresult;
1860     foreach (@leftresult) {
1861         my $value=$_;
1862         $value=$1 if $value=~m/(.*)-\d+$/;
1863         unless ($rightresult =~ "$value-") {
1864             $finalresult .= "$_;";
1865         }
1866     }
1867     return $finalresult;
1868 }
1869
1870 =head2 NZorder
1871
1872   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1873
1874   TODO :: Description
1875
1876 =cut
1877
1878 sub NZorder {
1879     my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
1880     warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
1881
1882     # order title asc by default
1883     #     $ordering = '1=36 <i' unless $ordering;
1884     $results_per_page = 20 unless $results_per_page;
1885     $offset           = 0  unless $offset;
1886     my $dbh = C4::Context->dbh;
1887
1888     #
1889     # order by POPULARITY
1890     #
1891     if ( $ordering =~ /popularity/ ) {
1892         my %result;
1893         my %popularity;
1894
1895         # popularity is not in MARC record, it's builded from a specific query
1896         my $sth =
1897           $dbh->prepare("select sum(issues) from items where biblionumber=?");
1898         foreach ( split /;/, $biblionumbers ) {
1899             my ( $biblionumber, $title ) = split /,/, $_;
1900             $result{$biblionumber} = GetMarcBiblio($biblionumber);
1901             $sth->execute($biblionumber);
1902             my $popularity = $sth->fetchrow || 0;
1903
1904 # hint : the key is popularity.title because we can have
1905 # many results with the same popularity. In this case, sub-ordering is done by title
1906 # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1907 # (un-frequent, I agree, but we won't forget anything that way ;-)
1908             $popularity{ sprintf( "%10d", $popularity ) . $title
1909                   . $biblionumber } = $biblionumber;
1910         }
1911
1912     # sort the hash and return the same structure as GetRecords (Zebra querying)
1913         my $result_hash;
1914         my $numbers = 0;
1915         if ( $ordering eq 'popularity_dsc' ) {    # sort popularity DESC
1916             foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
1917                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1918                   $result{ $popularity{$key} }->as_usmarc();
1919             }
1920         }
1921         else {                                    # sort popularity ASC
1922             foreach my $key ( sort ( keys %popularity ) ) {
1923                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1924                   $result{ $popularity{$key} }->as_usmarc();
1925             }
1926         }
1927         my $finalresult = ();
1928         $result_hash->{'hits'}         = $numbers;
1929         $finalresult->{'biblioserver'} = $result_hash;
1930         return $finalresult;
1931
1932         #
1933         # ORDER BY author
1934         #
1935     }
1936     elsif ( $ordering =~ /author/ ) {
1937         my %result;
1938         foreach ( split /;/, $biblionumbers ) {
1939             my ( $biblionumber, $title ) = split /,/, $_;
1940             my $record = GetMarcBiblio($biblionumber);
1941             my $author;
1942             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1943                 $author = $record->subfield( '200', 'f' );
1944                 $author = $record->subfield( '700', 'a' ) unless $author;
1945             }
1946             else {
1947                 $author = $record->subfield( '100', 'a' );
1948             }
1949
1950 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1951 # and we don't want to get only 1 result for each of them !!!
1952             $result{ $author . $biblionumber } = $record;
1953         }
1954
1955     # sort the hash and return the same structure as GetRecords (Zebra querying)
1956         my $result_hash;
1957         my $numbers = 0;
1958         if ( $ordering eq 'author_za' ) {    # sort by author desc
1959             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
1960                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1961                   $result{$key}->as_usmarc();
1962             }
1963         }
1964         else {                               # sort by author ASC
1965             foreach my $key ( sort ( keys %result ) ) {
1966                 $result_hash->{'RECORDS'}[ $numbers++ ] =
1967                   $result{$key}->as_usmarc();
1968             }
1969         }
1970         my $finalresult = ();
1971         $result_hash->{'hits'}         = $numbers;
1972         $finalresult->{'biblioserver'} = $result_hash;
1973         return $finalresult;
1974
1975         #
1976         # ORDER BY callnumber
1977         #
1978     }
1979     elsif ( $ordering =~ /callnumber/ ) {
1980         my %result;
1981         foreach ( split /;/, $biblionumbers ) {
1982             my ( $biblionumber, $title ) = split /,/, $_;
1983             my $record = GetMarcBiblio($biblionumber);
1984             my $callnumber;
1985             my $frameworkcode = GetFrameworkCode($biblionumber);
1986             my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField(  'items.itemcallnumber', $frameworkcode);
1987                ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode)
1988                 unless $callnumber_tag;
1989             if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1990                 $callnumber = $record->subfield( '200', 'f' );
1991             } else {
1992                 $callnumber = $record->subfield( '100', 'a' );
1993             }
1994
1995 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1996 # and we don't want to get only 1 result for each of them !!!
1997             $result{ $callnumber . $biblionumber } = $record;
1998         }
1999
2000     # sort the hash and return the same structure as GetRecords (Zebra querying)
2001         my $result_hash;
2002         my $numbers = 0;
2003         if ( $ordering eq 'call_number_dsc' ) {    # sort by title desc
2004             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2005                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2006                   $result{$key}->as_usmarc();
2007             }
2008         }
2009         else {                                     # sort by title ASC
2010             foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
2011                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2012                   $result{$key}->as_usmarc();
2013             }
2014         }
2015         my $finalresult = ();
2016         $result_hash->{'hits'}         = $numbers;
2017         $finalresult->{'biblioserver'} = $result_hash;
2018         return $finalresult;
2019     }
2020     elsif ( $ordering =~ /pubdate/ ) {             #pub year
2021         my %result;
2022         foreach ( split /;/, $biblionumbers ) {
2023             my ( $biblionumber, $title ) = split /,/, $_;
2024             my $record = GetMarcBiblio($biblionumber);
2025             my ( $publicationyear_tag, $publicationyear_subfield ) =
2026               GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
2027             my $publicationyear =
2028               $record->subfield( $publicationyear_tag,
2029                 $publicationyear_subfield );
2030
2031 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2032 # and we don't want to get only 1 result for each of them !!!
2033             $result{ $publicationyear . $biblionumber } = $record;
2034         }
2035
2036     # sort the hash and return the same structure as GetRecords (Zebra querying)
2037         my $result_hash;
2038         my $numbers = 0;
2039         if ( $ordering eq 'pubdate_dsc' ) {    # sort by pubyear desc
2040             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2041                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2042                   $result{$key}->as_usmarc();
2043             }
2044         }
2045         else {                                 # sort by pub year ASC
2046             foreach my $key ( sort ( keys %result ) ) {
2047                 $result_hash->{'RECORDS'}[ $numbers++ ] =
2048                   $result{$key}->as_usmarc();
2049             }
2050         }
2051         my $finalresult = ();
2052         $result_hash->{'hits'}         = $numbers;
2053         $finalresult->{'biblioserver'} = $result_hash;
2054         return $finalresult;
2055
2056         #
2057         # ORDER BY title
2058         #
2059     }
2060     elsif ( $ordering =~ /title/ ) {
2061
2062 # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
2063         my %result;
2064         foreach ( split /;/, $biblionumbers ) {
2065             my ( $biblionumber, $title ) = split /,/, $_;
2066
2067 # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
2068 # and we don't want to get only 1 result for each of them !!!
2069 # hint & speed improvement : we can order without reading the record
2070 # so order, and read records only for the requested page !
2071             $result{ $title . $biblionumber } = $biblionumber;
2072         }
2073
2074     # sort the hash and return the same structure as GetRecords (Zebra querying)
2075         my $result_hash;
2076         my $numbers = 0;
2077         if ( $ordering eq 'title_az' ) {    # sort by title desc
2078             foreach my $key ( sort ( keys %result ) ) {
2079                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2080             }
2081         }
2082         else {                              # sort by title ASC
2083             foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2084                 $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2085             }
2086         }
2087
2088         # limit the $results_per_page to result size if it's more
2089         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2090
2091         # for the requested page, replace biblionumber by the complete record
2092         # speed improvement : avoid reading too much things
2093         for (
2094             my $counter = $offset ;
2095             $counter <= $offset + $results_per_page ;
2096             $counter++
2097           )
2098         {
2099             $result_hash->{'RECORDS'}[$counter] =
2100               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
2101         }
2102         my $finalresult = ();
2103         $result_hash->{'hits'}         = $numbers;
2104         $finalresult->{'biblioserver'} = $result_hash;
2105         return $finalresult;
2106     }
2107     else {
2108
2109 #
2110 # order by ranking
2111 #
2112 # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
2113         my %result;
2114         my %count_ranking;
2115         foreach ( split /;/, $biblionumbers ) {
2116             my ( $biblionumber, $title ) = split /,/, $_;
2117             $title =~ /(.*)-(\d)/;
2118
2119             # get weight
2120             my $ranking = $2;
2121
2122 # note that we + the ranking because ranking is calculated on weight of EACH term requested.
2123 # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
2124 # biblio N has ranking = 6
2125             $count_ranking{$biblionumber} += $ranking;
2126         }
2127
2128 # build the result by "inverting" the count_ranking hash
2129 # hing : as usual, we don't order by ranking only, to avoid having only 1 result for each rank. We build an hash on concat(ranking,biblionumber) instead
2130 #         warn "counting";
2131         foreach ( keys %count_ranking ) {
2132             $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
2133         }
2134
2135     # sort the hash and return the same structure as GetRecords (Zebra querying)
2136         my $result_hash;
2137         my $numbers = 0;
2138         foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
2139             $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
2140         }
2141
2142         # limit the $results_per_page to result size if it's more
2143         $results_per_page = $numbers - 1 if $numbers < $results_per_page;
2144
2145         # for the requested page, replace biblionumber by the complete record
2146         # speed improvement : avoid reading too much things
2147         for (
2148             my $counter = $offset ;
2149             $counter <= $offset + $results_per_page ;
2150             $counter++
2151           )
2152         {
2153             $result_hash->{'RECORDS'}[$counter] =
2154               GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
2155               if $result_hash->{'RECORDS'}[$counter];
2156         }
2157         my $finalresult = ();
2158         $result_hash->{'hits'}         = $numbers;
2159         $finalresult->{'biblioserver'} = $result_hash;
2160         return $finalresult;
2161     }
2162 }
2163
2164 =head2 enabled_staff_search_views
2165
2166 %hash = enabled_staff_search_views()
2167
2168 This function returns a hash that contains three flags obtained from the system
2169 preferences, used to determine whether a particular staff search results view
2170 is enabled.
2171
2172 =over 2
2173
2174 =item C<Output arg:>
2175
2176     * $hash{can_view_MARC} is true only if the MARC view is enabled
2177     * $hash{can_view_ISBD} is true only if the ISBD view is enabled
2178     * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled
2179
2180 =item C<usage in the script:>
2181
2182 =back
2183
2184 $template->param ( C4::Search::enabled_staff_search_views );
2185
2186 =cut
2187
2188 sub enabled_staff_search_views
2189 {
2190         return (
2191                 can_view_MARC                   => C4::Context->preference('viewMARC'),                 # 1 if the staff search allows the MARC view
2192                 can_view_ISBD                   => C4::Context->preference('viewISBD'),                 # 1 if the staff search allows the ISBD view
2193                 can_view_labeledMARC    => C4::Context->preference('viewLabeledMARC'),  # 1 if the staff search allows the Labeled MARC view
2194         );
2195 }
2196
2197 sub AddSearchHistory{
2198         my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_;
2199     my $dbh = C4::Context->dbh;
2200
2201     # Add the request the user just made
2202     my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())";
2203     my $sth   = $dbh->prepare($sql);
2204     $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total);
2205         return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef);
2206 }
2207
2208 sub GetSearchHistory{
2209         my ($borrowernumber,$session)=@_;
2210     my $dbh = C4::Context->dbh;
2211
2212     # Add the request the user just made
2213     my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)";
2214     my $sth   = $dbh->prepare($query);
2215         $sth->execute($borrowernumber, $session);
2216     return  $sth->fetchall_hashref({});
2217 }
2218
2219 =head2 z3950_search_args
2220
2221 $arrayref = z3950_search_args($matchpoints)
2222
2223 This function returns an array reference that contains the search parameters to be
2224 passed to the Z39.50 search script (z3950_search.pl). The array elements
2225 are hash refs whose keys are name, value and encvalue, and whose values are the
2226 name of a search parameter, the value of that search parameter and the URL encoded
2227 value of that parameter.
2228
2229 The search parameter names are lccn, isbn, issn, title, author, dewey and subject.
2230
2231 The search parameter values are obtained from the bibliographic record whose
2232 data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData().
2233
2234 If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g.
2235 a general purpose search argument. In this case, the returned array contains only
2236 entry: the key is 'title' and the value and encvalue are derived from $matchpoints.
2237
2238 If a search parameter value is undefined or empty, it is not included in the returned
2239 array.
2240
2241 The returned array reference may be passed directly to the template parameters.
2242
2243 =over 2
2244
2245 =item C<Output arg:>
2246
2247     * $array containing hash refs as described above
2248
2249 =item C<usage in the script:>
2250
2251 =back
2252
2253 $data = Biblio::GetBiblioData($bibno);
2254 $template->param ( MYLOOP => C4::Search::z3950_search_args($data) )
2255
2256 *OR*
2257
2258 $template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) )
2259
2260 =cut
2261
2262 sub z3950_search_args {
2263     my $bibrec = shift;
2264     $bibrec = { title => $bibrec } if !ref $bibrec;
2265     my $array = [];
2266     for my $field (qw/ lccn isbn issn title author dewey subject /)
2267     {
2268         my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field});
2269         push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field};
2270     }
2271     return $array;
2272 }
2273
2274 =head2 BiblioAddAuthorities
2275
2276 ( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);
2277
2278 this function finds the authorities linked to the biblio
2279     * search in the authority DB for the same authid (in $9 of the biblio)
2280     * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
2281     * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
2282 OR adds a new authority record
2283
2284 =over 2
2285
2286 =item C<input arg:>
2287
2288     * $record is the MARC record in question (marc blob)
2289     * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)
2290
2291 =item C<Output arg:>
2292
2293     * $countlinked is the number of authorities records that are linked to this authority
2294     * $countcreated
2295
2296 =item C<BUGS>
2297     * I had to add this to Search.pm (instead of the logical Biblio.pm) because of a circular dependency (this sub uses SimpleSearch, and Search.pm uses Biblio.pm)
2298 =back
2299
2300 =cut
2301
2302
2303 sub BiblioAddAuthorities{
2304   my ( $record, $frameworkcode ) = @_;
2305   my $dbh=C4::Context->dbh;
2306   my $query=$dbh->prepare(qq|
2307 SELECT authtypecode,tagfield
2308 FROM marc_subfield_structure
2309 WHERE frameworkcode=?
2310 AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|);
2311 # SELECT authtypecode,tagfield
2312 # FROM marc_subfield_structure
2313 # WHERE frameworkcode=?
2314 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
2315   $query->execute($frameworkcode);
2316   my ($countcreated,$countlinked);
2317   while (my $data=$query->fetchrow_hashref){
2318     foreach my $field ($record->field($data->{tagfield})){
2319       next if ($field->subfield('3')||$field->subfield('9'));
2320       # No authorities id in the tag.
2321       # Search if there is any authorities to link to.
2322       my $query='at='.$data->{authtypecode}.' ';
2323       map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)}  $field->subfields();
2324       my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
2325     # there is only 1 result
2326           if ( $error ) {
2327         warn "BIBLIOADDSAUTHORITIES: $error";
2328             return (0,0) ;
2329           }
2330       if ($results && scalar(@$results)==1) {
2331         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2332         $field->add_subfields('9'=>$marcrecord->field('001')->data);
2333         $countlinked++;
2334       } elsif (scalar(@$results)>1) {
2335    #More than One result
2336    #This can comes out of a lack of a subfield.
2337 #         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
2338 #         $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
2339   $countlinked++;
2340       } else {
2341   #There are no results, build authority record, add it to Authorities, get authid and add it to 9
2342   ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
2343   ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
2344          my $authtypedata=C4::AuthoritiesMarc->GetAuthType($data->{authtypecode});
2345          next unless $authtypedata;
2346          my $marcrecordauth=MARC::Record->new();
2347          my $authfield=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$field->subfield('a'));
2348          map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )}  $field->subfields();
2349          $marcrecordauth->insert_fields_ordered($authfield);
2350
2351          # bug 2317: ensure new authority knows it's using UTF-8; currently
2352          # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
2353          # automatically for UNIMARC (by not transcoding)
2354          # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
2355          # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
2356          # of change to a core API just before the 3.0 release.
2357          if (C4::Context->preference('marcflavour') eq 'MARC21') {
2358             SetMarcUnicodeFlag($marcrecordauth, 'MARC21');
2359          }
2360
2361 #          warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
2362
2363          my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode});
2364          $countcreated++;
2365          $field->add_subfields('9'=>$authid);
2366       }
2367     }
2368   }
2369   return ($countlinked,$countcreated);
2370 }
2371
2372 =head2 GetDistinctValues($field);
2373
2374 C<$field> is a reference to the fields array
2375
2376 =cut
2377
2378 sub GetDistinctValues {
2379     my ($fieldname,$string)=@_;
2380     # returns a reference to a hash of references to branches...
2381     if ($fieldname=~/\./){
2382                         my ($table,$column)=split /\./, $fieldname;
2383                         my $dbh = C4::Context->dbh;
2384                         warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column ";
2385                         my $sth = $dbh->prepare("select DISTINCT($column) as value, count(*) as cnt from $table ".($string?" where $column like \"$string%\"":"")."group by value order by $column ");
2386                         $sth->execute;
2387                         my $elements=$sth->fetchall_arrayref({});
2388                         return $elements;
2389    }
2390    else {
2391                 $string||= qq("");
2392                 my @servers=qw<biblioserver authorityserver>;
2393                 my (@zconns,@results);
2394         for ( my $i = 0 ; $i < @servers ; $i++ ) {
2395                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
2396                         $results[$i] =
2397                       $zconns[$i]->scan(
2398                         ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i])
2399                       );
2400                 }
2401                 # The big moment: asynchronously retrieve results from all servers
2402                 my @elements;
2403                 while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
2404                         my $ev = $zconns[ $i - 1 ]->last_event();
2405                         if ( $ev == ZOOM::Event::ZEND ) {
2406                                 next unless $results[ $i - 1 ];
2407                                 my $size = $results[ $i - 1 ]->size();
2408                                 if ( $size > 0 ) {
2409                       for (my $j=0;$j<$size;$j++){
2410                                                 my %hashscan;
2411                                                 @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j);
2412                                                 push @elements, \%hashscan;
2413                                           }
2414                                 }
2415                         }
2416                 }
2417                 return \@elements;
2418    }
2419 }
2420
2421
2422 END { }    # module clean-up code here (global destructor)
2423
2424 1;
2425 __END__
2426
2427 =head1 AUTHOR
2428
2429 Koha Developement team <info@koha.org>
2430
2431 =cut