X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FBreeding.pm;h=a93189c13fe6ba3fa1a1996afe9f0fff640ecaa7;hb=4fcf7af117153690cc4aca55eb47290dfc5814f6;hp=db8a3a48a545f346aadd45e2a8d43a88f5ce7f68;hpb=de40463a7fa2be0fe090ef64b2bfffe928607adc;p=koha-ffzg.git diff --git a/C4/Breeding.pm b/C4/Breeding.pm index db8a3a48a5..a93189c13f 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -25,6 +25,7 @@ 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; @@ -47,7 +48,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 +57,9 @@ cataloguing reservoir features. =head2 BreedingSearch -($count, @results) = &BreedingSearch($title,$isbn,$random); +($count, @results) = &BreedingSearch($title,$isbn); C<$title> contains the title, C<$isbn> contains isbn or issn, -C<$random> contains the random seed from a z3950 search. 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 and @@ -68,7 +68,7 @@ C tables of the Koha database. =cut sub BreedingSearch { - my ($search,$isbn,$z3950random) = @_; + my ($search,$isbn) = @_; my $dbh = C4::Context->dbh; my $count = 0; my ($query,@bind); @@ -83,25 +83,20 @@ sub BreedingSearch { 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%"); - } + @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 "; } - $sth = $dbh->prepare($query); + if (defined($isbn) && length($isbn)>0) { + $query .= "isbn like ?"; + push(@bind,"$isbn%"); + } + $sth = $dbh->prepare($query); $sth->execute(@bind); while (my $data = $sth->fetchrow_hashref) { $results[$count] = $data; @@ -147,7 +142,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( @@ -244,26 +239,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 = { @@ -280,6 +260,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; @@ -314,9 +301,7 @@ 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 @@ -363,15 +348,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) { $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; } @@ -445,73 +483,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; - - # 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); + my $controlnumber = $marcrecord->field('001')->data; - 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 +526,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,7 +550,7 @@ 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] = @@ -573,7 +558,7 @@ sub Z3950SearchAuth { $oConnection[$s]->search_pqf( $zquery ): $oConnection[$s]->search(new ZOOM::Query::CQL( _translate_query( $server, $squery ))); - $encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); + $encoding[$s] = $server->{encoding} // "iso-5426"; $servers[$s] = $server; $s++; } ## while fetch @@ -590,7 +575,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]}); @@ -621,7 +606,7 @@ sub Z3950SearchAuth { $heading_authtype_code = GuessAuthTypeCode($marcrecord); $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;