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 require Exporter;
  20 use C4::Context;
  21 use C4::Biblio;    # GetMarcFromKohaField
  22 use C4::Koha;      # getFacets
  23 use Lingua::Stem;
  24 use C4::Date;
  25
  26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  27
  28 # set the version for version checking
  29 $VERSION = 3.00;
  30 $DEBUG=1;
  31
  32 =head1 NAME
  33
  34 C4::Search - Functions for searching the Koha catalog.
  35
  36 =head1 SYNOPSIS
  37
  38 see opac/opac-search.pl or catalogue/search.pl for example of usage
  39
  40 =head1 DESCRIPTION
  41
  42 This module provides the searching facilities for the Koha into a zebra catalog.
  43
  44 =head1 FUNCTIONS
  45
  46 =cut
  47
  48 @ISA    = qw(Exporter);
  49 @EXPORT = qw(
  50   &SimpleSearch
  51   &findseealso
  52   &FindDuplicate
  53   &searchResults
  54   &getRecords
  55   &buildQuery
  56   &NZgetRecords
  57   &ModBiblios
  58 );
  59
  60 # make all your functions, whether exported or not;
  61
  62 =head2 findseealso($dbh,$fields);
  63
  64 C<$dbh> is a link to the DB handler.
  65
  66 use C4::Context;
  67 my $dbh =C4::Context->dbh;
  68
  69 C<$fields> is a reference to the fields array
  70
  71 This function modify the @$fields array and add related fields to search on.
  72
  73 =cut
  74
  75 sub findseealso {
  76     my ( $dbh, $fields ) = @_;
  77     my $tagslib = GetMarcStructure( 1 );
  78     for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
  79         my ($tag)      = substr( @$fields[$i], 1, 3 );
  80         my ($subfield) = substr( @$fields[$i], 4, 1 );
  81         @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
  82           if ( $tagslib->{$tag}->{$subfield}->{seealso} );
  83     }
  84 }
  85
  86 =head2 FindDuplicate
  87
  88 ($biblionumber,$biblionumber,$title) = FindDuplicate($record);
  89
  90 =cut
  91
  92 sub FindDuplicate {
  93     my ($record) = @_;
  94     my $dbh = C4::Context->dbh;
  95     my $result = TransformMarcToKoha( $dbh, $record, '' );
  96     my $sth;
  97     my $query;
  98     my $search;
  99     my $type;
 100     my ( $biblionumber, $title );
 101
 102     # search duplicate on ISBN, easy and fast..
 103     # ... normalize first
 104     if ( $result->{isbn} ) {
 105         $result->{isbn} =~ s/\(.*$//;
 106         $result->{isbn} =~ s/\s+$//;
 107     }
 108     #$search->{'avoidquerylog'}=1;
 109     if ( $result->{isbn} ) {
 110         $query = "isbn=$result->{isbn}";
 111     }
 112     else {
 113         $result->{title} =~ s /\\//g;
 114         $result->{title} =~ s /\"//g;
 115         $result->{title} =~ s /\(//g;
 116         $result->{title} =~ s /\)//g;
 117         # remove valid operators
 118         $result->{title} =~ s/(and|or|not)//g;
 119         $query = "ti,ext=$result->{title}";
 120         $query .= " and itemtype=$result->{itemtype}" if ($result->{itemtype});
 121         if ($result->{author}){
 122           $result->{author} =~ s /\\//g;
 123           $result->{author} =~ s /\"//g;
 124           $result->{author} =~ s /\(//g;
 125           $result->{author} =~ s /\)//g;
 126           # remove valid operators
 127           $result->{author} =~ s/(and|or|not)//g;
 128           $query .= " and au,ext=$result->{author}";
 129         }
 130     }
 131     my ($error,$searchresults) =
 132       SimpleSearch($query); # FIXME :: hardcoded !
 133     my @results;
 134     foreach my $possible_duplicate_record (@$searchresults) {
 135         my $marcrecord =
 136           MARC::Record->new_from_usmarc($possible_duplicate_record);
 137         my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
 138
 139         # FIXME :: why 2 $biblionumber ?
 140         if ($result){
 141           push @results, $result->{'biblionumber'};
 142           push @results, $result->{'title'};
 143         }
 144     }
 145     return @results;
 146 }
 147
 148 =head2 SimpleSearch
 149
 150 ($error,$results) = SimpleSearch($query,@servers);
 151
 152 this function performs a simple search on the catalog using zoom.
 153
 154 =over 2
 155
 156 =item C<input arg:>
 157
 158     * $query could be a simple keyword or a complete CCL query wich is depending on your ccl file.
 159     * @servers is optionnal. default one is read on koha.xml
 160
 161 =item C<Output arg:>
 162     * $error is a string which containt the description error if there is one. Else it's empty.
 163     * \@results is an array of marc record.
 164
 165 =item C<usage in the script:>
 166
 167 =back
 168
 169 my ($error, $marcresults) = SimpleSearch($query);
 170
 171 if (defined $error) {
 172     $template->param(query_error => $error);
 173     warn "error: ".$error;
 174     output_html_with_http_headers $input, $cookie, $template->output;
 175     exit;
 176 }
 177
 178 my $hits = scalar @$marcresults;
 179 my @results;
 180
 181 for(my $i=0;$i<$hits;$i++) {
 182     my %resultsloop;
 183     my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
 184     my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,'');
 185
 186     #build the hash for the template.
 187     $resultsloop{highlight}       = ($i % 2)?(1):(0);
 188     $resultsloop{title}           = $biblio->{'title'};
 189     $resultsloop{subtitle}        = $biblio->{'subtitle'};
 190     $resultsloop{biblionumber}    = $biblio->{'biblionumber'};
 191     $resultsloop{author}          = $biblio->{'author'};
 192     $resultsloop{publishercode}   = $biblio->{'publishercode'};
 193     $resultsloop{publicationyear} = $biblio->{'publicationyear'};
 194
 195     push @results, \%resultsloop;
 196 }
 197 $template->param(result=>\@results);
 198
 199 =cut
 200
 201 sub SimpleSearch {
 202     my $query   = shift;
 203     if (C4::Context->preference('NoZebra')) {
 204         my $result = NZorder(NZanalyse($query))->{'biblioserver'}->{'RECORDS'};
 205         return (undef,$result);
 206     } else {
 207         my @servers = @_;
 208         my @results;
 209         my @tmpresults;
 210         my @zconns;
 211         return ( "No query entered", undef ) unless $query;
 212
 213         #@servers = (C4::Context->config("biblioserver")) unless @servers;
 214         @servers =
 215         ("biblioserver") unless @servers
 216         ;    # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
 217
 218         # Connect & Search
 219         for ( my $i = 0 ; $i < @servers ; $i++ ) {
 220             eval {
 221                 $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 222                 $tmpresults[$i] =
 223                 $zconns[$i]
 224                 ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
 225
 226                 # getting error message if one occured.
 227                 my $error =
 228                   $zconns[$i]->errmsg() . " ("
 229                 . $zconns[$i]->errcode() . ") "
 230                 . $zconns[$i]->addinfo() . " "
 231                 . $zconns[$i]->diagset();
 232
 233                 return ( $error, undef ) if $zconns[$i]->errcode();
 234             };
 235             if ($@) {
 236                 # caught a ZOOM::Exception
 237                 my $error =
 238                   $@->message() . " ("
 239                 . $@->code() . ") "
 240                 . $@->addinfo() . " "
 241                 . $@->diagset();
 242                 warn $error;
 243                 return ( $error, undef );
 244             }
 245         }
 246         my $hits;
 247         my $ev;
 248         while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 249             $ev = $zconns[ $i - 1 ]->last_event();
 250             if ( $ev == ZOOM::Event::ZEND ) {
 251                 $hits = $tmpresults[ $i - 1 ]->size();
 252             }
 253             if ( $hits > 0 ) {
 254                 for ( my $j = 0 ; $j < $hits ; $j++ ) {
 255                     my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
 256                     push @results, $record;
 257                 }
 258             }
 259         }
 260         return ( undef, \@results );
 261     }
 262 }
 263
 264 # performs the search
 265 sub getRecords {
 266     my (
 267         $koha_query,     $simple_query,  $sort_by_ref,
 268         $servers_ref,    $results_per_page, $offset,
 269         $expanded_facet, $branches,         $query_type,
 270         $scan
 271     ) = @_;
 272 #     warn "Query : $koha_query";
 273     my @servers = @$servers_ref;
 274     my @sort_by = @$sort_by_ref;
 275
 276     # create the zoom connection and query object
 277     my $zconn;
 278     my @zconns;
 279     my @results;
 280     my $results_hashref = ();
 281
 282     ### FACETED RESULTS
 283     my $facets_counter = ();
 284     my $facets_info    = ();
 285     my $facets         = getFacets();
 286
 287     #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
 288     my @facets_loop;    # stores the ref to array of hashes for template
 289     for ( my $i = 0 ; $i < @servers ; $i++ ) {
 290         $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
 291
 292 # perform the search, create the results objects
 293 # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
 294         my $query_to_use;
 295         if ( $servers[$i] =~ /biblioserver/ ) {
 296             $query_to_use = $koha_query;
 297         }
 298         else {
 299             $query_to_use = $simple_query;
 300         }
 301
 302                 #$query_to_use = $simple_query if $scan;
 303                 #warn $simple_query if ($scan && $DEBUG);
 304         # check if we've got a query_type defined
 305         eval {
 306             if ($query_type)
 307             {
 308                 if ( $query_type =~ /^ccl/ ) {
 309                     $query_to_use =~
 310                       s/\:/\=/g;    # change : to = last minute (FIXME)
 311
 312                     #                 warn "CCL : $query_to_use";
 313                     $results[$i] =
 314                       $zconns[$i]->search(
 315                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 316                       );
 317                 }
 318                 elsif ( $query_type =~ /^cql/ ) {
 319
 320                     #                 warn "CQL : $query_to_use";
 321                     $results[$i] =
 322                       $zconns[$i]->search(
 323                         new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
 324                 }
 325                 elsif ( $query_type =~ /^pqf/ ) {
 326
 327                     #                 warn "PQF : $query_to_use";
 328                     $results[$i] =
 329                       $zconns[$i]->search(
 330                         new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
 331                 }
 332             }
 333             else {
 334                 if ($scan) {
 335                      #               warn "preparing to scan:$query_to_use";
 336                     $results[$i] =
 337                       $zconns[$i]->scan(
 338                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 339                       );
 340                 }
 341                 else {
 342                     #             warn "LAST : $query_to_use";
 343                     $results[$i] =
 344                       $zconns[$i]->search(
 345                         new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
 346                       );
 347                 }
 348             }
 349         };
 350         if ($@) {
 351             warn "WARNING: query problem with $query_to_use " . $@;
 352         }
 353
 354         # concatenate the sort_by limits and pass them to the results object
 355         my $sort_by;
 356         foreach my $sort (@sort_by) {
 357             if ($sort eq "author_az") {
 358                 $sort_by.="1=1003 <i ";
 359             }
 360             elsif ($sort eq "author_za") {
 361                 $sort_by.="1=1003 >i ";
 362             }
 363             elsif ($sort eq "popularity_asc") {
 364                 $sort_by.="1=9003 <i ";
 365             }
 366             elsif ($sort eq "popularity_dsc") {
 367                 $sort_by.="1=9003 >i ";
 368             }
 369             elsif ($sort eq "call_number_asc") {
 370                 $sort_by.="1=20  <i ";
 371             }
 372             elsif ($sort eq "call_number_dsc") {
 373                 $sort_by.="1=20 >i ";
 374             }
 375             elsif ($sort eq "pubdate_asc") {
 376                 $sort_by.="1=31 <i ";
 377             }
 378             elsif ($sort eq "pubdate_dsc") {
 379                 $sort_by.="1=31 >i ";
 380             }
 381             elsif ($sort eq "acqdate_asc") {
 382                 $sort_by.="1=32 <i ";
 383             }
 384             elsif ($sort eq "acqdate_dsc") {
 385                 $sort_by.="1=32 >i ";
 386             }
 387             elsif ($sort eq "title_az") {
 388                 $sort_by.="1=4 <i ";
 389             }
 390             elsif ($sort eq "title_za") {
 391                 $sort_by.="1=4 >i ";
 392             }
 393         }
 394         if ($sort_by) {
 395             if ( $results[$i]->sort( "yaz", $sort_by ) < 0) {
 396                 warn "WARNING sort $sort_by failed";
 397             }
 398         }
 399     }
 400     while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
 401         my $ev = $zconns[ $i - 1 ]->last_event();
 402         if ( $ev == ZOOM::Event::ZEND ) {
 403             my $size = $results[ $i - 1 ]->size();
 404             if ( $size > 0 ) {
 405                 my $results_hash;
 406                 #$results_hash->{'server'} = $servers[$i-1];
 407                 # loop through the results
 408                 $results_hash->{'hits'} = $size;
 409                 my $times;
 410                 if ( $offset + $results_per_page <= $size ) {
 411                     $times = $offset + $results_per_page;
 412                 }
 413                 else {
 414                     $times = $size;
 415                 }
 416                 for ( my $j = $offset ; $j < $times ; $j++ )
 417                 {   #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
 418                     my $records_hash;
 419                     my $record;
 420                     my $facet_record;
 421                     ## This is just an index scan
 422                     if ($scan) {
 423                         my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
 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
 431                         # srote the minimal record in author/title (depending on MARC flavour)
 432                         if ( C4::Context->preference("marcflavour") eq
 433                             "UNIMARC" )
 434                         {
 435                             $tmptitle = MARC::Field->new(
 436                                 '200', ' ', ' ',
 437                                 a => $term,
 438                                 f => $occ
 439                             );
 440                         }
 441                         else {
 442                             $tmptitle = MARC::Field->new(
 443                                 '245', ' ', ' ',
 444                                 a => $term,
 445                                 b => $occ
 446                             );
 447                         }
 448                         $tmprecord->append_fields($tmptitle);
 449                         $results_hash->{'RECORDS'}[$j] =
 450                           $tmprecord->as_usmarc();
 451                     }
 452                     else {
 453                         $record = $results[ $i - 1 ]->record($j)->raw();
 454
 455                         #warn "RECORD $j:".$record;
 456                         $results_hash->{'RECORDS'}[$j] =
 457                           $record;    # making a reference to a hash
 458                                       # Fill the facets while we're looping
 459                         $facet_record = MARC::Record->new_from_usmarc($record);
 460
 461                         #warn $servers[$i-1].$facet_record->title();
 462                         for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
 463                             if ( $facets->[$k] ) {
 464                                 my @fields;
 465                                 for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
 466                                     push @fields, $facet_record->field($tag);
 467                                 }
 468                                 for my $field (@fields) {
 469                                     my @subfields = $field->subfields();
 470                                     for my $subfield (@subfields) {
 471                                         my ( $code, $data ) = @$subfield;
 472                                         if ( $code eq
 473                                             $facets->[$k]->{'subfield'} )
 474                                         {
 475                                             $facets_counter->{ $facets->[$k]
 476                                                   ->{'link_value'} }->{$data}++;
 477                                         }
 478                                     }
 479                                 }
 480                                 $facets_info->{ $facets->[$k]->{'link_value'} }
 481                                   ->{'label_value'} =
 482                                   $facets->[$k]->{'label_value'};
 483                                 $facets_info->{ $facets->[$k]->{'link_value'} }
 484                                   ->{'expanded'} = $facets->[$k]->{'expanded'};
 485                             }
 486                         }
 487                     }
 488                 }
 489                 $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
 490             }
 491
 492             #print "connection ", $i-1, ": $size hits";
 493             #print $results[$i-1]->record(0)->render() if $size > 0;
 494             # BUILD FACETS
 495             for my $link_value (
 496                 sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
 497                 keys %$facets_counter
 498               )
 499             {
 500                 my $expandable;
 501                 my $number_of_facets;
 502                 my @this_facets_array;
 503                 for my $one_facet (
 504                     sort {
 505                         $facets_counter->{$link_value}
 506                           ->{$b} <=> $facets_counter->{$link_value}->{$a}
 507                     } keys %{ $facets_counter->{$link_value} }
 508                   )
 509                 {
 510                     $number_of_facets++;
 511                     if (   ( $number_of_facets < 6 )
 512                         || ( $expanded_facet eq $link_value )
 513                         || ( $facets_info->{$link_value}->{'expanded'} ) )
 514                     {
 515
 516                        # sanitize the link value ), ( will cause errors with CCL
 517                         my $facet_link_value = $one_facet;
 518                         $facet_link_value =~ s/(\(|\))/ /g;
 519
 520                         # fix the length that will display in the label
 521                         my $facet_label_value = $one_facet;
 522                         $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
 523                           unless length($facet_label_value) <= 20;
 524
 525                        # well, if it's a branch, label by the name, not the code
 526                         if ( $link_value =~ /branch/ ) {
 527                             $facet_label_value =
 528                               $branches->{$one_facet}->{'branchname'};
 529                         }
 530
 531                  # but we're down with the whole label being in the link's title
 532                         my $facet_title_value = $one_facet;
 533
 534                         push @this_facets_array,
 535                           (
 536                             {
 537                                 facet_count =>
 538                                   $facets_counter->{$link_value}->{$one_facet},
 539                                 facet_label_value => $facet_label_value,
 540                                 facet_title_value => $facet_title_value,
 541                                 facet_link_value  => $facet_link_value,
 542                                 type_link_value   => $link_value,
 543                             },
 544                           );
 545                     }
 546                 }
 547                 unless ( $facets_info->{$link_value}->{'expanded'} ) {
 548                     $expandable = 1
 549                       if ( ( $number_of_facets > 6 )
 550                         && ( $expanded_facet ne $link_value ) );
 551                 }
 552                 push @facets_loop,
 553                   (
 554                     {
 555                         type_link_value => $link_value,
 556                         type_id         => $link_value . "_id",
 557                         type_label      =>
 558                           $facets_info->{$link_value}->{'label_value'},
 559                         facets     => \@this_facets_array,
 560                         expandable => $expandable,
 561                         expand     => $link_value,
 562                     }
 563                   );
 564             }
 565         }
 566     }
 567     return ( undef, $results_hashref, \@facets_loop );
 568 }
 569
 570 # STOPWORDS
 571 sub _remove_stopwords {
 572     my ($operand,$index) = @_;
 573         my @stopwords_removed;
 574     # phrase and exact-qualified indexes shouldn't have stopwords removed
 575     if ($index!~m/phr|ext/){
 576     # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
 577     #       we use IsAlpha unicode definition, to deal correctly with diacritics.
 578     #       otherwise, a French word like "leçon" woudl be split into "le" "çon", le
 579     #       is an empty word, we'd get "çon" and wouldn't find anything...
 580         foreach (keys %{C4::Context->stopwords}) {
 581             next if ($_ =~/(and|or|not)/); # don't remove operators
 582                         if ($operand =~ /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/) {
 583                 $operand=~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi;
 584                 $operand=~ s/^$_\P{IsAlpha}/ /gi;
 585                 $operand=~ s/\P{IsAlpha}$_$/ /gi;
 586                                 push @stopwords_removed, $_;
 587                         }
 588         }
 589     }
 590     return ($operand, \@stopwords_removed);
 591 }
 592
 593 # TRUNCATION
 594 sub _detect_truncation {
 595     my ($operand,$index) = @_;
 596     my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
 597     $operand =~s/^ //g;
 598     my @wordlist= split (/\s/,$operand);
 599     foreach my $word (@wordlist){
 600         if ($word=~s/^\*([^\*]+)\*$/$1/){
 601             push @rightlefttruncated,$word;
 602         }
 603         elsif($word=~s/^\*([^\*]+)$/$1/){
 604             push @lefttruncated,$word;
 605         }
 606         elsif ($word=~s/^([^\*]+)\*$/$1/){
 607             push @righttruncated,$word;
 608         }
 609         elsif (index($word,"*")<0){
 610             push @nontruncated,$word;
 611         }
 612         else {
 613             push @regexpr,$word;
 614         }
 615     }
 616     return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr);
 617 }
 618
 619 sub _build_stemmed_operand {
 620     my ($operand) = @_;
 621     my $stemmed_operand;
 622     # FIXME: the locale should be set based on the user's language and/or search choice
 623     my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
 624     # FIXME: these should be stored in the db so the librarian can modify the behavior
 625     $stemmer->add_exceptions(
 626             {
 627                 'and' => 'and',
 628                 'or'  => 'or',
 629                 'not' => 'not',
 630             }
 631
 632         );
 633     my @words = split( / /, $operand );
 634     my $stems = $stemmer->stem(@words);
 635     for my $stem (@$stems) {
 636             $stemmed_operand .= "$stem";
 637             $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
 638             $stemmed_operand .= " ";
 639     }
 640     #warn "STEMMED OPERAND: $stemmed_operand";
 641     return $stemmed_operand;
 642 }
 643
 644 sub _build_weighted_query {
 645     # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
 646     # pretty well but will work much better when we have an actual query parser
 647     my ($operand,$stemmed_operand,$index) = @_;
 648     my $stemming      = C4::Context->preference("QueryStemming")     || 0;
 649     my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
 650     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
 651
 652     my $weighted_query .= "(rk=(";     # Specifies that we're applying rank
 653
 654     # Keyword, or, no index specified
 655     if ( ( $index eq 'kw' ) || ( !$index ) ) {
 656         $weighted_query .= "Title-cover,ext,r1=\"$operand\"";       # exact title-cover
 657         $weighted_query .= " or ti,ext,r2=\"$operand\"";            # exact title
 658         $weighted_query .= " or ti,phr,r3=\"$operand\"";            # phrase title
 659        #$weighted_query .= " or any,ext,r4=$operand";               # exact any
 660        #$weighted_query .=" or kw,wrdl,r5=\"$operand\"";            # word list any
 661         $weighted_query .= " or wrd,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy, word list
 662         $weighted_query .= " or wrd,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming, right truncation
 663        # embedded sorting: 0 a-z; 1 z-a
 664        # $weighted_query .= ") or (sort1,aut=1";
 665     }
 666         elsif ( $index eq 'bc' ) {
 667                 $weighted_query .= "bc=\"$operand\"";
 668         }
 669     # if the index already has more than one qualifier, just wrap the operand
 670     # in quotes and pass it back
 671     elsif ($index =~ ',') {
 672         $weighted_query .=" $index=\"$operand\"";
 673     }
 674     #TODO: build better cases based on specific search indexes
 675     else {
 676        $weighted_query .= " $index,ext,r1=\"$operand\"";            # exact index
 677        #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
 678        $weighted_query .= " or $index,phr,r3=\"$operand\"";         # phrase index
 679        $weighted_query .= " or $index,rt,wrd,r3=\"$operand\"";      # word list index
 680     }
 681     $weighted_query .= "))";    # close rank specification
 682     return $weighted_query;
 683 }
 684
 685 # build the query itself
 686 sub buildQuery {
 687     my ( $operators, $operands, $indexes, $limits, $sort_by, $scan) = @_;
 688
 689     my @operators = @$operators if $operators;
 690     my @indexes   = @$indexes   if $indexes;
 691     my @operands  = @$operands  if $operands;
 692     my @limits    = @$limits    if $limits;
 693     my @sort_by   = @$sort_by   if $sort_by;
 694
 695     my $stemming      = C4::Context->preference("QueryStemming")                || 0;
 696         my $auto_truncation = C4::Context->preference("QueryAutoTruncate")              || 0;
 697     my $weight_fields = C4::Context->preference("QueryWeightFields")            || 0;
 698     my $fuzzy_enabled = C4::Context->preference("QueryFuzzy")                           || 0;
 699         my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords")  || 0;
 700
 701     my $query = $operands[0];
 702         my $simple_query = $operands[0];
 703         my $query_cgi;
 704         my $query_desc;
 705         my $query_type;
 706
 707         my $limit;
 708         my $limit_cgi;
 709         my $limit_desc;
 710
 711         my $stopwords_removed;
 712
 713         # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
 714         # DIAGNOSTIC ONLY!!
 715     if ( $query =~ /^ccl=/ ) {
 716         return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
 717     }
 718     if ( $query =~ /^cql=/ ) {
 719         return ( undef, $', $', $', $', '', '', '', '', 'cql' );
 720     }
 721     if ( $query =~ /^pqf=/ ) {
 722         return ( undef, $', $', $', $', '', '', '', '', 'pqf' );
 723     }
 724
 725         # pass nested queries directly
 726     if ( $query =~ /(\(|\))/ ) {
 727         return ( undef, $query, $simple_query, $query_cgi, $query, $limit, $limit_cgi, $limit_desc, $stopwords_removed, 'ccl' );
 728     }
 729
 730 # form-based queries are limited to non-nested at a specific depth, so we can easily
 731 # modify the incoming query operands and indexes to do stemming and field weighting
 732 # Once we do so, we'll end up with a value in $query, just like if we had an
 733 # incoming $query from the user
 734     else {
 735         $query = ""; # clear it out so we can populate properly with field-weighted stemmed query
 736         my $previous_operand;    # a flag used to keep track if there was a previous query
 737                                 # if there was, we can apply the current operator
 738         # for every operand
 739         for ( my $i = 0 ; $i <= @operands ; $i++ ) {
 740
 741             # COMBINE OPERANDS, INDEXES AND OPERATORS
 742             if ( $operands[$i] ) {
 743
 744                                 # a flag to determine whether or not to add the index to the query
 745                                 my $indexes_set;
 746                                 # if the user is sophisticated enough to specify an index, turn off some defaults
 747                                 if ($operands[$i] =~ /(:|=)/ || $scan) {
 748                                         $weight_fields = 0;
 749                                         $stemming = 0;
 750                                         $remove_stopwords = 0;
 751                                 }
 752                 my $operand = $operands[$i];
 753                 my $index   = $indexes[$i];
 754
 755                                 # some helpful index modifs
 756                 my $index_plus = "$index:" if $index;
 757                 my $index_plus_comma="$index," if $index;
 758
 759                 # Remove Stopwords
 760                                 if ($remove_stopwords) {
 761                 ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
 762                         warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
 763                                         warn "REMOVED STOPWORDS: @$stopwords_removed" if ($stopwords_removed && $DEBUG);
 764                                 }
 765
 766                 # Detect Truncation
 767                 my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
 768                 my $truncated_operand;
 769                 ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
 770                 warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
 771
 772                 # Apply Truncation
 773                 if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
 774                                         # don't field weight or add the index to the query, we do it here
 775                     $indexes_set = 1;
 776                     undef $weight_fields;
 777                     my $previous_truncation_operand;
 778                     if (scalar(@$nontruncated)>0) {
 779                         $truncated_operand.= "$index_plus @$nontruncated ";
 780                         $previous_truncation_operand = 1;
 781                     }
 782                     if (scalar(@$righttruncated)>0){
 783                         $truncated_operand .= "and " if $previous_truncation_operand;
 784                         $truncated_operand .= "$index_plus_comma"."rtrn:@$righttruncated ";
 785                         $previous_truncation_operand = 1;
 786                     }
 787                     if (scalar(@$lefttruncated)>0){
 788                         $truncated_operand .= "and " if $previous_truncation_operand;
 789                         $truncated_operand .= "$index_plus_comma"."ltrn:@$lefttruncated ";
 790                         $previous_truncation_operand = 1;
 791                     }
 792                     if (scalar(@$rightlefttruncated)>0){
 793                         $truncated_operand .= "and " if $previous_truncation_operand;
 794                         $truncated_operand .= "$index_plus_comma"."rltrn:@$rightlefttruncated ";
 795                         $previous_truncation_operand = 1;
 796                     }
 797                 }
 798                 $operand = $truncated_operand if $truncated_operand;
 799                 warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
 800
 801                 # Handle Stemming
 802                 my $stemmed_operand;
 803                 $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
 804                 warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
 805
 806                 # Handle Field Weighting
 807                 my $weighted_operand;
 808                 $weighted_operand = _build_weighted_query($operand,$stemmed_operand,$index) if $weight_fields;
 809                 warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
 810                 $operand = $weighted_operand if $weight_fields;
 811                 $indexes_set = 1 if $weight_fields;
 812
 813                 # If there's a previous operand, we need to add an operator
 814                 if ($previous_operand) {
 815
 816                     # user-specified operator
 817                     if ( $operators[$i-1] ) {
 818                         $query .= " $operators[$i-1] ";
 819                         $query .= " $index_plus " unless $indexes_set;
 820                         $query .= " $operand";
 821                                                 $query_cgi .="&op=$operators[$i-1]";
 822                                                 $query_cgi .="&idx=$index" if $index;
 823                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
 824                                                 $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
 825                     }
 826
 827                     # the default operator is and
 828                     else {
 829                         $query .= " and ";
 830                         $query .= "$index_plus " unless $indexes_set;
 831                         $query .= "$operand";
 832                                                 $query_cgi .="&op=and&idx=$index" if $index;
 833                                                 $query_cgi .="&q=$operands[$i]" if $operands[$i];
 834                         $query_desc .= " and $index_plus $operands[$i]";
 835                     }
 836                 }
 837
 838                                 # there isn't a pervious operand, don't need an operator
 839                 else {
 840                                         # field-weighted queries already have indexes set
 841                                         $query .=" $index_plus " unless $indexes_set;
 842                                         $query .= $operand;
 843                                         $query_desc .= " $index_plus $operands[$i]";
 844                                         $query_cgi.="&idx=$index" if $index;
 845                                         $query_cgi.="&q=$operands[$i]" if $operands[$i];
 846
 847                     $previous_operand = 1;
 848                 }
 849             }    #/if $operands
 850         }    # /for
 851     }
 852     warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
 853
 854     # add limits
 855         my $group_OR_limits;
 856         my $availability_limit;
 857     foreach my $this_limit (@limits) {
 858         if ( $this_limit =~ /available/ ) {
 859                         # available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
 860                         $availability_limit .="( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and ((lost,st-numeric gt 0) or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )";
 861                         $limit_cgi .= "&limit=available";
 862                         $limit_desc .="";
 863         }
 864
 865                 # these are treated as OR
 866         elsif ( $this_limit =~ /mc/ ) {
 867             $group_OR_limits .= " or " if $group_OR_limits;
 868                         $limit_desc .=" or " if $group_OR_limits;
 869                         $group_OR_limits .= "$this_limit";
 870                         $limit_cgi .="&limit=$this_limit";
 871                         $limit_desc .= "$this_limit";
 872         }
 873
 874                 # regular old limits
 875                 else {
 876                         $limit .= " and " if $limit || $query;
 877                         $limit .= "$this_limit";
 878                         $limit_cgi .="&limit=$this_limit";
 879                         $limit_desc .=" and $this_limit";
 880                 }
 881     }
 882         if ($group_OR_limits) {
 883                 $limit.=" and " if ($query || $limit );
 884                 $limit.="($group_OR_limits)";
 885         }
 886         if ($availability_limit) {
 887                 $limit.=" not " if ($query || $limit );
 888                 $limit.="$availability_limit";
 889         }
 890         # normalize the strings
 891         $query =~ s/:/=/g;
 892         $limit =~ s/:/=/g;
 893         for ($query, $query_desc, $limit, $limit_desc) {
 894                 $_ =~ s/  / /g;    # remove extra spaces
 895         $_ =~ s/^ //g;     # remove any beginning spaces
 896                 $_ =~ s/ $//g;     # remove any ending spaces
 897         $_ =~ s/==/=/g;    # remove double == from query
 898
 899         }
 900         $query_cgi =~ s/^&//;
 901
 902         # append the limit to the query
 903         $query .= " ".$limit;
 904
 905     warn "QUERY:".$query if $DEBUG;
 906         warn "QUERY CGI:".$query_cgi if $DEBUG;
 907     warn "QUERY DESC:".$query_desc if $DEBUG;
 908     warn "LIMIT:".$limit if $DEBUG;
 909     warn "LIMIT CGI:".$limit_cgi if $DEBUG;
 910     warn "LIMIT DESC:".$limit_desc if $DEBUG;
 911
 912         return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
 913 }
 914
 915 # IMO this subroutine is pretty messy still -- it's responsible for
 916 # building the HTML output for the template
 917 sub searchResults {
 918     my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
 919
 920     my $dbh = C4::Context->dbh;
 921     my $toggle;
 922     my $even = 1;
 923     my @newresults;
 924     my $span_terms_hashref;
 925     for my $span_term ( split( / /, $searchdesc ) ) {
 926         $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
 927         $span_terms_hashref->{$span_term}++;
 928     }
 929
 930     #Build brancnames hash
 931     #find branchname
 932     #get branch information.....
 933     my %branches;
 934     my $bsth =
 935       $dbh->prepare("SELECT branchcode,branchname FROM branches")
 936       ;    # FIXME : use C4::Koha::GetBranches
 937     $bsth->execute();
 938     while ( my $bdata = $bsth->fetchrow_hashref ) {
 939         $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
 940     }
 941
 942     #Build itemtype hash
 943     #find itemtype & itemtype image
 944     my %itemtypes;
 945     $bsth =
 946       $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
 947     $bsth->execute();
 948     while ( my $bdata = $bsth->fetchrow_hashref ) {
 949         $itemtypes{ $bdata->{'itemtype'} }->{description} =
 950           $bdata->{'description'};
 951         $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
 952         $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
 953         $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = $bdata->{'notforloan'};
 954     }
 955
 956     #search item field code
 957     my $sth =
 958       $dbh->prepare(
 959 "select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
 960       );
 961     $sth->execute;
 962     my ($itemtag) = $sth->fetchrow;
 963
 964     ## find column names of items related to MARC
 965     my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
 966     $sth2->execute;
 967     my %subfieldstosearch;
 968     while ( ( my $column ) = $sth2->fetchrow ) {
 969         my ( $tagfield, $tagsubfield ) =
 970           &GetMarcFromKohaField( "items." . $column, "" );
 971         $subfieldstosearch{$column} = $tagsubfield;
 972     }
 973     my $times;
 974
 975     if ( $hits && $offset + $results_per_page <= $hits ) {
 976         $times = $offset + $results_per_page;
 977     }
 978     else {
 979         $times = $hits;
 980     }
 981
 982     for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
 983         my $marcrecord;
 984         $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
 985         my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
 986                 $oldbiblio->{result_number} = $i+1;
 987         # add image url if there is one
 988         if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
 989             $oldbiblio->{imageurl} =
 990               $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
 991             $oldbiblio->{description} =
 992               $itemtypes{ $oldbiblio->{itemtype} }->{description};
 993         }
 994         else {
 995             $oldbiblio->{imageurl} =
 996               getitemtypeimagesrc() . "/"
 997               . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
 998               if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
 999             $oldbiblio->{description} =
1000               $itemtypes{ $oldbiblio->{itemtype} }->{description};
1001         }
1002         #
1003         # build summary if there is one (the summary is defined in itemtypes table
1004         #
1005         if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
1006             my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
1007             my @fields = $marcrecord->fields();
1008             foreach my $field (@fields) {
1009                 my $tag = $field->tag();
1010                 my $tagvalue = $field->as_string();
1011                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
1012                 unless ($tag<10) {
1013                     my @subf = $field->subfields;
1014                     for my $i (0..$#subf) {
1015                         my $subfieldcode = $subf[$i][0];
1016                         my $subfieldvalue = $subf[$i][1];
1017                         my $tagsubf = $tag.$subfieldcode;
1018                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
1019                     }
1020                 }
1021             }
1022             $summary =~ s/\[(.*?)]//g;
1023             $summary =~ s/\n/<br>/g;
1024             $oldbiblio->{summary} = $summary;
1025         }
1026         # add spans to search term in results for search term highlighting
1027         # save a native author, for the <a href=search.lq=<!--tmpl_var name="author"-->> link
1028         $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
1029         foreach my $term ( keys %$span_terms_hashref ) {
1030             my $old_term = $term;
1031             if ( length($term) > 3 ) {
1032                 $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\])//g;
1033                 $term =~ s/\\//g;
1034                 $term =~ s/\*//g;
1035
1036                 #FIXME: is there a better way to do this?
1037                 $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1038                 $oldbiblio->{'subtitle'} =~
1039                   s/$term/<span class=\"term\">$&<\/span>/gi;
1040
1041                 $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1042                 $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1043                 $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1044                 $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1045                 $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1046                 $oldbiblio->{'size'}  =~ s/$term/<span class=\"term\">$&<\/span>/gi;
1047             }
1048         }
1049
1050         if ( $i % 2 ) {
1051             $toggle = "#ffffcc";
1052         }
1053         else {
1054             $toggle = "white";
1055         }
1056         $oldbiblio->{'toggle'} = $toggle;
1057         my @fields = $marcrecord->field($itemtag);
1058         my @items_loop;
1059         my $items;
1060         my $ordered_count     = 0;
1061         my $onloan_count      = 0;
1062         my $wthdrawn_count    = 0;
1063         my $itemlost_count    = 0;
1064         my $norequests        = 1;
1065
1066         #
1067         # check the loan status of the item :
1068         # it is not stored in the MARC record, for pref (zebra reindexing)
1069         # reason. Thus, we have to get the status from a specific SQL query
1070         #
1071         my $sth_issue = $dbh->prepare("
1072             SELECT date_due,returndate
1073             FROM issues
1074             WHERE itemnumber=? AND returndate IS NULL");
1075         my $items_count=scalar(@fields);
1076         foreach my $field (@fields) {
1077             my $item;
1078             foreach my $code ( keys %subfieldstosearch ) {
1079                 $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
1080             }
1081             $sth_issue->execute($item->{itemnumber});
1082             $item->{due_date} = format_date($sth_issue->fetchrow);
1083             $item->{onloan} = 1 if $item->{due_date};
1084             # at least one item can be reserved : suppose no
1085             $norequests = 1;
1086             if ( $item->{wthdrawn} ) {
1087                 $wthdrawn_count++;
1088                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1089                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{wthdrawn}=1;
1090             }
1091             elsif ( $item->{itemlost} ) {
1092                 $itemlost_count++;
1093                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1094                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemlost}=1;
1095             }
1096             unless ( $item->{notforloan}) {
1097                 # OK, this one can be issued, so at least one can be reserved
1098                 $norequests = 0;
1099             }
1100             if ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
1101             {
1102                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{unavailable}=1;
1103                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{onloancount} = 1;
1104                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{due_date} = $item->{due_date};
1105                 $onloan_count++;
1106             }
1107             if ( $item->{'homebranch'} ) {
1108                 $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{count}++;
1109             }
1110
1111             # Last resort
1112             elsif ( $item->{'holdingbranch'} ) {
1113                 $items->{ $item->{'holdingbranch'} }->{count}++;
1114             }
1115             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{itemcallnumber} =                $item->{itemcallnumber};
1116             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{location} =                $item->{location};
1117             $items->{ $item->{'homebranch'}.'--'.$item->{'itemcallnumber'} }->{branchcode} =               $item->{homebranch};
1118         }    # notforloan, item level and biblioitem level
1119
1120         # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items
1121         $norequests = 1 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
1122                 my $itemscount;
1123         for my $key ( sort keys %$items ) {
1124                         $itemscount++;
1125             my $this_item = {
1126                 branchname     => $branches{$items->{$key}->{branchcode}},
1127                 branchcode     => $items->{$key}->{branchcode},
1128                 count          => $items->{$key}->{count},
1129                 itemcallnumber => $items->{$key}->{itemcallnumber},
1130                 location => $items->{$key}->{location},
1131                 onloancount      => $items->{$key}->{onloancount},
1132                 due_date         => $items->{$key}->{due_date},
1133                 wthdrawn      => $items->{$key}->{wthdrawn},
1134                 lost         => $items->{$key}->{itemlost},
1135             };
1136                         # only show the number specified by the user
1137                         my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
1138             push @items_loop, $this_item unless $itemscount > $maxitems;;
1139         }
1140         $oldbiblio->{norequests}    = $norequests;
1141         $oldbiblio->{items_count}    = $items_count;
1142         $oldbiblio->{items_loop}    = \@items_loop;
1143         $oldbiblio->{onloancount}   = $onloan_count;
1144         $oldbiblio->{wthdrawncount} = $wthdrawn_count;
1145         $oldbiblio->{itemlostcount} = $itemlost_count;
1146         $oldbiblio->{orderedcount}  = $ordered_count;
1147         $oldbiblio->{isbn}          =~ s/-//g; # deleting - in isbn to enable amazon content
1148         push( @newresults, $oldbiblio );
1149     }
1150     return @newresults;
1151 }
1152
1153
1154
1155 #----------------------------------------------------------------------
1156 #
1157 # Non-Zebra GetRecords#
1158 #----------------------------------------------------------------------
1159
1160 =head2 NZgetRecords
1161
1162   NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
1163
1164 =cut
1165 sub NZgetRecords {
1166     my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
1167     my $result = NZanalyse($query);
1168     return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
1169 }
1170
1171 =head2 NZanalyse
1172
1173   NZanalyse : get a CQL string as parameter, and returns a list of biblionumber;title,biblionumber;title,...
1174   the list is built from an inverted index in the nozebra SQL table
1175   note that title is here only for convenience : the sorting will be very fast when requested on title
1176   if the sorting is requested on something else, we will have to reread all results, and that may be longer.
1177
1178 =cut
1179
1180 sub NZanalyse {
1181     my ($string,$server) = @_;
1182     # $server contains biblioserver or authorities, depending on what we search on.
1183     #warn "querying : $string on $server";
1184     $server='biblioserver' unless $server;
1185
1186     # if we have a ", replace the content to discard temporarily any and/or/not inside
1187     my $commacontent;
1188     if ($string =~/"/) {
1189         $string =~ s/"(.*?)"/__X__/;
1190         $commacontent = $1;
1191                 warn "commacontent : $commacontent" if $DEBUG;
1192     }
1193     # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
1194     # then, call again NZanalyse with $left and $right
1195     # (recursive until we find a leaf (=> something without and/or/not)
1196     # delete repeated operator... Would then go in infinite loop
1197     while ($string =~s/( and| or| not| AND| OR| NOT)\1/$1/g){
1198     }
1199     #process parenthesis before.
1200     if ($string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/){
1201       my $left = $1;
1202 #       warn "left :".$left;
1203       my $right = $4;
1204       my $operator = lc($3); # FIXME: and/or/not are operators, not operands
1205       my $leftresult = NZanalyse($left,$server);
1206       if ($operator) {
1207         my $rightresult = NZanalyse($right,$server);
1208         # OK, we have the results for right and left part of the query
1209         # depending of operand, intersect, union or exclude both lists
1210         # to get a result list
1211         if ($operator eq ' and ') {
1212             my @leftresult = split /;/, $leftresult;
1213 #             my @rightresult = split /;/,$leftresult;
1214             my $finalresult;
1215             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1216             # the result is stored twice, to have the same weight for AND than OR.
1217             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1218             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1219             foreach (@leftresult) {
1220                 if ($rightresult =~ "$_;") {
1221                     $finalresult .= "$_;$_;";
1222                 }
1223             }
1224             return $finalresult;
1225         } elsif ($operator eq ' or ') {
1226             # just merge the 2 strings
1227             return $leftresult.$rightresult;
1228         } elsif ($operator eq ' not ') {
1229             my @leftresult = split /;/, $leftresult;
1230 #             my @rightresult = split /;/,$leftresult;
1231             my $finalresult;
1232             foreach (@leftresult) {
1233                 unless ($rightresult =~ "$_;") {
1234                     $finalresult .= "$_;";
1235                 }
1236             }
1237             return $finalresult;
1238         } else {
1239             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1240             return $leftresult;
1241             exit;
1242         }
1243       }
1244     }
1245     warn "string :".$string if $DEBUG;
1246     $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/;
1247     my $left = $1;
1248     my $right = $3;
1249     my $operand = lc($2); # FIXME: and/or/not are operators, not operands
1250     # it's not a leaf, we have a and/or/not
1251     if ($operand) {
1252         # reintroduce comma content if needed
1253         $right =~ s/__X__/"$commacontent"/ if $commacontent;
1254         $left =~ s/__X__/"$commacontent"/ if $commacontent;
1255         warn "node : $left / $operand / $right\n" if $DEBUG;
1256         my $leftresult = NZanalyse($left,$server);
1257         my $rightresult = NZanalyse($right,$server);
1258         # OK, we have the results for right and left part of the query
1259         # depending of operand, intersect, union or exclude both lists
1260         # to get a result list
1261         if ($operand eq ' and ') {
1262             my @leftresult = split /;/, $leftresult;
1263 #             my @rightresult = split /;/,$leftresult;
1264             my $finalresult;
1265             # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
1266             # the result is stored twice, to have the same weight for AND than OR.
1267             # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
1268             # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
1269             foreach (@leftresult) {
1270                 if ($rightresult =~ "$_;") {
1271                     $finalresult .= "$_;$_;";
1272                 }
1273             }
1274             return $finalresult;
1275         } elsif ($operand eq ' or ') {
1276             # just merge the 2 strings
1277             return $leftresult.$rightresult;
1278         } elsif ($operand eq ' not ') {
1279             my @leftresult = split /;/, $leftresult;
1280 #             my @rightresult = split /;/,$leftresult;
1281             my $finalresult;
1282             foreach (@leftresult) {
1283                 unless ($rightresult =~ "$_;") {
1284                     $finalresult .= "$_;";
1285                 }
1286             }
1287             return $finalresult;
1288         } else {
1289             # this error is impossible, because of the regexp that isolate the operand, but just in case...
1290             die "error : operand unknown : $operand for $string";
1291         }
1292     # it's a leaf, do the real SQL query and return the result
1293     } else {
1294         $string =~  s/__X__/"$commacontent"/ if $commacontent;
1295         $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
1296         warn "leaf : $string\n" if $DEBUG;
1297         # parse the string in in operator/operand/value again
1298         $string =~ /(.*)(>=|<=)(.*)/;
1299         my $left = $1;
1300         my $operator = $2;
1301         my $right = $3;
1302         unless ($operator) {
1303             $string =~ /(.*)(>|<|=)(.*)/;
1304             $left = $1;
1305             $operator = $2;
1306             $right = $3;
1307         }
1308         my $results;
1309         # automatic replace for short operators
1310         $left='title' if $left =~ '^ti$';
1311         $left='author' if $left =~ '^au$';
1312         $left='publisher' if $left =~ '^pb$';
1313         $left='subject' if $left =~ '^su$';
1314         $left='koha-Auth-Number' if $left =~ '^an$';
1315         $left='keyword' if $left =~ '^kw$';
1316         if ($operator) {
1317             #do a specific search
1318             my $dbh = C4::Context->dbh;
1319             $operator='LIKE' if $operator eq '=' and $right=~ /%/;
1320             my $sth = $dbh->prepare("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
1321             warn "$left / $operator / $right\n";
1322             # split each word, query the DB and build the biblionumbers result
1323             #sanitizing leftpart
1324             $left=~s/^\s+|\s+$//;
1325             my ($biblionumbers,$value);
1326             foreach (split / /,$right) {
1327                 next unless $_;
1328                 warn "EXECUTE : $server, $left, $_";
1329                 $sth->execute($server, $left, $_) or warn "execute failed: $!";
1330                 while (my ($line,$value) = $sth->fetchrow) {
1331                     # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
1332                     # otherwise, fill the result
1333                     $biblionumbers .= $line unless ($right =~ /\d/ && $value =~ /\D/);
1334 #                     warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
1335                 }
1336                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1337                 if ($results) {
1338                     my @leftresult = split /;/, $biblionumbers;
1339                     my $temp;
1340                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1341                         # remove weight at the end
1342                         my $cleaned = $entry;
1343                         $cleaned =~ s/-\d*$//;
1344                         # if the entry already in the hash, take it & increase weight
1345                          warn "===== $cleaned =====" if $DEBUG;
1346                         if ($results =~ "$cleaned") {
1347                             $temp .= "$entry;$entry;";
1348                              warn "INCLUDING $entry" if $DEBUG;
1349                         }
1350                     }
1351                     $results = $temp;
1352                 } else {
1353                     $results = $biblionumbers;
1354                 }
1355             }
1356         } else {
1357             #do a complete search (all indexes)
1358             my $dbh = C4::Context->dbh;
1359             my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
1360             # split each word, query the DB and build the biblionumbers result
1361             foreach (split / /,$string) {
1362                 next if C4::Context->stopwords->{uc($_)}; # skip if stopword
1363                 warn "search on all indexes on $_" if $DEBUG;
1364                 my $biblionumbers;
1365                 next unless $_;
1366                 $sth->execute($server, $_);
1367                 while (my $line = $sth->fetchrow) {
1368                     $biblionumbers .= $line;
1369                 }
1370                 # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
1371                 if ($results) {
1372                  warn "RES for $_ = $biblionumbers" if $DEBUG;
1373                     my @leftresult = split /;/, $biblionumbers;
1374                     my $temp;
1375                     foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
1376                         # remove weight at the end
1377                         my $cleaned = $entry;
1378                         $cleaned =~ s/-\d*$//;
1379                         # if the entry already in the hash, take it & increase weight
1380                          warn "===== $cleaned =====" if $DEBUG;
1381                         if ($results =~ "$cleaned") {
1382                             $temp .= "$entry;$entry;";
1383                              warn "INCLUDING $entry" if $DEBUG;
1384                         }
1385                     }
1386                     $results = $temp;
1387                 } else {
1388                  warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
1389                     $results = $biblionumbers;
1390                 }
1391             }
1392         }
1393 #         warn "return : $results for LEAF : $string" if $DEBUG;
1394         return $results;
1395     }
1396 }
1397
1398 =head2 NZorder
1399
1400   $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset);
1401
1402   TODO :: Description
1403
1404 =cut
1405
1406
1407 sub NZorder {
1408     my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
1409     # order title asc by default
1410 #     $ordering = '1=36 <i' unless $ordering;
1411     $results_per_page=20 unless $results_per_page;
1412     $offset = 0 unless $offset;
1413     my $dbh = C4::Context->dbh;
1414     #
1415     # order by POPULARITY
1416     #
1417     if ($ordering =~ /popularity/) {
1418         my %result;
1419         my %popularity;
1420         # popularity is not in MARC record, it's builded from a specific query
1421         my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
1422         foreach (split /;/,$biblionumbers) {
1423             my ($biblionumber,$title) = split /,/,$_;
1424             $result{$biblionumber}=GetMarcBiblio($biblionumber);
1425             $sth->execute($biblionumber);
1426             my $popularity= $sth->fetchrow ||0;
1427             # hint : the key is popularity.title because we can have
1428             # many results with the same popularity. In this cas, sub-ordering is done by title
1429             # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity
1430             # (un-frequent, I agree, but we won't forget anything that way ;-)
1431             $popularity{sprintf("%10d",$popularity).$title.$biblionumber} = $biblionumber;
1432         }
1433         # sort the hash and return the same structure as GetRecords (Zebra querying)
1434         my $result_hash;
1435         my $numbers=0;
1436         if ($ordering eq 'popularity_dsc') { # sort popularity DESC
1437             foreach my $key (sort {$b cmp $a} (keys %popularity)) {
1438                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1439             }
1440         } else { # sort popularity ASC
1441             foreach my $key (sort (keys %popularity)) {
1442                 $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
1443             }
1444         }
1445         my $finalresult=();
1446         $result_hash->{'hits'} = $numbers;
1447         $finalresult->{'biblioserver'} = $result_hash;
1448         return $finalresult;
1449     #
1450     # ORDER BY author
1451     #
1452     } elsif ($ordering =~/author/){
1453         my %result;
1454         foreach (split /;/,$biblionumbers) {
1455             my ($biblionumber,$title) = split /,/,$_;
1456             my $record=GetMarcBiblio($biblionumber);
1457             my $author;
1458             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1459                 $author=$record->subfield('200','f');
1460                 $author=$record->subfield('700','a') unless $author;
1461             } else {
1462                 $author=$record->subfield('100','a');
1463             }
1464             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1465             # and we don't want to get only 1 result for each of them !!!
1466             $result{$author.$biblionumber}=$record;
1467         }
1468         # sort the hash and return the same structure as GetRecords (Zebra querying)
1469         my $result_hash;
1470         my $numbers=0;
1471         if ($ordering eq 'author_za') { # sort by author desc
1472             foreach my $key (sort { $b cmp $a } (keys %result)) {
1473                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1474             }
1475         } else { # sort by author ASC
1476             foreach my $key (sort (keys %result)) {
1477                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1478             }
1479         }
1480         my $finalresult=();
1481         $result_hash->{'hits'} = $numbers;
1482         $finalresult->{'biblioserver'} = $result_hash;
1483         return $finalresult;
1484     #
1485     # ORDER BY callnumber
1486     #
1487     } elsif ($ordering =~/callnumber/){
1488         my %result;
1489         foreach (split /;/,$biblionumbers) {
1490             my ($biblionumber,$title) = split /,/,$_;
1491             my $record=GetMarcBiblio($biblionumber);
1492             my $callnumber;
1493             my ($callnumber_tag,$callnumber_subfield)=GetMarcFromKohaField($dbh,'items.itemcallnumber');
1494             ($callnumber_tag,$callnumber_subfield)= GetMarcFromKohaField('biblioitems.callnumber') unless $callnumber_tag;
1495             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1496                 $callnumber=$record->subfield('200','f');
1497             } else {
1498                 $callnumber=$record->subfield('100','a');
1499             }
1500             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1501             # and we don't want to get only 1 result for each of them !!!
1502             $result{$callnumber.$biblionumber}=$record;
1503         }
1504         # sort the hash and return the same structure as GetRecords (Zebra querying)
1505         my $result_hash;
1506         my $numbers=0;
1507         if ($ordering eq 'call_number_dsc') { # sort by title desc
1508             foreach my $key (sort { $b cmp $a } (keys %result)) {
1509                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1510             }
1511         } else { # sort by title ASC
1512             foreach my $key (sort { $a cmp $b } (keys %result)) {
1513                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1514             }
1515         }
1516         my $finalresult=();
1517         $result_hash->{'hits'} = $numbers;
1518         $finalresult->{'biblioserver'} = $result_hash;
1519         return $finalresult;
1520     } elsif ($ordering =~ /pubdate/){ #pub year
1521         my %result;
1522         foreach (split /;/,$biblionumbers) {
1523             my ($biblionumber,$title) = split /,/,$_;
1524             my $record=GetMarcBiblio($biblionumber);
1525             my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
1526             my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
1527             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1528             # and we don't want to get only 1 result for each of them !!!
1529             $result{$publicationyear.$biblionumber}=$record;
1530         }
1531         # sort the hash and return the same structure as GetRecords (Zebra querying)
1532         my $result_hash;
1533         my $numbers=0;
1534         if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
1535             foreach my $key (sort { $b cmp $a } (keys %result)) {
1536                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1537             }
1538         } else { # sort by pub year ASC
1539             foreach my $key (sort (keys %result)) {
1540                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
1541             }
1542         }
1543         my $finalresult=();
1544         $result_hash->{'hits'} = $numbers;
1545         $finalresult->{'biblioserver'} = $result_hash;
1546         return $finalresult;
1547     #
1548     # ORDER BY title
1549     #
1550     } elsif ($ordering =~ /title/) {
1551         # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
1552         my %result;
1553         foreach (split /;/,$biblionumbers) {
1554             my ($biblionumber,$title) = split /,/,$_;
1555             # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
1556             # and we don't want to get only 1 result for each of them !!!
1557             # hint & speed improvement : we can order without reading the record
1558             # so order, and read records only for the requested page !
1559             $result{$title.$biblionumber}=$biblionumber;
1560         }
1561         # sort the hash and return the same structure as GetRecords (Zebra querying)
1562         my $result_hash;
1563         my $numbers=0;
1564         if ($ordering eq 'title_az') { # sort by title desc
1565             foreach my $key (sort (keys %result)) {
1566                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1567             }
1568         } else { # sort by title ASC
1569             foreach my $key (sort { $b cmp $a } (keys %result)) {
1570                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1571             }
1572         }
1573         # limit the $results_per_page to result size if it's more
1574         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1575         # for the requested page, replace biblionumber by the complete record
1576         # speed improvement : avoid reading too much things
1577         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1578             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
1579         }
1580         my $finalresult=();
1581         $result_hash->{'hits'} = $numbers;
1582         $finalresult->{'biblioserver'} = $result_hash;
1583         return $finalresult;
1584     } else {
1585     #
1586     # order by ranking
1587     #
1588         # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
1589         my %result;
1590         my %count_ranking;
1591         foreach (split /;/,$biblionumbers) {
1592             my ($biblionumber,$title) = split /,/,$_;
1593             $title =~ /(.*)-(\d)/;
1594             # get weight
1595             my $ranking =$2;
1596             # note that we + the ranking because ranking is calculated on weight of EACH term requested.
1597             # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
1598             # biblio N has ranking = 6
1599             $count_ranking{$biblionumber} += $ranking;
1600         }
1601         # build the result by "inverting" the count_ranking hash
1602         # 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
1603 #         warn "counting";
1604         foreach (keys %count_ranking) {
1605             $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
1606         }
1607         # sort the hash and return the same structure as GetRecords (Zebra querying)
1608         my $result_hash;
1609         my $numbers=0;
1610             foreach my $key (sort {$b cmp $a} (keys %result)) {
1611                 $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
1612             }
1613         # limit the $results_per_page to result size if it's more
1614         $results_per_page = $numbers-1 if $numbers < $results_per_page;
1615         # for the requested page, replace biblionumber by the complete record
1616         # speed improvement : avoid reading too much things
1617         for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
1618             $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
1619         }
1620         my $finalresult=();
1621         $result_hash->{'hits'} = $numbers;
1622         $finalresult->{'biblioserver'} = $result_hash;
1623         return $finalresult;
1624     }
1625 }
1626 =head2 ModBiblios
1627
1628 ($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
1629
1630 this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios
1631 test parameter if set donot perform change to records in database.
1632
1633 =over 2
1634
1635 =item C<input arg:>
1636
1637     * $listbiblios is an array ref to marcrecords to be changed
1638     * $tagsubfield is the reference of the subfield to change.
1639     * $initvalue is the value to search the record for
1640     * $targetvalue is the value to set the subfield to
1641     * $test is to be set only not to perform changes in database.
1642
1643 =item C<Output arg:>
1644     * $countchanged counts all the changes performed.
1645     * $listunchanged contains the list of all the biblionumbers of records unchanged.
1646
1647 =item C<usage in the script:>
1648
1649 =back
1650
1651 my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);;
1652 #If one wants to display unchanged records, you should get biblios foreach @$listunchanged
1653 $template->param(countchanged => $countchanged, loopunchanged=>$listunchanged);
1654
1655 =cut
1656
1657 sub ModBiblios{
1658   my ($listbiblios,$tagsubfield,$initvalue,$targetvalue,$test)=@_;
1659   my $countmatched;
1660   my @unmatched;
1661   my ($tag,$subfield)=($1,$2) if ($tagsubfield=~/^(\d{1,3})([a-z0-9A-Z@])?$/);
1662   if ((length($tag)<3)&& $subfield=~/0-9/){
1663     $tag=$tag.$subfield;
1664     undef $subfield;
1665   }
1666   my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
1667   my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
1668   foreach my $usmarc (@$listbiblios){
1669     my $record;
1670     $record=eval{MARC::Record->new_from_usmarc($usmarc)};
1671     my $biblionumber;
1672     if ($@){
1673       # usmarc is not a valid usmarc May be a biblionumber
1674       if ($tag eq $itemtag){
1675         my $bib=GetBiblioFromItemNumber($usmarc);
1676         $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
1677         $biblionumber=$bib->{'biblionumber'};
1678       } else {
1679         $record=GetMarcBiblio($usmarc);
1680         $biblionumber=$usmarc;
1681       }
1682     }  else {
1683       if ($bntag >= 010){
1684         $biblionumber = $record->subfield($bntag,$bnsubf);
1685       }else {
1686         $biblionumber=$record->field($bntag)->data;
1687       }
1688     }
1689     #GetBiblionumber is to be written.
1690     #Could be replaced by TransformMarcToKoha (But Would be longer)
1691     if ($record->field($tag)){
1692       my $modify=0;
1693       foreach my $field ($record->field($tag)){
1694         if ($subfield){
1695           if ($field->delete_subfield('code' =>$subfield,'match'=>qr($initvalue))){
1696             $countmatched++;
1697             $modify=1;
1698             $field->update($subfield,$targetvalue) if ($targetvalue);
1699           }
1700         } else {
1701           if ($tag >= 010){
1702             if ($field->delete_field($field)){
1703               $countmatched++;
1704               $modify=1;
1705             }
1706           } else {
1707             $field->data=$targetvalue if ($field->data=~qr($initvalue));
1708           }
1709         }
1710       }
1711 #       warn $record->as_formatted;
1712       if ($modify){
1713         ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
1714       } else {
1715         push @unmatched, $biblionumber;
1716       }
1717     } else {
1718       push @unmatched, $biblionumber;
1719     }
1720   }
1721   return ($countmatched,\@unmatched);
1722 }
1723
1724 END { }    # module clean-up code here (global destructor)
1725
1726 1;
1727 __END__
1728
1729 =head1 AUTHOR
1730
1731 Koha Developement team <info@koha.org>
1732
1733 =cut