Bug 22330: Transfer limits should be respected for placing holds in staff interface...
[koha.git] / C4 / Breeding.pm
index cf32bf4..9afd2f1 100644 (file)
@@ -5,18 +5,18 @@ package C4::Breeding;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use strict;
 use warnings;
@@ -25,17 +25,16 @@ use C4::Biblio;
 use C4::Koha;
 use C4::Charset;
 use MARC::File::USMARC;
+use MARC::Field;
 use C4::ImportBatch;
 use C4::AuthoritiesMarc; #GuessAuthTypeCode, FindDuplicateAuthority
 use C4::Languages;
 use Koha::Database;
 use Koha::XSLT_Handler;
 
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 BEGIN {
-       # set the version for version checking
-    $VERSION = 3.07.00.049;
        require Exporter;
        @ISA = qw(Exporter);
     @EXPORT = qw(&BreedingSearch &Z3950Search &Z3950SearchAuth);
@@ -149,7 +148,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(
@@ -229,7 +228,28 @@ sub Z3950Search {
     );
 }
 
-sub _build_query {
+sub _auth_build_query {
+    my ( $pars ) = @_;
+
+    my $qry_build = {
+        nameany           => '@attr 1=1002 "#term" ',
+        authorany         => '@attr 1=1003 "#term" ',
+        authorcorp        => '@attr 1=2 "#term" ',
+        authorpersonal    => '@attr 1=1 "#term" ',
+        authormeetingcon  => '@attr 1=3 "#term" ',
+        subject           => '@attr 1=21 "#term" ',
+        subjectsubdiv     => '@attr 1=47 "#term" ',
+        title             => '@attr 1=4 "#term" ',
+        uniformtitle      => '@attr 1=6 "#term" ',
+        srchany           => '@attr 1=1016 "#term" ',
+        controlnumber     => '@attr 1=12 "#term" ',
+    };
+
+    return _build_query( $pars, $qry_build );
+}
+
+sub _bib_build_query {
+
     my ( $pars ) = @_;
 
     my $qry_build = {
@@ -246,6 +266,13 @@ sub _build_query {
         stdid   => '@attr 1=1007 "#term" ',
     };
 
+    return _build_query( $pars, $qry_build );
+}
+
+sub _build_query {
+
+    my ( $pars, $qry_build ) = @_;
+
     my $zquery='';
     my $squery='';
     my $nterms=0;
@@ -318,7 +345,7 @@ sub _do_xslt_proc {
     if( !$xslh->err ) {
         return MARC::Record->new_from_xml($xml, 'UTF-8');
     } else {
-        return ( $marc, 'xslt_err' ); #original record in case of errors
+        return ( $marc, $xslh->err ); #original record in case of errors
     }
 }
 
@@ -329,17 +356,68 @@ sub _add_rowdata {
         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
+        edition =>'biblioitems.editionstatement'
     );
+    $fetch{date} = C4::Context->preference('marcflavour') eq "MARC21" ? 'biblio.copyrightdate' : 'biblioitems.publicationyear';
+
     foreach my $k (keys %fetch) {
-        my ($t, $f)= split '\.', $fetch{$k};
-        $row= C4::Biblio::TransformMarcToKohaOneField($t, $f, $record, $row);
-        $row->{$k}= $row->{$f} if $k ne $f;
+        $row->{$k} = C4::Biblio::TransformMarcToKohaOneField( $fetch{$k}, $record );
     }
     $row->{date}//= $row->{date2};
     $row->{isbn}=_isbn_replace($row->{isbn});
+
+    $row = _add_custom_field_rowdata($row, $record);
+
+    return $row;
+}
+
+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->{'addnumberfields'} = \@addnumberfields;
+
     return $row;
 }
 
@@ -373,7 +451,6 @@ sub _create_connection {
         $option1->option( 'user', $server->{userid} ) if $server->{userid};
         $option1->option( 'password', $server->{password} ) if $server->{password};
     }
-
     my $obj= ZOOM::Connection->create($option1);
     if( $server->{servertype} eq 'sru' ) {
         my $host= $server->{host};
@@ -414,7 +491,7 @@ sub _translate_query { #SRU query adjusted per server cf. srufields column
 
 =head2 ImportBreedingAuth
 
-ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type);
+ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random);
 
     ImportBreedingAuth imports MARC records in the reservoir (import_records table).
     ImportBreedingAuth is based on the ImportBreeding subroutine.
@@ -422,25 +499,21 @@ ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random
 =cut
 
 sub ImportBreedingAuth {
-    my ($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type) = @_;
-    my @marcarray = split /\x1D/, $marcrecords;
-
+    my ($marcrecord,$overwrite_auth,$filename,$encoding,$z3950random) = @_;
     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=?");
 
-#     $encoding = C4::Context->preference("marcflavour") unless $encoding;
+    my $marcflavour = C4::Context->preference('marcflavour');
+    my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour;
+
     # fields used for import results
     my $imported=0;
     my $alreadyindb = 0;
     my $alreadyinfarm = 0;
     my $notmarcrecord = 0;
     my $breedingid;
-    for (my $i=0;$i<=$#marcarray;$i++) {
-        my ($marcrecord, $charset_result, $charset_errors);
-        ($marcrecord, $charset_result, $charset_errors) =
-            MarcToUTF8Record($marcarray[$i]."\x1D", C4::Context->preference("marcflavour"), $encoding);
 
         # Normalize the record so it doesn't have separated diacritics
         SetUTF8Flag($marcrecord);
@@ -484,7 +557,6 @@ sub ImportBreedingAuth {
                 }
             }
         }
-    }
     return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid);
 }
 
