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