|
Lines 19-30
package C4::AuthoritiesMarc;
Link Here
|
| 19 |
use strict; |
19 |
use strict; |
| 20 |
use warnings; |
20 |
use warnings; |
| 21 |
use C4::Context; |
21 |
use C4::Context; |
|
|
22 |
use List::MoreUtils qw/any none first_index/; |
| 22 |
use MARC::Record; |
23 |
use MARC::Record; |
| 23 |
use C4::Biblio; |
24 |
use C4::Biblio; |
| 24 |
use C4::Search; |
25 |
use C4::Search; |
| 25 |
use C4::AuthoritiesMarc::MARC21; |
26 |
use C4::AuthoritiesMarc::MARC21; |
| 26 |
use C4::AuthoritiesMarc::UNIMARC; |
27 |
use C4::AuthoritiesMarc::UNIMARC; |
| 27 |
use C4::Charset; |
28 |
use C4::Charset; |
|
|
29 |
use C4::Debug; |
| 28 |
use C4::Log; |
30 |
use C4::Log; |
| 29 |
use Koha::Authority; |
31 |
use Koha::Authority; |
| 30 |
|
32 |
|
|
Lines 32-38
use vars qw($VERSION @ISA @EXPORT);
Link Here
|
| 32 |
|
34 |
|
| 33 |
BEGIN { |
35 |
BEGIN { |
| 34 |
# set the version for version checking |
36 |
# set the version for version checking |
| 35 |
$VERSION = 3.07.00.049; |
37 |
$VERSION = 3.11.00.001; |
| 36 |
|
38 |
|
| 37 |
require Exporter; |
39 |
require Exporter; |
| 38 |
@ISA = qw(Exporter); |
40 |
@ISA = qw(Exporter); |
|
Lines 62-67
BEGIN {
Link Here
|
| 62 |
|
64 |
|
| 63 |
&GuessAuthTypeCode |
65 |
&GuessAuthTypeCode |
| 64 |
&GuessAuthId |
66 |
&GuessAuthId |
|
|
67 |
authorityflavour |
| 65 |
); |
68 |
); |
| 66 |
} |
69 |
} |
| 67 |
|
70 |
|
|
Lines 95-100
sub GetAuthMARCFromKohaField {
Link Here
|
| 95 |
return ($tagfield,$tagsubfield); |
98 |
return ($tagfield,$tagsubfield); |
| 96 |
} |
99 |
} |
| 97 |
|
100 |
|
|
|
101 |
=head2 authorityflavour |
| 102 |
|
| 103 |
$authorityflavour = authorityflavour(); |
| 104 |
return the marc flavour used for authorities |
| 105 |
|
| 106 |
=cut |
| 107 |
my $authorityflavour; |
| 108 |
|
| 109 |
sub authorityflavour { |
| 110 |
return $authorityflavour if defined $authorityflavour; |
| 111 |
$authorityflavour = |
| 112 |
(uc(C4::Context->preference('marcflavour')) eq 'UNIMARC'? |
| 113 |
"UNIMARCAUTH": |
| 114 |
C4::Context->preference('marcflavour') |
| 115 |
); |
| 116 |
return $authorityflavour; |
| 117 |
} |
| 118 |
|
| 98 |
=head2 SearchAuthorities |
119 |
=head2 SearchAuthorities |
| 99 |
|
120 |
|
| 100 |
(\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, |
121 |
(\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, |
|
Lines 449-464
sub GetAuthTypeCode {
Link Here
|
| 449 |
|
470 |
|
| 450 |
=head2 GuessAuthTypeCode |
471 |
=head2 GuessAuthTypeCode |
| 451 |
|
472 |
|
| 452 |
my $authtypecode = GuessAuthTypeCode($record); |
473 |
my $authtypecode = GuessAuthTypeCode($record, [$headingfields]); |
| 453 |
|
474 |
|
| 454 |
Get the record and tries to guess the adequate authtypecode from its content. |
475 |
Get the record and tries to guess the adequate authtypecode from its content. |
| 455 |
|
476 |
|
| 456 |
=cut |
477 |
=cut |
| 457 |
|
478 |
|
| 458 |
sub GuessAuthTypeCode { |
479 |
sub GuessAuthTypeCode { |
| 459 |
my ($record) = @_; |
480 |
my ($record, $heading_fields) = @_; |
| 460 |
return unless defined $record; |
481 |
return unless defined $record; |
| 461 |
my $heading_fields = { |
482 |
$heading_fields //= { |
| 462 |
"MARC21"=>{ |
483 |
"MARC21"=>{ |
| 463 |
'100'=>{authtypecode=>'PERSO_NAME'}, |
484 |
'100'=>{authtypecode=>'PERSO_NAME'}, |
| 464 |
'110'=>{authtypecode=>'CORPO_NAME'}, |
485 |
'110'=>{authtypecode=>'CORPO_NAME'}, |
|
Lines 653-667
sub AddAuthority {
Link Here
|
| 653 |
my $leader=' nz a22 o 4500';#Leader for incomplete MARC21 record |
674 |
my $leader=' nz a22 o 4500';#Leader for incomplete MARC21 record |
| 654 |
|
675 |
|
| 655 |
# if authid empty => true add, find a new authid number |
676 |
# if authid empty => true add, find a new authid number |
| 656 |
my $format; |
677 |
#update date/time to 005 for marc and unimarc |
| 657 |
if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') { |
|
|
| 658 |
$format= 'UNIMARCAUTH'; |
| 659 |
} |
| 660 |
else { |
| 661 |
$format= 'MARC21'; |
| 662 |
} |
| 663 |
|
| 664 |
#update date/time to 005 for marc and unimarc |
| 665 |
my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime); |
678 |
my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime); |
| 666 |
my $f5=$record->field('005'); |
679 |
my $f5=$record->field('005'); |
| 667 |
if (!$f5) { |
680 |
if (!$f5) { |
|
Lines 672-678
sub AddAuthority {
Link Here
|
| 672 |
} |
685 |
} |
| 673 |
|
686 |
|
| 674 |
SetUTF8Flag($record); |
687 |
SetUTF8Flag($record); |
| 675 |
if ($format eq "MARC21") { |
688 |
if (authorityflavour() eq "MARC21") { |
| 676 |
if (!$record->leader) { |
689 |
if (!$record->leader) { |
| 677 |
$record->leader($leader); |
690 |
$record->leader($leader); |
| 678 |
} |
691 |
} |
|
Lines 704-710
sub AddAuthority {
Link Here
|
| 704 |
} |
717 |
} |
| 705 |
} |
718 |
} |
| 706 |
|
719 |
|
| 707 |
if ($format eq "UNIMARCAUTH") { |
720 |
if (authorityflavour() eq "UNIMARCAUTH") { |
| 708 |
$record->leader(" nx j22 ") unless ($record->leader()); |
721 |
$record->leader(" nx j22 ") unless ($record->leader()); |
| 709 |
my $date=POSIX::strftime("%Y%m%d",localtime); |
722 |
my $date=POSIX::strftime("%Y%m%d",localtime); |
| 710 |
if (my $string=$record->subfield('100',"a")){ |
723 |
if (my $string=$record->subfield('100',"a")){ |
|
Lines 721-727
sub AddAuthority {
Link Here
|
| 721 |
} |
734 |
} |
| 722 |
} |
735 |
} |
| 723 |
my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); |
736 |
my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); |
| 724 |
if (!$authid and $format eq "MARC21") { |
737 |
if (!$authid and authorityflavour() eq "MARC21") { |
| 725 |
# only need to do this fix when modifying an existing authority |
738 |
# only need to do this fix when modifying an existing authority |
| 726 |
C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield); |
739 |
C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield); |
| 727 |
} |
740 |
} |
|
Lines 753-764
sub AddAuthority {
Link Here
|
| 753 |
$record->add_fields('001',$authid) unless ($record->field('001')); |
766 |
$record->add_fields('001',$authid) unless ($record->field('001')); |
| 754 |
# warn "\n\n\n enregistrement".$record->as_formatted; |
767 |
# warn "\n\n\n enregistrement".$record->as_formatted; |
| 755 |
my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?"); |
768 |
my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?"); |
| 756 |
$sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$authid) or die $sth->errstr; |
769 |
$sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour()),$authid) or die $sth->errstr; |
| 757 |
$sth->finish; |
770 |
$sth->finish; |
| 758 |
} |
771 |
} |
| 759 |
else { |
772 |
else { |
| 760 |
my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)"); |
773 |
my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)"); |
| 761 |
$sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format)); |
774 |
$sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour())); |
| 762 |
$sth->finish; |
775 |
$sth->finish; |
| 763 |
logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog"); |
776 |
logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog"); |
| 764 |
} |
777 |
} |
|
Lines 809-817
sub ModAuthority {
Link Here
|
| 809 |
&merge($authid,$oldrecord,$authid,$record); |
822 |
&merge($authid,$oldrecord,$authid,$record); |
| 810 |
} else { |
823 |
} else { |
| 811 |
# save a record in need_merge_authorities table |
824 |
# save a record in need_merge_authorities table |
| 812 |
my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ". |
825 |
my $sqlinsert="INSERT INTO need_merge_authorities (authid, init_value, done) ". |
| 813 |
"VALUES (?,?)"; |
826 |
"VALUES (?,?,?)"; |
| 814 |
$dbh->do($sqlinsert,undef,($authid,0)); |
827 |
$dbh->do($sqlinsert,undef,($authid,$oldrecord->as_xml_record(authorityflavour()),0)); |
| 815 |
} |
828 |
} |
| 816 |
logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); |
829 |
logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); |
| 817 |
return $authid; |
830 |
return $authid; |
|
Lines 1439-1444
sub AddAuthorityTrees{
Link Here
|
| 1439 |
return $rq->execute($trees,$authid); |
1452 |
return $rq->execute($trees,$authid); |
| 1440 |
} |
1453 |
} |
| 1441 |
|
1454 |
|
|
|
1455 |
|
| 1442 |
=head2 merge |
1456 |
=head2 merge |
| 1443 |
|
1457 |
|
| 1444 |
$ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) |
1458 |
$ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) |
|
Lines 1448-1631
Then we should add some new parameter : bibliotargettag, authtargettag
Link Here
|
| 1448 |
|
1462 |
|
| 1449 |
=cut |
1463 |
=cut |
| 1450 |
|
1464 |
|
|
|
1465 |
|
| 1466 |
# Test if a subfield exist in a subfield list |
| 1467 |
sub _test_subfcode_presence { |
| 1468 |
my ( $subfields, $subfcode ) = @_; |
| 1469 |
return grep { $_->[0] eq $subfcode } @$subfields; |
| 1470 |
} |
| 1471 |
|
| 1472 |
# Test if a string exists in a field |
| 1473 |
sub _test_string { |
| 1474 |
my ( $string, @fields ) = @_; |
| 1475 |
my $return = 0; |
| 1476 |
for my $field (@fields) { |
| 1477 |
if ( grep { $_->[1] =~ /$string/i } $field->subfields ) { |
| 1478 |
$return = 1; |
| 1479 |
last; |
| 1480 |
} |
| 1481 |
} |
| 1482 |
return $return; |
| 1483 |
} |
| 1484 |
|
| 1485 |
# _process_subfcode_4_merge sets the correct subfcode |
| 1486 |
sub _process_subfcode_4_merge { |
| 1487 |
my ( $tagfield, $bibliosubfields, $authorityrecord, $authoritysubfields, |
| 1488 |
$authtypecode ) |
| 1489 |
= @_; |
| 1490 |
return unless ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' ); |
| 1491 |
if ( $tagfield eq "600" |
| 1492 |
or $tagfield eq "606" |
| 1493 |
or $tagfield eq "607" |
| 1494 |
or $tagfield eq "700" |
| 1495 |
or $tagfield eq "701" |
| 1496 |
or $tagfield eq "702" |
| 1497 |
or $tagfield eq "710" |
| 1498 |
or $tagfield eq "711" |
| 1499 |
or $tagfield eq "712" ) |
| 1500 |
{ |
| 1501 |
my $authtag = GetAuthType($authtypecode); |
| 1502 |
my $chronological_auth = |
| 1503 |
_test_string( qq{S'emploie uniquement en subdivision chronologique}, |
| 1504 |
$authorityrecord->field('3..') ); |
| 1505 |
my $subfz_absent = not _test_subfcode_presence( $bibliosubfields, 'z' ); |
| 1506 |
if ( _test_subfcode_presence( $bibliosubfields, "a" ) ) { |
| 1507 |
if ( ( $authtag->{'auth_tag_to_report'} eq '215' ) |
| 1508 |
and ( $tagfield ne "607" ) ) |
| 1509 |
{ |
| 1510 |
return "y"; |
| 1511 |
|
| 1512 |
} |
| 1513 |
elsif ( $chronological_auth and $subfz_absent ) { |
| 1514 |
return "z"; |
| 1515 |
} |
| 1516 |
else { |
| 1517 |
return "x"; |
| 1518 |
} |
| 1519 |
} |
| 1520 |
return; |
| 1521 |
} |
| 1522 |
return; |
| 1523 |
} |
| 1524 |
|
| 1451 |
sub merge { |
1525 |
sub merge { |
| 1452 |
my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; |
1526 |
my ( $mergefrom, $MARCfrom, $mergeto, $MARCto ) = @_; |
| 1453 |
my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0); |
1527 |
my $dbh = C4::Context->dbh; |
| 1454 |
my $dbh=C4::Context->dbh; |
1528 |
my $marcflavour = C4::Context->preference('marcflavour'); |
| 1455 |
my $authtypecodefrom = GetAuthTypeCode($mergefrom); |
1529 |
my $authtypecodefrom = GetAuthTypeCode($mergefrom); |
| 1456 |
my $authtypecodeto = GetAuthTypeCode($mergeto); |
1530 |
my $authtypecodeto = GetAuthTypeCode($mergeto); |
| 1457 |
# warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto "; |
1531 |
$MARCfrom ||= GetAuthority($mergefrom); |
|
|
1532 |
$MARCto ||= GetAuthority($mergeto); |
| 1533 |
my @editedbiblios = (); |
| 1534 |
|
| 1458 |
# return if authority does not exist |
1535 |
# return if authority does not exist |
| 1459 |
return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0; |
1536 |
return "error MARCFROM not a marcrecord " . Data::Dumper::Dumper($MARCfrom) |
| 1460 |
return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0; |
1537 |
if ( !$MARCfrom or scalar( $MARCfrom->fields() ) == 0 ); |
|
|
1538 |
return "error MARCTO not a marcrecord" . Data::Dumper::Dumper($MARCto) |
| 1539 |
if ( !$MARCto or scalar( $MARCto->fields() ) == 0 ); |
| 1540 |
|
| 1461 |
# search the tag to report |
1541 |
# search the tag to report |
| 1462 |
my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); |
1542 |
my $sth = $dbh->prepare( |
|
|
1543 |
"select auth_tag_to_report from auth_types where authtypecode=?"); |
| 1463 |
$sth->execute($authtypecodefrom); |
1544 |
$sth->execute($authtypecodefrom); |
| 1464 |
my ($auth_tag_to_report_from) = $sth->fetchrow; |
1545 |
my ($auth_tag_to_report_from) = $sth->fetchrow; |
| 1465 |
$sth->execute($authtypecodeto); |
1546 |
$sth->execute($authtypecodeto); |
| 1466 |
my ($auth_tag_to_report_to) = $sth->fetchrow; |
1547 |
my ($auth_tag_to_report_to) = $sth->fetchrow; |
| 1467 |
|
1548 |
|
| 1468 |
my @record_to; |
1549 |
my @record_to; |
| 1469 |
@record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to); |
1550 |
@record_to = |
|
|
1551 |
grep { $_->[0] !~ /[0-9]/ } |
| 1552 |
$MARCto->field($auth_tag_to_report_to)->subfields() |
| 1553 |
if $MARCto->field($auth_tag_to_report_to); |
| 1554 |
if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) { |
| 1555 |
unshift @record_to, [ 3 => $MARCto->field('009')->data() ]; |
| 1556 |
} |
| 1557 |
my $field_to; |
| 1558 |
$field_to = $MARCto->field($auth_tag_to_report_to) |
| 1559 |
if $MARCto->field($auth_tag_to_report_to); |
| 1470 |
my @record_from; |
1560 |
my @record_from; |
| 1471 |
@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from); |
1561 |
@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() |
| 1472 |
|
1562 |
if $MARCfrom->field($auth_tag_to_report_from); |
|
|
1563 |
|
| 1473 |
my @reccache; |
1564 |
my @reccache; |
|
|
1565 |
|
| 1474 |
# search all biblio tags using this authority. |
1566 |
# search all biblio tags using this authority. |
| 1475 |
#Getting marcbiblios impacted by the change. |
1567 |
#Getting marcbiblios impacted by the change. |
| 1476 |
if (C4::Context->preference('NoZebra')) { |
1568 |
if ( C4::Context->preference('NoZebra') ) { |
| 1477 |
#nozebra way |
1569 |
|
| 1478 |
my $dbh=C4::Context->dbh; |
1570 |
#nozebra way |
| 1479 |
my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" )); |
1571 |
my $dbh = C4::Context->dbh; |
|
|
1572 |
my $rq = $dbh->prepare( |
| 1573 |
qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ) |
| 1574 |
); |
| 1480 |
$rq->execute; |
1575 |
$rq->execute; |
| 1481 |
while (my $biblionumbers=$rq->fetchrow){ |
1576 |
while ( my $biblionumbers = $rq->fetchrow ) { |
| 1482 |
my @biblionumbers=split /;/,$biblionumbers; |
1577 |
my @biblionumbers = split /;/, $biblionumbers; |
| 1483 |
foreach (@biblionumbers) { |
1578 |
foreach (@biblionumbers) { |
| 1484 |
if ($_=~/(\d+),.*/) { |
1579 |
if ( $_ =~ /(\d+),.*/ ) { |
| 1485 |
my $marc=GetMarcBiblio($1); |
1580 |
my $marc = GetMarcBiblio($1); |
| 1486 |
push @reccache,$marc; |
1581 |
push @reccache, $marc; |
| 1487 |
} |
1582 |
} |
| 1488 |
} |
1583 |
} |
| 1489 |
} |
1584 |
} |
| 1490 |
} else { |
1585 |
} |
| 1491 |
#zebra connection |
1586 |
else { |
| 1492 |
my $oConnection=C4::Context->Zconn("biblioserver",0); |
1587 |
|
| 1493 |
# We used to use XML syntax here, but that no longer works. |
1588 |
#zebra connection |
| 1494 |
# Thankfully, we don't need it. |
1589 |
my ( $err, $res, $result ) = |
| 1495 |
my $query; |
1590 |
C4::Search::SimpleSearch( "an=$mergefrom", 0, 999999 ); |
| 1496 |
$query= "an=".$mergefrom; |
1591 |
my $z = 0; |
| 1497 |
my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); |
1592 |
foreach my $rawrecord (@$res) { |
| 1498 |
my $count = 0; |
1593 |
my $marcrecord = MARC::File::USMARC::decode($rawrecord); |
| 1499 |
if ($oResult) { |
1594 |
SetUTF8Flag($marcrecord); |
| 1500 |
$count=$oResult->size(); |
1595 |
push @reccache, $marcrecord; |
| 1501 |
} |
|
|
| 1502 |
my $z=0; |
| 1503 |
while ( $z<$count ) { |
| 1504 |
my $rec; |
| 1505 |
$rec=$oResult->record($z); |
| 1506 |
my $marcdata = $rec->raw(); |
| 1507 |
my $marcrecordzebra= MARC::Record->new_from_usmarc($marcdata); |
| 1508 |
my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' ); |
| 1509 |
my $i = ($biblionumbertagfield < 10) ? $marcrecordzebra->field($biblionumbertagfield)->data : $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield); |
| 1510 |
my $marcrecorddb=GetMarcBiblio($i); |
| 1511 |
push @reccache, $marcrecorddb; |
| 1512 |
$z++; |
| 1513 |
} |
1596 |
} |
| 1514 |
$oResult->destroy(); |
|
|
| 1515 |
} |
1597 |
} |
| 1516 |
#warn scalar(@reccache)." biblios to update"; |
1598 |
|
| 1517 |
# Get All candidate Tags for the change |
1599 |
# Get All candidate Tags for the change |
| 1518 |
# (This will reduce the search scope in marc records). |
1600 |
# (This will reduce the search scope in marc records). |
| 1519 |
$sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); |
1601 |
$sth = $dbh->prepare( |
| 1520 |
$sth->execute($authtypecodefrom); |
1602 |
"select distinct tagfield from marc_subfield_structure where authtypecode<>''" |
|
|
1603 |
); |
| 1604 |
$sth->execute(); |
| 1521 |
my @tags_using_authtype; |
1605 |
my @tags_using_authtype; |
| 1522 |
while (my ($tagfield) = $sth->fetchrow) { |
1606 |
while ( my ($tagfield) = $sth->fetchrow ) { |
| 1523 |
push @tags_using_authtype,$tagfield ; |
1607 |
push @tags_using_authtype, $tagfield; |
| 1524 |
} |
1608 |
} |
| 1525 |
my $tag_to=0; |
1609 |
my $tag_to = 0; |
| 1526 |
if ($authtypecodeto ne $authtypecodefrom){ |
1610 |
|
| 1527 |
# If many tags, take the first |
1611 |
# if any element in this list matchs exactly a subfield in the biblio field |
| 1528 |
$sth->execute($authtypecodeto); |
1612 |
# which is before the $9, the subfield is removed. |
| 1529 |
$tag_to=$sth->fetchrow; |
1613 |
my @data_to_remove = map { $_->[1] } @record_from; |
| 1530 |
#warn $tag_to; |
1614 |
if ( uc( C4::Context->preference('marcflavour') ) eq "UNIMARC" ) { |
| 1531 |
} |
1615 |
|
| 1532 |
# BulkEdit marc records |
1616 |
# If in UNIMARC, we also want to remove PPN if it's before $9 (it will |
| 1533 |
# May be used as a template for a bulkedit field |
1617 |
# be reinserted after) |
| 1534 |
foreach my $marcrecord(@reccache){ |
1618 |
foreach my $record ( $MARCto, $MARCfrom ) { |
| 1535 |
my $update; |
1619 |
my $field = $record->field('009'); |
| 1536 |
foreach my $tagfield (@tags_using_authtype){ |
1620 |
if ( $field and ( my $data = $field->data() ) ) { |
| 1537 |
# warn "tagfield : $tagfield "; |
1621 |
push @data_to_remove, $data; |
| 1538 |
foreach my $field ($marcrecord->field($tagfield)){ |
1622 |
} |
| 1539 |
# biblio is linked to authority with $9 subfield containing authid |
1623 |
} |
| 1540 |
my $auth_number=$field->subfield("9"); |
1624 |
} |
| 1541 |
my $tag=$field->tag(); |
1625 |
|
| 1542 |
if ($auth_number==$mergefrom) { |
1626 |
foreach my $marcrecord (@reccache) { |
| 1543 |
my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto); |
1627 |
foreach my $tagfield (@tags_using_authtype) { |
| 1544 |
my $exclude='9'; |
1628 |
foreach my $field ( $marcrecord->field($tagfield) ) { |
| 1545 |
foreach my $subfield (grep {$_->[0] ne '9'} @record_to) { |
1629 |
my $update; |
| 1546 |
$field_to->add_subfields($subfield->[0] =>$subfield->[1]); |
1630 |
my $tag = $field->tag(); |
| 1547 |
$exclude.= $subfield->[0]; |
1631 |
my @newsubfields; |
|
|
1632 |
my %indexes; |
| 1633 |
|
| 1634 |
#get to next field if no subfield |
| 1635 |
my @localsubfields = $field->subfields(); |
| 1636 |
my $index_9_auth = first_index { |
| 1637 |
( $_->[0] eq 9 ) |
| 1638 |
and ( $_->[1] eq "$mergefrom" ); |
| 1548 |
} |
1639 |
} |
| 1549 |
$exclude='['.$exclude.']'; |
1640 |
@localsubfields; |
| 1550 |
# add subfields in $field not included in @record_to |
1641 |
next if ( $index_9_auth < 0 ); |
| 1551 |
my @restore= grep {$_->[0]!~/$exclude/} $field->subfields(); |
1642 |
|
| 1552 |
foreach my $subfield (@restore) { |
1643 |
# Removes the data if before the $9 |
| 1553 |
$field_to->add_subfields($subfield->[0] =>$subfield->[1]); |
1644 |
my $index = 0; |
| 1554 |
} |
1645 |
for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) { |
|
|
1646 |
if ( any { $subf->[1] eq $_ } @data_to_remove ) { |
| 1647 |
$debug && warn "found $subf->[0] " . $subf->[1]; |
| 1648 |
splice @localsubfields, $index, 1; |
| 1649 |
$index_9_auth--; |
| 1650 |
} |
| 1651 |
else { |
| 1652 |
$index++; |
| 1653 |
} |
| 1654 |
} |
| 1655 |
|
| 1656 |
#Get the next $9 subfield |
| 1657 |
my $nextindex_9 = |
| 1658 |
first_index { $_->[0] =~ /[12456789]/ } |
| 1659 |
@localsubfields[ $index_9_auth + 1 .. $#localsubfields ]; |
| 1660 |
|
| 1661 |
#Change the first tag if required |
| 1662 |
# That is : change the first tag ($a) to what it is in the biblio record |
| 1663 |
# Since some composed authorities will place the $a into $x or $y |
| 1664 |
|
| 1665 |
my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ]; |
| 1666 |
|
| 1667 |
# Changing the record_to first $a subfield code is quite a dangerous idea. |
| 1668 |
# But in order to clone the subfield structure and avoid the side effect affectation |
| 1669 |
# one would need to parse the whole subfield structure |
| 1670 |
# This would break performance a little more. |
| 1671 |
my $changesubfcode; |
| 1672 |
if ( |
| 1673 |
$changesubfcode = _process_subfcode_4_merge( |
| 1674 |
$tag, \@previous_subfields, |
| 1675 |
$MARCto, \@record_to, |
| 1676 |
$authtypecodeto |
| 1677 |
) |
| 1678 |
) |
| 1679 |
{ |
| 1680 |
my $index_subf_a = |
| 1681 |
first_index { $_->[0] eq "a" } @record_to; |
| 1682 |
$record_to[$index_subf_a]->[0] = $changesubfcode |
| 1683 |
if defined($changesubfcode); |
| 1684 |
} |
| 1685 |
|
| 1686 |
# Replace in local subfields the subfields related to recordfrom with data from record_to |
| 1687 |
|
| 1688 |
my @localrecord_to = @record_to; |
| 1689 |
@localrecord_to = ( [ 9, $mergeto ], @localrecord_to ); |
| 1690 |
my $length = |
| 1691 |
( $nextindex_9 > 0 ) |
| 1692 |
? $nextindex_9 + 1 |
| 1693 |
: $#localsubfields - $#previous_subfields + 1; |
| 1694 |
splice( |
| 1695 |
@localsubfields, $index_9_auth, |
| 1696 |
$length, @localrecord_to |
| 1697 |
); |
| 1698 |
|
| 1699 |
# very nice api for MARC::Record |
| 1700 |
# It seems that some elements localsubfields can be undefined so skip them |
| 1701 |
@newsubfields = |
| 1702 |
map { ( defined $_ ? @$_ : () ) } @localsubfields; |
| 1703 |
|
| 1704 |
#filter to subfields which are not in the subfield |
| 1705 |
my $field_to = MARC::Field->new( |
| 1706 |
( $tag_to ? $tag_to : $tag ), $field->indicator(1), |
| 1707 |
$field->indicator(2), @newsubfields |
| 1708 |
); |
| 1555 |
$marcrecord->delete_field($field); |
1709 |
$marcrecord->delete_field($field); |
| 1556 |
$marcrecord->insert_grouped_field($field_to); |
1710 |
$marcrecord->insert_fields_ordered($field_to); |
| 1557 |
$update=1; |
1711 |
|
|
|
1712 |
# if the first $a was change, restore it before next iteration |
| 1713 |
if ($changesubfcode) { |
| 1714 |
my $index_subf = |
| 1715 |
first_index { $_->[0] eq $changesubfcode } @record_to; |
| 1716 |
$record_to[$index_subf]->[0] = "a"; |
| 1558 |
} |
1717 |
} |
| 1559 |
}#for each tag |
1718 |
} #for each tag |
| 1560 |
}#foreach tagfield |
1719 |
} #foreach tagfield |
| 1561 |
my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ; |
1720 |
my ( $bibliotag, $bibliosubf ) = |
|
|
1721 |
GetMarcFromKohaField( "biblio.biblionumber", "" ); |
| 1562 |
my $biblionumber; |
1722 |
my $biblionumber; |
| 1563 |
if ($bibliotag<10){ |
1723 |
if ( $bibliotag < 10 ) { |
| 1564 |
$biblionumber=$marcrecord->field($bibliotag)->data; |
1724 |
$biblionumber = $marcrecord->field($bibliotag)->data; |
| 1565 |
} |
1725 |
} |
| 1566 |
else { |
1726 |
else { |
| 1567 |
$biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf); |
1727 |
$biblionumber = $marcrecord->subfield( $bibliotag, $bibliosubf ); |
| 1568 |
} |
1728 |
} |
| 1569 |
unless ($biblionumber){ |
1729 |
unless ($biblionumber) { |
| 1570 |
warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted; |
1730 |
warn "No biblionumber in : " |
|
|
1731 |
. $marcrecord->as_formatted; |
| 1571 |
next; |
1732 |
next; |
| 1572 |
} |
1733 |
} |
| 1573 |
if ($update==1){ |
1734 |
my $mod_ok = |
| 1574 |
&ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ; |
1735 |
&ModBiblio( $marcrecord, $biblionumber, |
| 1575 |
$counteditedbiblio++; |
1736 |
GetFrameworkCode($biblionumber) ); |
| 1576 |
warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG}); |
1737 |
push @editedbiblios, $biblionumber if $mod_ok; |
| 1577 |
} |
1738 |
} #foreach $marc |
| 1578 |
}#foreach $marc |
1739 |
DelAuthority($mergefrom) if ( $mergefrom != $mergeto ); |
| 1579 |
return $counteditedbiblio; |
1740 |
return @editedbiblios; |
| 1580 |
# now, find every other authority linked with this authority |
1741 |
} #sub |
| 1581 |
# now, find every other authority linked with this authority |
|
|
| 1582 |
# my $oConnection=C4::Context->Zconn("authorityserver"); |
| 1583 |
# my $query; |
| 1584 |
# # att 9210 Auth-Internal-authtype |
| 1585 |
# # att 9220 Auth-Internal-LN |
| 1586 |
# # ccl.properties to add for authorities |
| 1587 |
# $query= "= ".$mergefrom; |
| 1588 |
# my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); |
| 1589 |
# my $count=$oResult->size() if ($oResult); |
| 1590 |
# my @reccache; |
| 1591 |
# my $z=0; |
| 1592 |
# while ( $z<$count ) { |
| 1593 |
# my $rec; |
| 1594 |
# $rec=$oResult->record($z); |
| 1595 |
# my $marcdata = $rec->raw(); |
| 1596 |
# push @reccache, $marcdata; |
| 1597 |
# $z++; |
| 1598 |
# } |
| 1599 |
# $oResult->destroy(); |
| 1600 |
# foreach my $marc(@reccache){ |
| 1601 |
# my $update; |
| 1602 |
# my $marcrecord; |
| 1603 |
# $marcrecord = MARC::File::USMARC::decode($marc); |
| 1604 |
# foreach my $tagfield (@tags_using_authtype){ |
| 1605 |
# $tagfield=substr($tagfield,0,3); |
| 1606 |
# my @tags = $marcrecord->field($tagfield); |
| 1607 |
# foreach my $tag (@tags){ |
| 1608 |
# my $tagsubs=$tag->subfield("9"); |
| 1609 |
# #warn "$tagfield:$tagsubs:$mergefrom"; |
| 1610 |
# if ($tagsubs== $mergefrom) { |
| 1611 |
# $tag->update("9" =>$mergeto); |
| 1612 |
# foreach my $subfield (@record_to) { |
| 1613 |
# # warn "$subfield,$subfield->[0],$subfield->[1]"; |
| 1614 |
# $tag->update($subfield->[0] =>$subfield->[1]); |
| 1615 |
# }#for $subfield |
| 1616 |
# } |
| 1617 |
# $marcrecord->delete_field($tag); |
| 1618 |
# $marcrecord->add_fields($tag); |
| 1619 |
# $update=1; |
| 1620 |
# }#for each tag |
| 1621 |
# }#foreach tagfield |
| 1622 |
# my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ; |
| 1623 |
# if ($update==1){ |
| 1624 |
# &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ; |
| 1625 |
# } |
| 1626 |
# |
| 1627 |
# }#foreach $marc |
| 1628 |
}#sub |
| 1629 |
|
1742 |
|
| 1630 |
=head2 get_auth_type_location |
1743 |
=head2 get_auth_type_location |
| 1631 |
|
1744 |
|