X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBreeding.pm;h=a17406b145015eb48a1b63900236baad90705850;hb=e0e063a85b654af623ea1da068d6fd23e8ec3833;hp=03f3ed57d44b8e07e65639699e17620642df85c2;hpb=990bb17e14efb8a2c16236c89ef5869dcfc48ad4;p=koha.git diff --git a/C4/Breeding.pm b/C4/Breeding.pm index 03f3ed57d4..a17406b145 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -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 . use strict; use warnings; @@ -27,12 +27,13 @@ use C4::Charset; use MARC::File::USMARC; 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); @@ -135,109 +136,37 @@ sub Z3950Search { my @id= @{$pars->{id}}; my $page= $pars->{page}; my $biblionumber= $pars->{biblionumber}; - my $isbn= $pars->{isbn}; - my $issn= $pars->{issn}; - my $title= $pars->{title}; - my $author= $pars->{author}; - my $dewey= $pars->{dewey}; - my $subject= $pars->{subject}; - my $lccn= $pars->{lccn}; - my $lccall= $pars->{lccall}; - my $controlnumber= $pars->{controlnumber}; - my $srchany= $pars->{srchany}; - my $stdid= $pars->{stdid}; my $show_next = 0; my $total_pages = 0; - my $term; my @results; my @breeding_loop = (); my @oConnection; my @oResult; my @errconn; my $s = 0; - my $query; - my $nterms=0; my $imported=0; - my @serverinfo; #replaces former serverhost, servername, encoding - - if ($isbn) { - $term=$isbn; - $query .= " \@attr 1=7 \@attr 5=1 \"$term\" "; - $nterms++; - } - if ($issn) { - $term=$issn; - $query .= " \@attr 1=8 \@attr 5=1 \"$term\" "; - $nterms++; - } - if ($title) { - $query .= " \@attr 1=4 \"$title\" "; - $nterms++; - } - if ($author) { - $query .= " \@attr 1=1003 \"$author\" "; - $nterms++; - } - if ($dewey) { - $query .= " \@attr 1=16 \"$dewey\" "; - $nterms++; - } - if ($subject) { - $query .= " \@attr 1=21 \"$subject\" "; - $nterms++; - } - if ($lccn) { - $query .= " \@attr 1=9 $lccn "; - $nterms++; - } - if ($lccall) { - $query .= " \@attr 1=16 \@attr 2=3 \@attr 3=1 \@attr 4=1 \@attr 5=1 \@attr 6=1 \"$lccall\" "; - $nterms++; - } - if ($controlnumber) { - $query .= " \@attr 1=12 \"$controlnumber\" "; - $nterms++; - } - if($srchany) { - $query .= " \@attr 1=1016 \"$srchany\" "; - $nterms++; - } - if($stdid) { - $query .= " \@attr 1=1007 \"$stdid\" "; - $nterms++; - } - for my $i (1..$nterms-1) { - $query = "\@and " . $query; - } - - my $dbh = C4::Context->dbh; - foreach my $servid (@id) { - my $sth = $dbh->prepare("select * from z3950servers where id=?"); - $sth->execute($servid); - while (my $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} ); - $serverinfo[$s]->{host}= $server->{host}; - $serverinfo[$s]->{name}= $server->{name}; - $serverinfo[$s]->{encd}= $server->{encoding} // "iso-5426"; - $s++; - } ## while fetch - } # foreach - my $nremaining = $s; - for ( my $z = 0 ; $z < $s ; $z++ ) { - $oResult[$z] = $oConnection[$z]->search_pqf($query); - } + my ( $zquery, $squery ) = _build_query( $pars ); + my $schema = Koha::Database->new()->schema(); + my $rs = $schema->resultset('Z3950server')->search( + { id => [ @id ] }, + { result_class => 'DBIx::Class::ResultClass::HashRefInflator' }, + ); + my @servers = $rs->all; + foreach my $server ( @servers ) { + $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 ))); + $s++; + } + my $xslh = Koha::XSLT_Handler->new; + + my $nremaining = $s; while ( $nremaining-- ) { my $k; my $event; @@ -251,23 +180,25 @@ sub Z3950Search { my ($error)= $oConnection[$k]->error_x(); #ignores errmsg, addinfo, diagset if ($error) { if ($error =~ m/^(10000|10007)$/ ) { - push(@errconn, { server => $serverinfo[$k]->{host}, error => $error } ); + push(@errconn, { server => $servers[$k]->{host}, error => $error } ); } } else { my $numresults = $oResult[$k]->size(); my $i; - my $result = ''; + my $res; if ( $numresults > 0 and $numresults >= (($page-1)*20)) { $show_next = 1 if $numresults >= ($page*20); $total_pages = int($numresults/20)+1 if $total_pages < ($numresults/20); for ($i = ($page-1)*20; $i < (($numresults < ($page*20)) ? $numresults : ($page*20)); $i++) { - if($oResult[$k]->record($i)) { - my $res=_handle_one_result($oResult[$k]->record($i), $serverinfo[$k], ++$imported, $biblionumber); #ignores error in sequence numbering + if ( $oResult[$k]->record($i) ) { + undef $error; + ( $res, $error ) = _handle_one_result( $oResult[$k]->record($i), $servers[$k], ++$imported, $biblionumber, $xslh ); #ignores error in sequence numbering push @breeding_loop, $res if $res; + push @errconn, { server => $servers[$k]->{servername}, error => $error, seq => $i+1 } if $error; } else { - push(@breeding_loop,{'server'=>$serverinfo[$k]->{name},'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'biblionumber'=>-1}); + push @errconn, { 'server' => $servers[$k]->{servername}, error => ( ( $oConnection[$k]->error_x() )[0] ), seq => $i+1 }; } } } #if $numresults @@ -289,10 +220,6 @@ sub Z3950Search { $oConnection[$_]->destroy(); } - my @servers = (); - foreach my $id (@id) { - push @servers, {id => $id}; - } $template->param( breeding_loop => \@breeding_loop, servers => \@servers, @@ -300,14 +227,57 @@ sub Z3950Search { ); } +sub _build_query { + my ( $pars ) = @_; + + my $qry_build = { + isbn => '@attr 1=7 @attr 5=1 "#term" ', + issn => '@attr 1=8 @attr 5=1 "#term" ', + title => '@attr 1=4 "#term" ', + author => '@attr 1=1003 "#term" ', + dewey => '@attr 1=16 "#term" ', + subject => '@attr 1=21 "#term" ', + lccall => '@attr 1=16 @attr 2=3 @attr 3=1 @attr 4=1 @attr 5=1 '. + '@attr 6=1 "#term" ', + controlnumber => '@attr 1=12 "#term" ', + srchany => '@attr 1=1016 "#term" ', + stdid => '@attr 1=1007 "#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 ); +} + sub _handle_one_result { - my ($zoomrec, $servhref, $seq, $bib)= @_; + my ( $zoomrec, $servhref, $seq, $bib, $xslh )= @_; my $raw= $zoomrec->raw(); - my ($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encd}); #ignores charset return values + my $marcrecord; + if( $servhref->{servertype} eq 'sru' ) { + $marcrecord= MARC::Record->new_from_xml( $raw, 'UTF-8', + $servhref->{syntax} ); + } else { + ($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encoding} // "iso-5426" ); #ignores charset return values + } SetUTF8Flag($marcrecord); + my $error; + ( $marcrecord, $error ) = _do_xslt_proc($marcrecord, $servhref, $xslh); - my $batch_id = GetZ3950BatchId($servhref->{name}); + 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 @@ -316,12 +286,38 @@ sub _handle_one_result { #call to TransformMarcToKoha replaced by next call #we only need six fields from the marc record - return _add_rowdata( + my $row; + $row = _add_rowdata( { biblionumber => $bib, - server => $servhref->{name}, + server => $servhref->{servername}, breedingid => $breedingid, }, $marcrecord) if $breedingid; + return ( $row, $error ); +} + +sub _do_xslt_proc { + my ( $marc, $server, $xslh ) = @_; + return $marc if !$server->{add_xslt}; + + my $htdocs = C4::Context->config('intrahtdocs'); + my $theme = C4::Context->preference("template"); #staff + my $lang = C4::Languages::getlanguage() || 'en'; + + my @files= split ',', $server->{add_xslt}; + my $xml = $marc->as_xml; + foreach my $f ( @files ) { + $f =~ s/^\s+//; $f =~ s/\s+$//; next if !$f; + $f = C4::XSLT::_get_best_default_xslt_filename( + $htdocs, $theme, $lang, $f ) unless $f =~ /^\//; + $xml = $xslh->transform( $xml, $f ); + last if $xslh->err; #skip other files + } + if( !$xslh->err ) { + return MARC::Record->new_from_xml($xml, 'UTF-8'); + } else { + return ( $marc, 'xslt_err' ); #original record in case of errors + } } sub _add_rowdata { @@ -336,9 +332,7 @@ sub _add_rowdata { date2 => 'biblioitems.publicationyear', #UNIMARC ); 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}); @@ -354,6 +348,66 @@ sub _isbn_replace { return $isbn; } +sub _create_connection { + my ( $server ) = @_; + my $option1= new ZOOM::Options(); + $option1->option( 'async' => 1 ); + $option1->option( 'elementSetName', 'F' ); + $option1->option( 'preferredRecordSyntax', $server->{syntax} ); + $option1->option( 'timeout', $server->{timeout} ) if $server->{timeout}; + + if( $server->{servertype} eq 'sru' ) { + foreach( split ',', $server->{sru_options}//'' ) { + #first remove surrounding spaces at comma and equals-sign + s/^\s+|\s+$//g; + my @temp= split '=', $_, 2; + @temp= map { my $c=$_; $c=~s/^\s+|\s+$//g; $c; } @temp; + $option1->option( $temp[0] => $temp[1] ) if @temp; + } + } elsif( $server->{servertype} eq 'zed' ) { + $option1->option( 'databaseName', $server->{db} ); + $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}; + if( $host !~ /^https?:\/\// ) { + #Normally, host will not be prefixed by protocol. + #In that case we can (safely) assume http. + #In case someone prefixed with https, give it a try.. + $host = 'http://' . $host; + } + $obj->connect( $host.':'.$server->{port}.'/'.$server->{db} ); + } else { + $obj->connect( $server->{host}, $server->{port} ); + } + return $obj; +} + +sub _translate_query { #SRU query adjusted per server cf. srufields column + my ($server, $query) = @_; + + #sru_fields is in format title=field,isbn=field,... + #if a field doesn't exist, try anywhere or remove [field]= + my @parts= split(',', $server->{sru_fields} ); + my %trans= map { if( /=/ ) { ( $`,$' ) } else { () } } @parts; + my $any= $trans{srchany}?$trans{srchany}.'=':''; + + my $q=$query; + foreach my $key (keys %trans) { + my $f=$trans{$key}; + if( $f ) { + $q=~s/\[$key\]/$f/g; + } else { + $q=~s/\[$key\]=/$any/g; + } + } + $q=~s/\[\w+\]=/$any/g; # remove remaining fields (not found in field list) + return $q; +} + =head2 ImportBreedingAuth ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type); @@ -372,7 +426,9 @@ sub ImportBreedingAuth { 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; @@ -382,7 +438,7 @@ sub ImportBreedingAuth { 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); + MarcToUTF8Record($marcarray[$i]."\x1D", $marc_type, $encoding); # Normalize the record so it doesn't have separated diacritics SetUTF8Flag($marcrecord); @@ -460,6 +516,7 @@ sub Z3950SearchAuth { my $subject= $pars->{subject}; my $subjectsubdiv= $pars->{subjectsubdiv}; my $srchany= $pars->{srchany}; + my $authid= $pars->{authid}; my $show_next = 0; my $total_pages = 0; @@ -484,6 +541,9 @@ sub Z3950SearchAuth { my $query; my $nterms=0; + my $marcflavour = C4::Context->preference('marcflavour'); + my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour; + 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 @@ -555,7 +615,7 @@ sub Z3950SearchAuth { $oConnection[$s] = create ZOOM::Connection($option1); $oConnection[$s]->connect( $server->{host}, $server->{port} ); $serverhost[$s] = $server->{host}; - $servername[$s] = $server->{name}; + $servername[$s] = $server->{servername}; $encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); $s++; } ## while fetch @@ -597,7 +657,7 @@ sub Z3950SearchAuth { $marcdata = $rec->raw(); my ($charset_result, $charset_errors); - ($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); + ($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, $marc_type, $encoding[$k]); my $heading; my $heading_authtype_code; @@ -609,11 +669,12 @@ sub Z3950SearchAuth { $row_data{server} = $servername[$k]; $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'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'authid'=>-1}); } } } #if $numresults