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