C4/Search.pm

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