@@ -508,16 +580,6 @@ sub Z3950SearchAuth {
     my $random= $pars->{random};
     my $page= $pars->{page};
 
-    my $nameany= $pars->{nameany};
-    my $authorany= $pars->{authorany};
-    my $authorpersonal= $pars->{authorpersonal};
-    my $authorcorp= $pars->{authorcorp};
-    my $authormeetingcon= $pars->{authormeetingcon};
-    my $title= $pars->{title};
-    my $uniformtitle= $pars->{uniformtitle};
-    my $subject= $pars->{subject};
-    my $subjectsubdiv= $pars->{subjectsubdiv};
-    my $srchany= $pars->{srchany};
 
     my $show_next       = 0;
     my $total_pages     = 0;
@@ -532,98 +594,38 @@ sub Z3950SearchAuth {
     my $count;
     my $record;
     my @serverhost;
-    my @servername;
     my @breeding_loop = ();
 
     my @oConnection;
     my @oResult;
     my @errconn;
+    my @servers;
     my $s = 0;
     my $query;
     my $nterms=0;
 
-    if ($nameany) {
-        $query .= " \@attr 1=1002 \"$nameany\" "; #Any name (this includes personal, corporate, meeting/conference authors, and author names in subject headings)
-        #This attribute is supported by both the Library of Congress and Libraries Australia 08/05/2013
-        $nterms++;
-    }
-
-    if ($authorany) {
-        $query .= " \@attr 1=1003 \"$authorany\" "; #Author-name (this includes personal, corporate, meeting/conference authors, but not author names in subject headings)
-        #This attribute is not supported by the Library of Congress, but is supported by Libraries Australia 08/05/2013
-        $nterms++;
-    }
-
-    if ($authorcorp) {
-        $query .= " \@attr 1=2 \"$authorcorp\" "; #1005 is another valid corporate author attribute...
-        $nterms++;
-    }
-
-    if ($authorpersonal) {
-        $query .= " \@attr 1=1 \"$authorpersonal\" "; #1004 is another valid personal name attribute...
-        $nterms++;
-    }
-
-    if ($authormeetingcon) {
-        $query .= " \@attr 1=3 \"$authormeetingcon\" "; #1006 is another valid meeting/conference name attribute...
-        $nterms++;
-    }
-
-    if ($subject) {
-        $query .= " \@attr 1=21 \"$subject\" ";
-        $nterms++;
-    }
-
-    if ($subjectsubdiv) {
-        $query .= " \@attr 1=47 \"$subjectsubdiv\" ";
-        $nterms++;
-    }
-
-    if ($title) {
-        $query .= " \@attr 1=4 \"$title\" "; #This is a regular title search. 1=6 will give just uniform titles
-        $nterms++;
-    }
-
-     if ($uniformtitle) {
-        $query .= " \@attr 1=6 \"$uniformtitle\" "; #This is the uniform title search
-        $nterms++;
-    }
-
-    if($srchany) {
-        $query .= " \@attr 1=1016 \"$srchany\" ";
-        $nterms++;
-    }
-
-    for my $i (1..$nterms-1) {
-        $query = "\@and " . $query;
-    }
-
+    my $marcflavour = C4::Context->preference('marcflavour');
+    my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour;
+    my $authid= $pars->{authid};
+    my ( $zquery, $squery ) = _auth_build_query( $pars );
     foreach my $servid (@id) {
         my $sth = $dbh->prepare("select * from z3950servers where id=?");
         $sth->execute($servid);
         while ( $server = $sth->fetchrow_hashref ) {
-            my $option1      = new ZOOM::Options();
-            $option1->option( 'async' => 1 );
-            $option1->option( 'elementSetName', 'F' );
-            $option1->option( 'databaseName',   $server->{db} );
-            $option1->option( 'user', $server->{userid} ) if $server->{userid};
-            $option1->option( 'password', $server->{password} ) if $server->{password};
-            $option1->option( 'preferredRecordSyntax', $server->{syntax} );
-            $option1->option( 'timeout', $server->{timeout} ) if $server->{timeout};
-            $oConnection[$s] = create ZOOM::Connection($option1);
-            $oConnection[$s]->connect( $server->{host}, $server->{port} );
-            $serverhost[$s] = $server->{host};
-            $servername[$s] = $server->{name};
+            $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 )));
             $encoding[$s]   = ($server->{encoding}?$server->{encoding}:"iso-5426");
+            $servers[$s] = $server;
             $s++;
-        }    ## while fetch
+        }   ## while fetch
     }    # foreach
     my $nremaining  = $s;
 
