Bug 32426: (follow-up) Fix api/v1/patrons.t
[srvgit] / C4 / Breeding.pm
index db8a3a4..7b3dbc5 100644 (file)
@@ -21,22 +21,22 @@ package C4::Breeding;
 use strict;
 use warnings;
 
-use C4::Biblio;
-use C4::Koha;
-use C4::Charset;
+use C4::Biblio qw(TransformMarcToKoha);
+use C4::Koha qw( GetVariationsOfISBN );
+use C4::Charset qw( MarcToUTF8Record SetUTF8Flag );
 use MARC::File::USMARC;
-use C4::ImportBatch;
-use C4::AuthoritiesMarc; #GuessAuthTypeCode, FindDuplicateAuthority
+use MARC::Field;
+use C4::ImportBatch qw( GetZ3950BatchId AddBiblioToBatch AddAuthToBatch );
+use C4::AuthoritiesMarc qw( GuessAuthTypeCode );
 use C4::Languages;
 use Koha::Database;
-use Koha::XSLT_Handler;
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use Koha::XSLT::Base;
 
+our (@ISA, @EXPORT_OK);
 BEGIN {
-       require Exporter;
-       @ISA = qw(Exporter);
-    @EXPORT = qw(&BreedingSearch &Z3950Search &Z3950SearchAuth);
+    require Exporter;
+    @ISA       = qw(Exporter);
+    @EXPORT_OK = qw(BreedingSearch Z3950Search Z3950SearchAuth);
 }
 
 =head1 NAME
@@ -47,7 +47,7 @@ C4::Breeding : module to add biblios to import_records via
 =head1 SYNOPSIS
 
     Z3950Search($pars, $template);
-    ($count, @results) = &BreedingSearch($title,$isbn,$random);
+    ($count, @results) = &BreedingSearch($title,$isbn);
 
 =head1 DESCRIPTION
 
@@ -56,10 +56,8 @@ cataloguing reservoir features.
 
 =head2 BreedingSearch
 
-($count, @results) = &BreedingSearch($title,$isbn,$random);
-C<$title> contains the title,
-C<$isbn> contains isbn or issn,
-C<$random> contains the random seed from a z3950 search.
+($count, @results) = &BreedingSearch($term);
+C<$term> contains the term to search, it will be searched as title,author, or isbn
 
 C<$count> is the number of items in C<@results>. C<@results> is an
 array of references-to-hash; the keys are the items from the C<import_records> and
