Lines 1-6
Link Here
|
1 |
package C4::Breeding; |
1 |
package C4::Breeding; |
2 |
|
2 |
|
3 |
# Copyright 2000-2002 Katipo Communications |
3 |
# Copyright 2000-2002 Katipo Communications |
|
|
4 |
# Parts Copyright 2013 Prosentient Systems |
4 |
# |
5 |
# |
5 |
# This file is part of Koha. |
6 |
# This file is part of Koha. |
6 |
# |
7 |
# |
Lines 25-30
use C4::Koha;
Link Here
|
25 |
use C4::Charset; |
26 |
use C4::Charset; |
26 |
use MARC::File::USMARC; |
27 |
use MARC::File::USMARC; |
27 |
use C4::ImportBatch; |
28 |
use C4::ImportBatch; |
|
|
29 |
use C4::AuthoritiesMarc; #GuessAuthTypeCode, FindDuplicateAuthority |
28 |
|
30 |
|
29 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
31 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
30 |
|
32 |
|
Lines 33-39
BEGIN {
Link Here
|
33 |
$VERSION = 3.07.00.049; |
35 |
$VERSION = 3.07.00.049; |
34 |
require Exporter; |
36 |
require Exporter; |
35 |
@ISA = qw(Exporter); |
37 |
@ISA = qw(Exporter); |
36 |
@EXPORT = qw(&ImportBreeding &BreedingSearch &Z3950Search); |
38 |
@EXPORT = qw(&ImportBreeding &BreedingSearch &Z3950Search &Z3950SearchAuth); |
37 |
} |
39 |
} |
38 |
|
40 |
|
39 |
=head1 NAME |
41 |
=head1 NAME |
Lines 436-441
sub Z3950Search {
Link Here
|
436 |
); |
438 |
); |
437 |
} |
439 |
} |
438 |
|
440 |
|
|
|
441 |
=head2 ImportBreedingAuth |
442 |
|
443 |
ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type); |
444 |
|
445 |
TODO description |
446 |
|
447 |
=cut |
448 |
|
449 |
sub ImportBreedingAuth { |
450 |
my ($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type) = @_; |
451 |
my @marcarray = split /\x1D/, $marcrecords; |
452 |
|
453 |
my $dbh = C4::Context->dbh; |
454 |
|
455 |
my $batch_id = GetZ3950BatchId($filename); |
456 |
my $searchbreeding = $dbh->prepare("select import_record_id from import_auths where controlnumber=? and authorized_heading=?"); |
457 |
|
458 |
# $encoding = C4::Context->preference("marcflavour") unless $encoding; |
459 |
# fields used for import results |
460 |
my $imported=0; |
461 |
my $alreadyindb = 0; |
462 |
my $alreadyinfarm = 0; |
463 |
my $notmarcrecord = 0; |
464 |
my $breedingid; |
465 |
for (my $i=0;$i<=$#marcarray;$i++) { |
466 |
my ($marcrecord, $charset_result, $charset_errors); |
467 |
($marcrecord, $charset_result, $charset_errors) = |
468 |
MarcToUTF8Record($marcarray[$i]."\x1D", C4::Context->preference("marcflavour"), $encoding); |
469 |
|
470 |
# Normalize the record so it doesn't have separated diacritics |
471 |
SetUTF8Flag($marcrecord); |
472 |
|
473 |
# warn "$i : $marcarray[$i]"; |
474 |
# FIXME - currently this does nothing |
475 |
my @warnings = $marcrecord->warnings(); |
476 |
|
477 |
if (scalar($marcrecord->fields()) == 0) { |
478 |
$notmarcrecord++; |
479 |
} else { |
480 |
|
481 |
my $heading; |
482 |
$heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord }); |
483 |
|
484 |
my $heading_authtype_code; |
485 |
$heading_authtype_code = GuessAuthTypeCode($marcrecord); |
486 |
|
487 |
my $controlnumber; |
488 |
$controlnumber = $marcrecord->field('001')->data; |
489 |
|
490 |
#Check if the authority record already exists in the database... |
491 |
my ($duplicateauthid,$duplicateauthvalue); |
492 |
if ($marcrecord && $heading_authtype_code) { |
493 |
($duplicateauthid,$duplicateauthvalue) = FindDuplicateAuthority( $marcrecord, $heading_authtype_code); |
494 |
} |
495 |
|
496 |
if ($duplicateauthid && $overwrite_auth ne 2) { |
497 |
#If the authority record exists and $overwrite_auth doesn't equal 2, then mark it as already in the DB |
498 |
#FIXME: What does $overwrite_auth = 2 even mean? |
499 |
|
500 |
#FIXME: Should we bother with $overwrite_auth values? Currently, the hard-coded $overwrite_auth value is 2, which means the database gets filled with import_records... |
501 |
#^^ of course, we might not want to reject records if their control number/heading exist in the db or breeding/import pool...as we might be wanting to update existing authority records... |
502 |
$alreadyindb++; |
503 |
} else { |
504 |
|
505 |
if ($controlnumber && $heading) { |
506 |
$searchbreeding->execute($controlnumber,$heading); |
507 |
($breedingid) = $searchbreeding->fetchrow; |
508 |
} |
509 |
if ($breedingid && $overwrite_auth eq '0') { |
510 |
#FIXME: What does $overwrite_auth = 0 even mean? |
511 |
$alreadyinfarm++; |
512 |
} else { |
513 |
if ($breedingid && $overwrite_auth eq '1') { |
514 |
#FIXME: What does $overwrite_auth = 1 even mean? |
515 |
ModAuthInBatch($breedingid, $marcrecord); |
516 |
} else { |
517 |
my $import_id = AddAuthToBatch($batch_id, $imported, $marcrecord, $encoding, $z3950random); |
518 |
$breedingid = $import_id; |
519 |
} |
520 |
$imported++; |
521 |
} |
522 |
} |
523 |
} |
524 |
} |
525 |
return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid); |
526 |
} |
527 |
|
528 |
=head2 Z3950SearchAuth |
529 |
|
530 |
Z3950SearchAuth($pars, $template); |
531 |
|
532 |
Parameters for Z3950 search are all passed via the $pars hash. It may contain nameany, namepersonal, namecorp, namemeetingcon, |
533 |
title, uniform title, subject, subjectsubdiv, srchany. |
534 |
Also it should contain an arrayref id that points to a list of IDs of the z3950 targets to be queried (see z3950servers table). |
535 |
This code is used in cataloging/z3950_auth_search. |
536 |
The second parameter $template is a Template object. The routine uses this parameter to store the found values into the template. |
537 |
|
538 |
=cut |
539 |
|
540 |
sub Z3950SearchAuth { |
541 |
my ($pars, $template)= @_; |
542 |
|
543 |
my $dbh = C4::Context->dbh; |
544 |
my @id= @{$pars->{id}}; |
545 |
my $random= $pars->{random}; |
546 |
my $page= $pars->{page}; |
547 |
|
548 |
my $nameany= $pars->{nameany}; |
549 |
my $namepersonal= $pars->{namepersonal}; |
550 |
my $namecorp= $pars->{namecorp}; |
551 |
my $namemeetingcon= $pars->{namemeetingcon}; |
552 |
my $title= $pars->{title}; |
553 |
my $uniformtitle= $pars->{uniformtitle}; |
554 |
my $subject= $pars->{subject}; |
555 |
my $subjectsubdiv= $pars->{subjectsubdiv}; |
556 |
my $srchany= $pars->{srchany}; |
557 |
|
558 |
my $show_next = 0; |
559 |
my $total_pages = 0; |
560 |
my $attr = ''; |
561 |
my $host; |
562 |
my $server; |
563 |
my $database; |
564 |
my $port; |
565 |
my $marcdata; |
566 |
my @encoding; |
567 |
my @results; |
568 |
my $count; |
569 |
my $record; |
570 |
my @serverhost; |
571 |
my @servername; |
572 |
my @breeding_loop = (); |
573 |
|
574 |
my @oConnection; |
575 |
my @oResult; |
576 |
my @errconn; |
577 |
my $s = 0; |
578 |
my $query; |
579 |
my $nterms=0; |
580 |
|
581 |
|
582 |
if ($nameany) { |
583 |
$query .= " \@attr 1=1003 \"$nameany\" "; #Author-name |
584 |
$nterms++; |
585 |
} |
586 |
|
587 |
if ($namecorp) { |
588 |
$query .= " \@attr 1=2 \"$namecorp\" "; #1005 is another valid corporate author attribute... |
589 |
$nterms++; |
590 |
} |
591 |
|
592 |
if ($namepersonal) { |
593 |
$query .= " \@attr 1=1 \"$namepersonal\" "; #1004 is another valid personal name attribute... |
594 |
$nterms++; |
595 |
} |
596 |
|
597 |
if ($namemeetingcon) { |
598 |
$query .= " \@attr 1=1006 \"$namemeetingcon\" "; |
599 |
$nterms++; |
600 |
} |
601 |
|
602 |
if ($subject) { |
603 |
$query .= " \@attr 1=21 \"$subject\" "; |
604 |
$nterms++; |
605 |
} |
606 |
|
607 |
if ($subjectsubdiv) { |
608 |
$query .= " \@attr 1=47 \"$subjectsubdiv\" "; |
609 |
$nterms++; |
610 |
} |
611 |
|
612 |
if ($title) { |
613 |
$query .= " \@attr 1=4 \"$title\" "; #This is a regular title search. 1=6 will give just uniform titles |
614 |
$nterms++; |
615 |
} |
616 |
|
617 |
if ($uniformtitle) { |
618 |
$query .= " \@attr 1=6 \"$uniformtitle\" "; #This is the uniform title search |
619 |
$nterms++; |
620 |
} |
621 |
|
622 |
if($srchany) { |
623 |
$query .= " \@attr 1=1016 \"$srchany\" "; |
624 |
$nterms++; |
625 |
} |
626 |
|
627 |
for my $i (1..$nterms-1) { |
628 |
$query = "\@and " . $query; |
629 |
} |
630 |
|
631 |
foreach my $servid (@id) { |
632 |
my $sth = $dbh->prepare("select * from z3950servers where id=?"); |
633 |
$sth->execute($servid); |
634 |
while ( $server = $sth->fetchrow_hashref ) { |
635 |
my $option1 = new ZOOM::Options(); |
636 |
$option1->option( 'async' => 1 ); |
637 |
$option1->option( 'elementSetName', 'F' ); |
638 |
$option1->option( 'databaseName', $server->{db} ); |
639 |
$option1->option( 'user', $server->{userid} ) if $server->{userid}; |
640 |
$option1->option( 'password', $server->{password} ) if $server->{password}; |
641 |
$option1->option( 'preferredRecordSyntax', $server->{syntax} ); |
642 |
$option1->option( 'timeout', $server->{timeout} ) if $server->{timeout}; |
643 |
$oConnection[$s] = create ZOOM::Connection($option1); |
644 |
$oConnection[$s]->connect( $server->{host}, $server->{port} ); |
645 |
$serverhost[$s] = $server->{host}; |
646 |
$servername[$s] = $server->{name}; |
647 |
$encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); |
648 |
$s++; |
649 |
} ## while fetch |
650 |
} # foreach |
651 |
my $nremaining = $s; |
652 |
|
653 |
for ( my $z = 0 ; $z < $s ; $z++ ) { |
654 |
$oResult[$z] = $oConnection[$z]->search_pqf($query); |
655 |
} |
656 |
|
657 |
while ( $nremaining-- ) { |
658 |
my $k; |
659 |
my $event; |
660 |
while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) { |
661 |
$event = $oConnection[ $k - 1 ]->last_event(); |
662 |
last if $event == ZOOM::Event::ZEND; |
663 |
} |
664 |
|
665 |
if ( $k != 0 ) { |
666 |
$k--; |
667 |
my ($error, $errmsg, $addinfo, $diagset)= $oConnection[$k]->error_x(); |
668 |
if ($error) { |
669 |
if ($error =~ m/^(10000|10007)$/ ) { |
670 |
push(@errconn, {'server' => $serverhost[$k]}); |
671 |
} |
672 |
} |
673 |
else { |
674 |
my $numresults = $oResult[$k]->size(); |
675 |
my $i; |
676 |
my $result = ''; |
677 |
if ( $numresults > 0 and $numresults >= (($page-1)*20)) { |
678 |
$show_next = 1 if $numresults >= ($page*20); |
679 |
$total_pages = int($numresults/20)+1 if $total_pages < ($numresults/20); |
680 |
for ($i = ($page-1)*20; $i < (($numresults < ($page*20)) ? $numresults : ($page*20)); $i++) { |
681 |
my $rec = $oResult[$k]->record($i); |
682 |
if ($rec) { |
683 |
my $marcrecord; |
684 |
my $marcdata; |
685 |
$marcdata = $rec->raw(); |
686 |
|
687 |
my ($charset_result, $charset_errors); |
688 |
($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); |
689 |
|
690 |
my $heading; |
691 |
my $heading_authtype_code; |
692 |
$heading_authtype_code = GuessAuthTypeCode($marcrecord); |
693 |
$heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord }); |
694 |
|
695 |
my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' ); |
696 |
my %row_data; |
697 |
$row_data{server} = $servername[$k]; |
698 |
$row_data{breedingid} = $breedingid; |
699 |
$row_data{heading} = $heading; |
700 |
$row_data{heading_code} = $heading_authtype_code; |
701 |
push( @breeding_loop, \%row_data ); |
702 |
} |
703 |
else { |
704 |
push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1}); |
705 |
} |
706 |
} |
707 |
} #if $numresults |
708 |
} |
709 |
} # if $k !=0 |
710 |
|
711 |
$template->param( |
712 |
numberpending => $nremaining, |
713 |
current_page => $page, |
714 |
total_pages => $total_pages, |
715 |
show_nextbutton => $show_next?1:0, |
716 |
show_prevbutton => $page!=1, |
717 |
); |
718 |
} # while nremaining |
719 |
|
720 |
#close result sets and connections |
721 |
foreach(0..$s-1) { |
722 |
$oResult[$_]->destroy(); |
723 |
$oConnection[$_]->destroy(); |
724 |
} |
725 |
|
726 |
my @servers = (); |
727 |
foreach my $id (@id) { |
728 |
push @servers, {id => $id}; |
729 |
} |
730 |
$template->param( |
731 |
breeding_loop => \@breeding_loop, |
732 |
servers => \@servers, |
733 |
errconn => \@errconn |
734 |
); |
735 |
} |
736 |
|
439 |
1; |
737 |
1; |
440 |
__END__ |
738 |
__END__ |
441 |
|
739 |
|