-    for ( my $z = 0 ; $z < $s ; $z++ ) {
-        $oResult[$z] = $oConnection[$z]->search_pqf($query);
-    }
-
     while ( $nremaining-- ) {
         my $k;
         my $event;
@@ -655,23 +657,27 @@ sub Z3950SearchAuth {
                             $marcdata   = $rec->raw();
 
                             my ($charset_result, $charset_errors);
-                            ($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]);
-
+                            if( $servers[$k]->{servertype} eq 'sru' ) {
+                                $marcrecord = MARC::Record->new_from_xml( $marcdata, 'UTF-8', $servers[$k]->{syntax} );
+                            } else {
+                                ( $marcrecord, $charset_result, $charset_errors ) = MarcToUTF8Record( $marcdata, $marc_type, $encoding[$k] );
+                            }
                             my $heading;
                             my $heading_authtype_code;
                             $heading_authtype_code = GuessAuthTypeCode($marcrecord);
                             $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });
 
-                            my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' );
+                            my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcrecord, 2, $serverhost[$k], $encoding[$k], $random);
                             my %row_data;
-                            $row_data{server}       = $servername[$k];
+                            $row_data{server}       = $servers[$k]->{'servername'};
                             $row_data{breedingid}   = $breedingid;
                             $row_data{heading}      = $heading;
+                            $row_data{authid}       = $authid;
                             $row_data{heading_code}      = $heading_authtype_code;
                             push( @breeding_loop, \%row_data );
                         }
                         else {
-                            push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1});
+                            push(@breeding_loop,{'server'=>$servers[$k]->{'servername'},'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'authid'=>-1});
                         }
                     }
                 }    #if $numresults
@@ -693,7 +699,7 @@ sub Z3950SearchAuth {
         $oConnection[$_]->destroy();
     }
 
-    my @servers = ();
+    @servers = ();
     foreach my $id (@id) {
         push @servers, {id => $id};
     }