@@ -68,40 +66,31 @@ C<import_biblios> tables of the Koha database.
 =cut
 
 sub BreedingSearch {
-    my ($search,$isbn,$z3950random) = @_;
+    my ($term) = @_;
     my $dbh   = C4::Context->dbh;
     my $count = 0;
     my ($query,@bind);
     my $sth;
     my @results;
 
+    my $authortitle = $term;
+    $authortitle =~ s/(\s+)/\%/g; #Replace spaces with wildcard
+    $authortitle = "%" . $authortitle . "%"; #Add wildcard to start and end of string
     # normalise ISBN like at import
-    $isbn = C4::Koha::GetNormalizedISBN($isbn);
-
-    $query = "SELECT import_record_id, file_name, isbn, title, author
-              FROM  import_biblios 
+    my @isbns = C4::Koha::GetVariationsOfISBN($term);
+
+    $query = "SELECT import_biblios.import_record_id,
+                import_batches.file_name,
+                import_biblios.isbn,
+                import_biblios.title,
+                import_biblios.author,
+                import_batches.upload_timestamp
+              FROM  import_biblios
               JOIN import_records USING (import_record_id)
               JOIN import_batches USING (import_batch_id)
-              WHERE ";
-    if ($z3950random) {
-        $query .= "z3950random = ?";
-        @bind=($z3950random);
-    } else {
-        @bind=();
-        if (defined($search) && length($search)>0) {
-            $search =~ s/(\s+)/\%/g;
-            $query .= "title like ? OR author like ?";
-            push(@bind,"%$search%", "%$search%");
-        }
-        if ($#bind!=-1 && defined($isbn) && length($isbn)>0) {
-            $query .= " and ";
-        }
-        if (defined($isbn) && length($isbn)>0) {
-            $query .= "isbn like ?";
-            push(@bind,"$isbn%");
-        }
-    }
-    $sth   = $dbh->prepare($query);
+              WHERE title LIKE ? OR author LIKE ? OR isbn IN (" . join(',',('?') x @isbns) . ")";
+    @bind=( $authortitle, $authortitle, @isbns );
+    $sth = $dbh->prepare($query);
     $sth->execute(@bind);
     while (my $data = $sth->fetchrow_hashref) {
             $results[$count] = $data;
@@ -147,7 +136,7 @@ sub Z3950Search {
     my $s = 0;
     my $imported=0;
 
-    my ( $zquery, $squery ) = _build_query( $pars );
+    my ( $zquery, $squery ) = _bib_build_query( $pars );
 
     my $schema = Koha::Database->new()->schema();
     my $rs = $schema->resultset('Z3950server')->search(
@@ -156,15 +145,19 @@ sub Z3950Search {
     );
     my @servers = $rs->all;
     foreach my $server ( @servers ) {
+        my $server_zquery = $zquery;
+        if(my $attributes = $server->{attributes}){
+            $server_zquery = "$attributes $zquery";
+        }
         $oConnection[$s] = _create_connection( $server );
         $oResult[$s] =
             $server->{servertype} eq 'zed'?
-                $oConnection[$s]->search_pqf( $zquery ):
-                $oConnection[$s]->search(new ZOOM::Query::CQL(
+                $oConnection[$s]->search_pqf( $server_zquery ):
+                $oConnection[$s]->search(ZOOM::Query::CQL->new(
                     _translate_query( $server, $squery )));
         $s++;
     }
-    my $xslh = Koha::XSLT_Handler->new;
+    my $xslh = Koha::XSLT::Base->new;
 
     my $nremaining = $s;
     while ( $nremaining-- ) {
@@ -244,26 +237,11 @@ sub _auth_build_query {
         controlnumber     => '@attr 1=12 "#term" ',
     };
 
-    my $zquery='';
-    my $squery='';
-    my $nterms=0;
-    foreach my $k ( sort keys %$pars ) {
-    #note that the sort keys forces an identical result under Perl 5.18
-    #one of the unit tests is based on that assumption
-        if( ( my $val=$pars->{$k} ) && $qry_build->{$k} ) {
-            $qry_build->{$k} =~ s/#term/$val/g;
-            $zquery .= $qry_build->{$k};
-            $squery .= "[$k]=\"$val\" and ";
-            $nterms++;
-        }
-    }
-    $zquery = "\@and " . $zquery for 2..$nterms;
-    $squery =~ s/ and $//;
-    return ( $zquery, $squery );
-
+    return _build_query( $pars, $qry_build );
 }
 
-sub _build_query {
+sub _bib_build_query {
+
     my ( $pars ) = @_;
 
     my $qry_build = {
@@ -278,8 +256,16 @@ sub _build_query {
         controlnumber => '@attr 1=12 "#term" ',
         srchany => '@attr 1=1016 "#term" ',
         stdid   => '@attr 1=1007 "#term" ',
+        publicationyear => '@attr 1=31 "#term" '
     };
 
+    return _build_query( $pars, $qry_build );
+}
+
+sub _build_query {
+
+    my ( $pars, $qry_build ) = @_;
+
     my $zquery='';
     my $squery='';
     my $nterms=0;
@@ -306,6 +292,7 @@ sub _handle_one_result {
     if( $servhref->{servertype} eq 'sru' ) {
         $marcrecord= MARC::Record->new_from_xml( $raw, 'UTF-8',
             $servhref->{syntax} );
+        $marcrecord->encoding('UTF-8');
     } else {
         ($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encoding} // "iso-5426" ); #ignores charset return values
     }
@@ -314,21 +301,20 @@ sub _handle_one_result {
     ( $marcrecord, $error ) = _do_xslt_proc($marcrecord, $servhref, $xslh);
 
     my $batch_id = GetZ3950BatchId($servhref->{servername});
-    my $breedingid = AddBiblioToBatch($batch_id, $seq, $marcrecord, 'UTF-8', 0, 0);
-        #FIXME passing 0 for z3950random
-        #Will eliminate this unused field in a followup report
+    my $breedingid = AddBiblioToBatch($batch_id, $seq, $marcrecord, 'UTF-8', 0);
         #Last zero indicates: no update for batch record counts
 
-
-    #call to TransformMarcToKoha replaced by next call
-    #we only need six fields from the marc record
     my $row;
-    $row = _add_rowdata(
-        {
-            biblionumber => $bib,
-            server       => $servhref->{servername},
-            breedingid   => $breedingid,
-        }, $marcrecord) if $breedingid;
+    if( $breedingid ){
+        my @kohafields = ('biblio.title','biblio.author','biblioitems.isbn','biblioitems.lccn','biblioitems.editionstatement');
+        push @kohafields, C4::Context->preference('marcflavour') eq "MARC21" ? 'biblio.copyrightdate' : 'biblioitems.publicationyear';
+        $row = C4::Biblio::TransformMarcToKoha({ record => $marcrecord, kohafields => \@kohafields, limit_table => 'no_items' });
+        $row->{biblionumber} = $bib;
+        $row->{server}       = $servhref->{servername};
+        $row->{breedingid}   = $breedingid;
+        $row->{isbn}=_isbn_replace($row->{isbn});
+        $row = _add_custom_field_rowdata($row, $marcrecord);
+    }
     return ( $row, $error );
 }
 
@@ -356,22 +342,53 @@ sub _do_xslt_proc {
     }
 }
 
-sub _add_rowdata {
-    my ($row, $record)=@_;
-    my %fetch= (
-        title => 'biblio.title',
-        author => 'biblio.author',
-        isbn =>'biblioitems.isbn',
-        lccn =>'biblioitems.lccn', #LC control number (not call number)
-        edition =>'biblioitems.editionstatement',
-        date => 'biblio.copyrightdate', #MARC21
-        date2 => 'biblioitems.publicationyear', #UNIMARC
-    );
-    foreach my $k (keys %fetch) {
-        $row->{$k} = C4::Biblio::TransformMarcToKohaOneField( $fetch{$k}, $record );
+sub _add_custom_field_rowdata
+{
+    my ( $row, $record ) = @_;
+    my $pref_newtags = C4::Context->preference('AdditionalFieldsInZ3950ResultSearch');
+    my $pref_flavour = C4::Context->preference('MarcFlavour');
+
+    $pref_newtags =~ s/^\s+|\s+$//g;
+    $pref_newtags =~ s/\h+/ /g;
+
+    my @addnumberfields;
+
+    foreach my $field (split /\,/, $pref_newtags) {
+        $field =~ s/^\s+|\s+$//g ;  # trim whitespace
+        my ($tag, $subtags) = split(/\$/, $field);
+
+        if ( $record->field($tag) ) {
+            my @content = ();
+
+            for my $marcfield ($record->field($tag)) {
+                if ( $subtags ) {
+                    my $str = '';
+                    for my $code (split //, $subtags) {
+                        if ( $marcfield->subfield($code) ) {
+                            $str .= $marcfield->subfield($code) . ' ';
+                        }
+                    }
+                    if ( not $str eq '') {
+                        push @content, $str;
+                    }
+                } elsif ( $tag == 10 ) {
+                    push @content, ( $pref_flavour eq "MARC21" ? $marcfield->data : $marcfield->as_string );
+                } elsif ( $tag < 10 ) {
+                    push @content, $marcfield->data();
+                } else {
+                    push @content, $marcfield->as_string();
+                }
+            }
+
+            if ( @content ) {
+                $row->{$field} = \@content;
+                push( @addnumberfields, $field );
+            }
+        }
     }
-    $row->{date}//= $row->{date2};
-    $row->{isbn}=_isbn_replace($row->{isbn});
+
+    $row->{'addnumberfields'} = \@addnumberfields;
+
     return $row;
 }
 
@@ -386,7 +403,7 @@ sub _isbn_replace {
 
 sub _create_connection {
     my ( $server ) = @_;
-    my $option1= new ZOOM::Options();
+    my $option1= ZOOM::Options->new();
     $option1->option( 'async' => 1 );
     $option1->option( 'elementSetName', 'F' );
     $option1->option( 'preferredRecordSyntax', $server->{syntax} );
@@ -445,73 +462,30 @@ sub _translate_query { #SRU query adjusted per server cf. srufields column
 
 =head2 ImportBreedingAuth
 
-ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random);
+ImportBreedingAuth( $marcrecord, $filename, $encoding, $heading );
 
-    ImportBreedingAuth imports MARC records in the reservoir (import_records table).
-    ImportBreedingAuth is based on the ImportBreeding subroutine.
+    ImportBreedingAuth imports MARC records in the reservoir (import_records table) or returns their id if they already exist.
 
 =cut
 
 sub ImportBreedingAuth {
-    my ($marcrecord,$overwrite_auth,$filename,$encoding,$z3950random) = @_;
+    my ( $marcrecord, $filename, $encoding, $heading ) = @_;
     my $dbh = C4::Context->dbh;
 
     my $batch_id = GetZ3950BatchId($filename);
     my $searchbreeding = $dbh->prepare("select import_record_id from import_auths where control_number=? and authorized_heading=?");
 
-    my $marcflavour = C4::Context->preference('marcflavour');
-    my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour;
+    my $controlnumber = $marcrecord->field('001')->data;
 
-    # fields used for import results
-    my $imported=0;
-    my $alreadyindb = 0;
-    my $alreadyinfarm = 0;
-    my $notmarcrecord = 0;
-    my $breedingid;
-
-        # Normalize the record so it doesn't have separated diacritics
-        SetUTF8Flag($marcrecord);
-
-        if (scalar($marcrecord->fields()) == 0) {
-            $notmarcrecord++;
-        } else {
-            my $heading;
-            $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });
-
-            my $heading_authtype_code;
-            $heading_authtype_code = GuessAuthTypeCode($marcrecord);
+    # Normalize the record so it doesn't have separated diacritics
+    SetUTF8Flag($marcrecord);
 
-            my $controlnumber;
-            $controlnumber = $marcrecord->field('001')->data;
+    $searchbreeding->execute($controlnumber,$heading);
+    my ($breedingid) = $searchbreeding->fetchrow;
 
-            #Check if the authority record already exists in the database...
-            my ($duplicateauthid,$duplicateauthvalue);
-            if ($marcrecord && $heading_authtype_code) {
-                ($duplicateauthid,$duplicateauthvalue) = FindDuplicateAuthority( $marcrecord, $heading_authtype_code);
-            }
-
-            if ($duplicateauthid && $overwrite_auth ne 2) {
-                #If the authority record exists and $overwrite_auth doesn't equal 2, then mark it as already in the DB
-                $alreadyindb++;
-            } else {
-                if ($controlnumber && $heading) {
-                    $searchbreeding->execute($controlnumber,$heading);
-                    ($breedingid) = $searchbreeding->fetchrow;
-                }
-                if ($breedingid && $overwrite_auth eq '0') {
-                    $alreadyinfarm++;
-                } else {
-                    if ($breedingid && $overwrite_auth eq '1') {
-                        ModAuthorityInBatch($breedingid, $marcrecord);
-                    } else {
-                        my $import_id = AddAuthToBatch($batch_id, $imported, $marcrecord, $encoding, $z3950random);
-                        $breedingid = $import_id;
-                    }
-                    $imported++;
-                }
-            }
-        }
-    return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid);
+    return $breedingid if $breedingid;
+    $breedingid = AddAuthToBatch($batch_id, 0, $marcrecord, $encoding);
+    return $breedingid;
 }
 
 =head2 Z3950SearchAuth
@@ -531,25 +505,15 @@ sub Z3950SearchAuth {
 
     my $dbh   = C4::Context->dbh;
     my @id= @{$pars->{id}};
-    my $random= $pars->{random};
     my $page= $pars->{page};
 
 
     my $show_next       = 0;
     my $total_pages     = 0;
-    my $attr = '';
-    my $host;
-    my $server;
-    my $database;
-    my $port;
-    my $marcdata;
     my @encoding;
     my @results;
-    my $count;
-    my $record;
     my @serverhost;
     my @breeding_loop = ();
-
     my @oConnection;
     my @oResult;
     my @errconn;
@@ -565,14 +529,21 @@ sub Z3950SearchAuth {
     foreach my $servid (@id) {
         my $sth = $dbh->prepare("select * from z3950servers where id=?");
         $sth->execute($servid);
-        while ( $server = $sth->fetchrow_hashref ) {
+        while ( my $server = $sth->fetchrow_hashref ) {
             $oConnection[$s] = _create_connection( $server );
 
-            $oResult[$s] =
-            $server->{servertype} eq 'zed'?
-                $oConnection[$s]->search_pqf( $zquery ):
-                $oConnection[$s]->search(new ZOOM::Query::CQL(
-                    _translate_query( $server, $squery )));
+            if ( $server->{servertype} eq 'zed' ) {
+                my $server_zquery = $zquery;
+                if ( my $attributes = $server->{attributes} ) {
+                    $server_zquery = "$attributes $zquery";
+                }
+                $oResult[$s] = $oConnection[$s]->search_pqf( $server_zquery );
+            }
+            else {
+                $oResult[$s] = $oConnection[$s]->search(
+                    ZOOM::Query::CQL->new(_translate_query( $server, $squery ))
+                );
+            }
             $encoding[$s]   = ($server->{encoding}?$server->{encoding}:"iso-5426");
             $servers[$s] = $server;
             $s++;
@@ -590,7 +561,7 @@ sub Z3950SearchAuth {
 
         if ( $k != 0 ) {
             $k--;
-            my ($error, $errmsg, $addinfo, $diagset)= $oConnection[$k]->error_x();
+            my ($error )= $oConnection[$k]->error_x(); #ignores errmsg, addinfo, diagset
             if ($error) {
                 if ($error =~ m/^(10000|10007)$/ ) {
                     push(@errconn, {'server' => $serverhost[$k]});
@@ -613,15 +584,18 @@ sub Z3950SearchAuth {
                             my ($charset_result, $charset_errors);
                             if( $servers[$k]->{servertype} eq 'sru' ) {
                                 $marcrecord = MARC::Record->new_from_xml( $marcdata, 'UTF-8', $servers[$k]->{syntax} );
+                                $marcrecord->encoding('UTF-8');
                             } else {
                                 ( $marcrecord, $charset_result, $charset_errors ) = MarcToUTF8Record( $marcdata, $marc_type, $encoding[$k] );
                             }
                             my $heading;
                             my $heading_authtype_code;
                             $heading_authtype_code = GuessAuthTypeCode($marcrecord);
+                            next if ( not defined $heading_authtype_code ) ;
+
                             $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });
 
-                            my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcrecord, 2, $serverhost[$k], $encoding[$k], $random);
+                            my $breedingid = ImportBreedingAuth( $marcrecord, $serverhost[$k], $encoding[$k], $heading );
                             my %row_data;
                             $row_data{server}       = $servers[$k]->{'servername'};
                             $row_data{breedingid}   = $breedingid;