|
Lines 16-23
package C4::AuthoritiesMarc;
Link Here
|
| 16 |
# You should have received a copy of the GNU General Public License |
16 |
# You should have received a copy of the GNU General Public License |
| 17 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
17 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
| 18 |
|
18 |
|
| 19 |
use strict; |
19 |
use Modern::Perl; |
| 20 |
use warnings; |
20 |
use YAML; |
| 21 |
use C4::Context; |
21 |
use C4::Context; |
| 22 |
use MARC::Record; |
22 |
use MARC::Record; |
| 23 |
use C4::Biblio; |
23 |
use C4::Biblio; |
|
Lines 27-68
use C4::AuthoritiesMarc::UNIMARC;
Link Here
|
| 27 |
use C4::Charset; |
27 |
use C4::Charset; |
| 28 |
use C4::Log; |
28 |
use C4::Log; |
| 29 |
use Koha::Authority; |
29 |
use Koha::Authority; |
|
|
30 |
use Koha::Cache; |
| 30 |
|
31 |
|
| 31 |
use vars qw($VERSION @ISA @EXPORT); |
32 |
use vars qw($VERSION @ISA @EXPORT); |
| 32 |
|
33 |
|
| 33 |
BEGIN { |
34 |
BEGIN { |
| 34 |
# set the version for version checking |
35 |
# set the version for version checking |
| 35 |
$VERSION = 3.07.00.049; |
36 |
$VERSION = 3.07.00.049; |
| 36 |
|
37 |
|
| 37 |
require Exporter; |
38 |
require Exporter; |
| 38 |
@ISA = qw(Exporter); |
39 |
@ISA = qw(Exporter); |
| 39 |
@EXPORT = qw( |
40 |
@EXPORT = qw( |
| 40 |
&GetTagsLabels |
41 |
&GetTagsLabels |
| 41 |
&GetAuthType |
42 |
&GetAuthType |
| 42 |
&GetAuthTypeCode |
43 |
&GetAuthTypeCode |
| 43 |
&GetAuthMARCFromKohaField |
44 |
&GetAuthMARCFromKohaField |
| 44 |
|
45 |
|
| 45 |
&AddAuthority |
46 |
&AddAuthority |
| 46 |
&ModAuthority |
47 |
&ModAuthority |
| 47 |
&DelAuthority |
48 |
&DelAuthority |
| 48 |
&GetAuthority |
49 |
&GetAuthority |
| 49 |
&GetAuthorityXML |
50 |
&GetAuthorityXML |
| 50 |
|
51 |
&GetBibliosByAuthid |
| 51 |
&CountUsage |
52 |
|
| 52 |
&CountUsageChildren |
53 |
&CountUsage |
| 53 |
&SearchAuthorities |
54 |
&CountUsageChildren |
| 54 |
|
55 |
&SearchAuthorities |
|
|
56 |
|
| 55 |
&BuildSummary |
57 |
&BuildSummary |
| 56 |
&BuildAuthHierarchies |
58 |
&BuildAuthHierarchies |
| 57 |
&BuildAuthHierarchy |
59 |
&BuildAuthHierarchy |
| 58 |
&GenerateHierarchy |
60 |
&GenerateHierarchy |
| 59 |
|
61 |
|
| 60 |
&merge |
62 |
&merge |
| 61 |
&FindDuplicateAuthority |
63 |
&FindDuplicateAuthority |
| 62 |
|
64 |
|
| 63 |
&GuessAuthTypeCode |
65 |
&GuessAuthTypeCode |
| 64 |
&GuessAuthId |
66 |
&GuessAuthId |
| 65 |
); |
67 |
); |
| 66 |
} |
68 |
} |
| 67 |
|
69 |
|
| 68 |
|
70 |
|
|
Lines 91-97
sub GetAuthMARCFromKohaField {
Link Here
|
| 91 |
my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? "); |
93 |
my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? "); |
| 92 |
$sth->execute($kohafield,$authtypecode); |
94 |
$sth->execute($kohafield,$authtypecode); |
| 93 |
my ($tagfield,$tagsubfield) = $sth->fetchrow; |
95 |
my ($tagfield,$tagsubfield) = $sth->fetchrow; |
| 94 |
|
96 |
|
| 95 |
return ($tagfield,$tagsubfield); |
97 |
return ($tagfield,$tagsubfield); |
| 96 |
} |
98 |
} |
| 97 |
|
99 |
|
|
Lines 271-277
sub SearchAuthorities {
Link Here
|
| 271 |
# my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); |
273 |
# my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); |
| 272 |
# my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); |
274 |
# my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); |
| 273 |
while (($counter < $nbresults) && ($counter < ($offset + $length))) { |
275 |
while (($counter < $nbresults) && ($counter < ($offset + $length))) { |
| 274 |
|
276 |
|
| 275 |
##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES |
277 |
##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES |
| 276 |
my $rec=$oAResult->record($counter); |
278 |
my $rec=$oAResult->record($counter); |
| 277 |
my $separator=C4::Context->preference('AuthoritySeparator'); |
279 |
my $separator=C4::Context->preference('AuthoritySeparator'); |
|
Lines 349-355
sub CountUsage {
Link Here
|
| 349 |
### ZOOM search here |
351 |
### ZOOM search here |
| 350 |
my $query; |
352 |
my $query; |
| 351 |
$query= "an:".$authid; |
353 |
$query= "an:".$authid; |
| 352 |
my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10); |
354 |
my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10); |
| 353 |
if ($err) { |
355 |
if ($err) { |
| 354 |
warn "Error: $err from search $query"; |
356 |
warn "Error: $err from search $query"; |
| 355 |
$result = 0; |
357 |
$result = 0; |
|
Lines 414-431
sub GuessAuthTypeCode {
Link Here
|
| 414 |
'182'=>{authtypecode=>'CHRON_SUBD'}, |
416 |
'182'=>{authtypecode=>'CHRON_SUBD'}, |
| 415 |
'185'=>{authtypecode=>'FORM_SUBD'}, |
417 |
'185'=>{authtypecode=>'FORM_SUBD'}, |
| 416 |
}, |
418 |
}, |
| 417 |
#200 Personal name 700, 701, 702 4-- with embedded 700, 701, 702 600 |
419 |
#200 Personal name 700, 701, 702 4-- with embedded 700, 701, 702 600 |
| 418 |
# 604 with embedded 700, 701, 702 |
420 |
# 604 with embedded 700, 701, 702 |
| 419 |
#210 Corporate or meeting name 710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712 |
421 |
#210 Corporate or meeting name 710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712 |
| 420 |
#215 Territorial or geographic name 710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712 |
422 |
#215 Territorial or geographic name 710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712 |
| 421 |
#216 Trademark 716 [Reserved for future use] |
423 |
#216 Trademark 716 [Reserved for future use] |
| 422 |
#220 Family name 720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722 |
424 |
#220 Family name 720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722 |
| 423 |
#230 Title 500 4-- with embedded 500 605 |
425 |
#230 Title 500 4-- with embedded 500 605 |
| 424 |
#240 Name and title (embedded 200, 210, 215, or 220 and 230) 4-- with embedded 7-- and 500 7-- 604 with embedded 7-- and 500 500 |
426 |
#240 Name and title (embedded 200, 210, 215, or 220 and 230) 4-- with embedded 7-- and 500 7-- 604 with embedded 7-- and 500 500 |
| 425 |
#245 Name and collective title (embedded 200, 210, 215, or 220 and 235) 4-- with embedded 7-- and 501 604 with embedded 7-- and 501 7-- 501 |
427 |
#245 Name and collective title (embedded 200, 210, 215, or 220 and 235) 4-- with embedded 7-- and 501 604 with embedded 7-- and 501 7-- 501 |
| 426 |
#250 Topical subject 606 |
428 |
#250 Topical subject 606 |
| 427 |
#260 Place access 620 |
429 |
#260 Place access 620 |
| 428 |
#280 Form, genre or physical characteristics 608 |
430 |
#280 Form, genre or physical characteristics 608 |
| 429 |
# |
431 |
# |
| 430 |
# |
432 |
# |
| 431 |
# Could also be represented with : |
433 |
# Could also be represented with : |
|
Lines 593-599
sub AddAuthority {
Link Here
|
| 593 |
# pass the MARC::Record to this function, and it will create the records in the authority table |
595 |
# pass the MARC::Record to this function, and it will create the records in the authority table |
| 594 |
my ($record,$authid,$authtypecode) = @_; |
596 |
my ($record,$authid,$authtypecode) = @_; |
| 595 |
my $dbh=C4::Context->dbh; |
597 |
my $dbh=C4::Context->dbh; |
| 596 |
my $leader=' nz a22 o 4500';#Leader for incomplete MARC21 record |
598 |
my $leader=' nz a22 o 4500';#Leader for incomplete MARC21 record |
| 597 |
|
599 |
|
| 598 |
# if authid empty => true add, find a new authid number |
600 |
# if authid empty => true add, find a new authid number |
| 599 |
my $format; |
601 |
my $format; |
|
Lines 615-631
sub AddAuthority {
Link Here
|
| 615 |
} |
617 |
} |
| 616 |
|
618 |
|
| 617 |
SetUTF8Flag($record); |
619 |
SetUTF8Flag($record); |
| 618 |
if ($format eq "MARC21") { |
620 |
if ($format eq "MARC21") { |
| 619 |
if (!$record->leader) { |
621 |
if (!$record->leader) { |
| 620 |
$record->leader($leader); |
622 |
$record->leader($leader); |
| 621 |
} |
623 |
} |
| 622 |
if (!$record->field('003')) { |
624 |
if (!$record->field('003')) { |
| 623 |
$record->insert_fields_ordered( |
625 |
$record->insert_fields_ordered( |
| 624 |
MARC::Field->new('003',C4::Context->preference('MARCOrgCode')) |
626 |
MARC::Field->new('003',C4::Context->preference('MARCOrgCode')) |
| 625 |
); |
627 |
); |
| 626 |
} |
628 |
} |
| 627 |
my $date=POSIX::strftime("%y%m%d",localtime); |
629 |
my $date=POSIX::strftime("%y%m%d",localtime); |
| 628 |
if (!$record->field('008')) { |
630 |
if (!$record->field('008')) { |
| 629 |
# Get a valid default value for field 008 |
631 |
# Get a valid default value for field 008 |
| 630 |
my $default_008 = C4::Context->preference('MARCAuthorityControlField008'); |
632 |
my $default_008 = C4::Context->preference('MARCAuthorityControlField008'); |
| 631 |
if(!$default_008 or length($default_008)<34) { |
633 |
if(!$default_008 or length($default_008)<34) { |
|
Lines 636-668
sub AddAuthority {
Link Here
|
| 636 |
} |
638 |
} |
| 637 |
|
639 |
|
| 638 |
$record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) ); |
640 |
$record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) ); |
| 639 |
} |
641 |
} |
| 640 |
if (!$record->field('040')) { |
642 |
if (!$record->field('040')) { |
| 641 |
$record->insert_fields_ordered( |
643 |
$record->insert_fields_ordered( |
| 642 |
MARC::Field->new('040','','', |
644 |
MARC::Field->new('040','','', |
| 643 |
'a' => C4::Context->preference('MARCOrgCode'), |
645 |
'a' => C4::Context->preference('MARCOrgCode'), |
| 644 |
'c' => C4::Context->preference('MARCOrgCode') |
646 |
'c' => C4::Context->preference('MARCOrgCode') |
| 645 |
) |
647 |
) |
| 646 |
); |
648 |
); |
| 647 |
} |
649 |
} |
| 648 |
} |
650 |
} |
| 649 |
|
651 |
|
| 650 |
if ($format eq "UNIMARCAUTH") { |
652 |
if ($format eq "UNIMARCAUTH") { |
| 651 |
$record->leader(" nx j22 ") unless ($record->leader()); |
653 |
$record->leader(" nx j22 ") unless ($record->leader()); |
| 652 |
my $date=POSIX::strftime("%Y%m%d",localtime); |
654 |
my $date=POSIX::strftime("%Y%m%d",localtime); |
| 653 |
my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100'); |
655 |
my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100'); |
| 654 |
if (my $string=$record->subfield('100',"a")){ |
656 |
if (my $string=$record->subfield('100',"a")){ |
| 655 |
$string=~s/fre50/frey50/; |
657 |
$string=~s/fre50/frey50/; |
| 656 |
$record->field('100')->update('a'=>$string); |
658 |
$record->field('100')->update('a'=>$string); |
| 657 |
} |
659 |
} |
| 658 |
elsif ($record->field('100')){ |
660 |
elsif ($record->field('100')){ |
| 659 |
$record->field('100')->update('a'=>$date.$defaultfield100); |
661 |
$record->field('100')->update('a'=>$date.$defaultfield100); |
| 660 |
} else { |
662 |
} else { |
| 661 |
$record->append_fields( |
663 |
$record->append_fields( |
| 662 |
MARC::Field->new('100',' ',' ' |
664 |
MARC::Field->new('100',' ',' ' |
| 663 |
,'a'=>$date.$defaultfield100) |
665 |
,'a'=>$date.$defaultfield100) |
| 664 |
); |
666 |
); |
| 665 |
} |
667 |
} |
| 666 |
} |
668 |
} |
| 667 |
my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); |
669 |
my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); |
| 668 |
if (!$authid and $format eq "MARC21") { |
670 |
if (!$authid and $format eq "MARC21") { |
|
Lines 754-760
sub ModAuthority {
Link Here
|
| 754 |
} else { |
756 |
} else { |
| 755 |
# save a record in need_merge_authorities table |
757 |
# save a record in need_merge_authorities table |
| 756 |
my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ". |
758 |
my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ". |
| 757 |
"VALUES (?,?)"; |
759 |
"VALUES (?,?)"; |
| 758 |
$dbh->do($sqlinsert,undef,($authid,0)); |
760 |
$dbh->do($sqlinsert,undef,($authid,0)); |
| 759 |
} |
761 |
} |
| 760 |
logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); |
762 |
logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); |
|
Lines 1401-1406
sub _get_authid_subfield{
Link Here
|
| 1401 |
my ($field)=@_; |
1403 |
my ($field)=@_; |
| 1402 |
return $field->subfield('9')||$field->subfield('3'); |
1404 |
return $field->subfield('9')||$field->subfield('3'); |
| 1403 |
} |
1405 |
} |
|
|
1406 |
|
| 1407 |
|
| 1404 |
=head2 GetHeaderAuthority |
1408 |
=head2 GetHeaderAuthority |
| 1405 |
|
1409 |
|
| 1406 |
$ref= &GetHeaderAuthority( $authid) |
1410 |
$ref= &GetHeaderAuthority( $authid) |
|
Lines 1436-1565
sub AddAuthorityTrees{
Link Here
|
| 1436 |
return $rq->execute($trees,$authid); |
1440 |
return $rq->execute($trees,$authid); |
| 1437 |
} |
1441 |
} |
| 1438 |
|
1442 |
|
| 1439 |
=head2 merge |
|
|
| 1440 |
|
1443 |
|
| 1441 |
$ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) |
1444 |
=head2 auth_heading_def |
|
|
1445 |
|
| 1446 |
Returns a hashref of authorities' info by type: |
| 1442 |
|
1447 |
|
| 1443 |
Could add some feature : Migrating from a typecode to an other for instance. |
1448 |
=over |
| 1444 |
Then we should add some new parameter : bibliotargettag, authtargettag |
1449 |
|
|
|
1450 |
=item type |
| 1451 |
|
| 1452 |
The authority type, ie authtypecode in the DB. |
| 1453 |
|
| 1454 |
=item tag |
| 1455 |
|
| 1456 |
The heading tag of the authority, the one identifying the field to be copied |
| 1457 |
to the linked biblio record field. |
| 1458 |
|
| 1459 |
=item letters |
| 1460 |
|
| 1461 |
The subfields from the heading tag that are displayed in an authority editor |
| 1462 |
tab and are not hidden. Those subfields may be removed from biblio fields when |
| 1463 |
AuthBibliosClean syspref is enabled. |
| 1464 |
|
| 1465 |
=item bibtags |
| 1466 |
|
| 1467 |
Contains the tags (separated by |) from biblio records that are linked to the |
| 1468 |
authority type. |
| 1469 |
|
| 1470 |
=back |
| 1471 |
|
| 1472 |
For example: |
| 1473 |
|
| 1474 |
GEO: |
| 1475 |
type: GEO |
| 1476 |
tag: 151 |
| 1477 |
letters: 68abvxyz |
| 1478 |
bibtags: 691 |
| 1479 |
PERSO_NAME: |
| 1480 |
type: PERSO_NAME |
| 1481 |
tag: 100 |
| 1482 |
letters: 68abcdefghjklmnopqrstvxyz |
| 1483 |
THEME: |
| 1484 |
type: THEME |
| 1485 |
tag: 150 |
| 1486 |
letters: 68abvxyz |
| 1487 |
bibtags: 690|691 |
| 1445 |
|
1488 |
|
| 1446 |
=cut |
1489 |
=cut |
| 1447 |
|
1490 |
|
| 1448 |
sub merge { |
1491 |
sub auth_heading_def { |
| 1449 |
my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; |
1492 |
my $cache = Koha::Cache->get_instance(); |
| 1450 |
my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0); |
1493 |
my $key = "AuthHeading"; |
| 1451 |
my $dbh=C4::Context->dbh; |
1494 |
my $heading = $cache->get_from_cache($key); |
| 1452 |
my $authtypecodefrom = GetAuthTypeCode($mergefrom); |
1495 |
unless ($heading) { |
| 1453 |
my $authtypecodeto = GetAuthTypeCode($mergeto); |
1496 |
my $sth = C4::Context->dbh->prepare(" |
| 1454 |
# warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto "; |
1497 |
SELECT DISTINCT |
| 1455 |
# return if authority does not exist |
1498 |
auth_types.authtypecode AS type, |
| 1456 |
return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0; |
1499 |
auth_tag_to_report AS tag, |
| 1457 |
return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0; |
1500 |
GROUP_CONCAT(DISTINCT tagsubfield SEPARATOR '') AS letters, |
| 1458 |
# search the tag to report |
1501 |
(SELECT DISTINCT |
| 1459 |
my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); |
1502 |
GROUP_CONCAT(DISTINCT tagfield SEPARATOR '|') |
| 1460 |
$sth->execute($authtypecodefrom); |
1503 |
FROM |
| 1461 |
my ($auth_tag_to_report_from) = $sth->fetchrow; |
1504 |
marc_subfield_structure |
| 1462 |
$sth->execute($authtypecodeto); |
1505 |
WHERE |
| 1463 |
my ($auth_tag_to_report_to) = $sth->fetchrow; |
1506 |
authtypecode = auth_types.authtypecode |
| 1464 |
|
1507 |
) AS bibtags |
| 1465 |
my @record_to; |
1508 |
FROM |
| 1466 |
@record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to); |
1509 |
auth_types, auth_subfield_structure |
| 1467 |
my @record_from; |
1510 |
WHERE |
| 1468 |
@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from); |
1511 |
auth_types.authtypecode = auth_subfield_structure.authtypecode |
| 1469 |
|
1512 |
AND |
| 1470 |
my @reccache; |
1513 |
tagfield = auth_tag_to_report |
| 1471 |
# search all biblio tags using this authority. |
1514 |
AND |
| 1472 |
#Getting marcbiblios impacted by the change. |
1515 |
tab >= 0 |
| 1473 |
#zebra connection |
1516 |
AND |
| 1474 |
my $oConnection=C4::Context->Zconn("biblioserver",0); |
1517 |
hidden = 0 |
| 1475 |
# We used to use XML syntax here, but that no longer works. |
1518 |
GROUP BY |
| 1476 |
# Thankfully, we don't need it. |
1519 |
auth_types.authtypecode, auth_tag_to_report |
| 1477 |
my $query; |
1520 |
"); |
| 1478 |
$query= "an=".$mergefrom; |
1521 |
$sth->execute; |
| 1479 |
my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); |
1522 |
$heading = { map { $_->{type} => $_ } @{$sth->fetchall_arrayref({})} }; |
| 1480 |
my $count = 0; |
1523 |
$cache->set_in_cache($key, $heading); |
| 1481 |
if ($oResult) { |
|
|
| 1482 |
$count=$oResult->size(); |
| 1483 |
} |
1524 |
} |
| 1484 |
my $z=0; |
1525 |
return $heading; |
| 1485 |
while ( $z<$count ) { |
1526 |
} |
| 1486 |
my $marcrecordzebra = C4::Search::new_record_from_zebra( |
1527 |
|
| 1487 |
'biblioserver', |
1528 |
|
| 1488 |
$oResult->record($z)->raw() |
1529 |
=head2 GetBibliosByAuthid |
| 1489 |
); |
1530 |
|
| 1490 |
my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' ); |
1531 |
$records = GetBibliosByAuthid($authid) |
| 1491 |
my $i = ($biblionumbertagfield < 10) |
1532 |
|
| 1492 |
? $marcrecordzebra->field( $biblionumbertagfield )->data |
1533 |
returns an arrayref of biblio records linked to an authority identified by its |
| 1493 |
: $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield ); |
1534 |
authid. |
| 1494 |
my $marcrecorddb = GetMarcBiblio($i); |
1535 |
|
| 1495 |
push @reccache, $marcrecorddb; |
1536 |
=cut |
| 1496 |
$z++; |
1537 |
|
| 1497 |
} |
1538 |
sub GetBibliosByAuthid { |
| 1498 |
$oResult->destroy(); |
1539 |
my $authid = shift; |
| 1499 |
#warn scalar(@reccache)." biblios to update"; |
1540 |
my $conn = C4::Context->Zconn("biblioserver", 0); |
| 1500 |
# Get All candidate Tags for the change |
1541 |
my $result = $conn->search( |
| 1501 |
# (This will reduce the search scope in marc records). |
1542 |
ZOOM::Query::CCL2RPN->new( "an=$authid", $conn )); |
| 1502 |
$sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); |
1543 |
my @records; |
| 1503 |
$sth->execute($authtypecodefrom); |
1544 |
if ( my $count = $result && $result->size() ) { |
| 1504 |
my @tags_using_authtype; |
1545 |
for (my $z = 0; $z < $count; $z++ ) { |
| 1505 |
while (my ($tagfield) = $sth->fetchrow) { |
1546 |
my $raw = $result->record($z)->raw(); |
| 1506 |
push @tags_using_authtype,$tagfield ; |
1547 |
my $record = C4::Search::new_record_from_zebra('biblioserver', $raw); |
|
|
1548 |
# Take the biblio from the DB rather than Zebra |
| 1549 |
push @records, GetMarcBiblio(GetBiblionumber($record)); |
| 1550 |
} |
| 1507 |
} |
1551 |
} |
| 1508 |
my $tag_to=0; |
1552 |
$conn->destroy(); |
| 1509 |
if ($authtypecodeto ne $authtypecodefrom){ |
1553 |
return \@records; |
| 1510 |
# If many tags, take the first |
1554 |
} |
| 1511 |
$sth->execute($authtypecodeto); |
1555 |
|
| 1512 |
$tag_to=$sth->fetchrow; |
1556 |
|
| 1513 |
#warn $tag_to; |
1557 |
=head2 merge |
| 1514 |
} |
1558 |
|
| 1515 |
# BulkEdit marc records |
1559 |
$ref= &merge($from_authid, $from_record, $to_authid, $to_record); |
| 1516 |
# May be used as a template for a bulkedit field |
1560 |
|
| 1517 |
foreach my $marcrecord(@reccache){ |
1561 |
Merge two authorties, and modify linked biblio records. |
|
|
1562 |
|
| 1563 |
=cut |
| 1564 |
|
| 1565 |
sub merge { |
| 1566 |
|
| 1567 |
# First, build a hashref with two keys, from & to, giving info about |
| 1568 |
# authorities to be merged: |
| 1569 |
# from: |
| 1570 |
# id: 5391 |
| 1571 |
# tag: 151 |
| 1572 |
# type: GEO |
| 1573 |
# subf: => all MARC::Field heading subfields |
| 1574 |
# - |
| 1575 |
# - a |
| 1576 |
# - Afrique orientale britannique (1888-1920) |
| 1577 |
# letters: 68abvxyz |
| 1578 |
# bibtags: => biblio records tag containing this authority |
| 1579 |
# - 691 |
| 1580 |
# - 692 |
| 1581 |
# to: |
| 1582 |
my $heading = auth_heading_def(); |
| 1583 |
my $auth = { map { |
| 1584 |
my $a = {}; |
| 1585 |
my $id = $a->{id} = shift; |
| 1586 |
my $record = shift; |
| 1587 |
return "Invalid $_ MARC record " . Dump($record) if $record->fields() == 0; |
| 1588 |
my $type = $a->{type} = GetAuthTypeCode($id); |
| 1589 |
my $h = $heading->{$type}; |
| 1590 |
$a->{$_} = $h->{$_} for qw/tag letters bibtags/; |
| 1591 |
$a->{subf} = [ $record->field($a->{tag})->subfields() ]; |
| 1592 |
$_ => $a; |
| 1593 |
} qw/ from to / }; |
| 1594 |
|
| 1595 |
# Is is necessary to change biblio record tag since the target authority |
| 1596 |
# has another type? The first tag linked to target authority is choosed: |
| 1597 |
# this is disputable. |
| 1598 |
my $modified_tag = $auth->{to}->{type} ne $auth->{from}->{type} |
| 1599 |
? $auth->{to}->{bibtags}->[0] : 0; |
| 1600 |
my $auth_clean_biblios = C4::Context->preference('AuthCleanBiblios'); |
| 1601 |
|
| 1602 |
# Modify all biblios containing the 'from' authority |
| 1603 |
my $modified = 0; |
| 1604 |
foreach my $record ( @{GetBibliosByAuthid($auth->{from}->{id})} ) { |
| 1518 |
my $update = 0; |
1605 |
my $update = 0; |
| 1519 |
foreach my $tagfield (@tags_using_authtype){ |
1606 |
foreach my $field ($record->field($auth->{from}->{bibtags})) { |
| 1520 |
# warn "tagfield : $tagfield "; |
1607 |
# biblio is linked to authority with $9 subfield containing authid |
| 1521 |
foreach my $field ($marcrecord->field($tagfield)){ |
1608 |
next unless $auth->{from}->{id} == $field->subfield('9'); |
| 1522 |
# biblio is linked to authority with $9 subfield containing authid |
1609 |
my $field_to = MARC::Field->new( |
| 1523 |
my $auth_number=$field->subfield("9"); |
1610 |
$modified_tag || $field->tag, |
| 1524 |
my $tag=$field->tag(); |
1611 |
$field->indicator(1), $field->indicator(2), |
| 1525 |
if ($auth_number==$mergefrom) { |
1612 |
9 => $auth->{to}->{id} ); |
| 1526 |
my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto); |
1613 |
my $exclude = '9'; |
| 1527 |
my $exclude='9'; |
1614 |
foreach my $subfield (grep {$_->[0] ne '9'} @{$auth->{to}->{subf}}) { |
| 1528 |
foreach my $subfield (grep {$_->[0] ne '9'} @record_to) { |
1615 |
$field_to->add_subfields($subfield->[0] => $subfield->[1]); |
| 1529 |
$field_to->add_subfields($subfield->[0] =>$subfield->[1]); |
1616 |
$exclude .= $subfield->[0]; |
| 1530 |
$exclude.= $subfield->[0]; |
1617 |
} |
| 1531 |
} |
1618 |
$exclude .= $auth->{to}->{letters} if $auth_clean_biblios; |
| 1532 |
$exclude='['.$exclude.']'; |
1619 |
$exclude = "[$exclude]"; |
| 1533 |
# add subfields in $field not included in @record_to |
1620 |
# Add subfields that are in the biblio field but are not in |
| 1534 |
my @restore= grep {$_->[0]!~/$exclude/} $field->subfields(); |
1621 |
# authority heading |
| 1535 |
foreach my $subfield (@restore) { |
1622 |
my @restore = grep { $_->[0] !~ /$exclude/ } $field->subfields(); |
| 1536 |
$field_to->add_subfields($subfield->[0] =>$subfield->[1]); |
1623 |
foreach my $subfield (@restore) { |
| 1537 |
} |
1624 |
$field_to->add_subfields($subfield->[0] => $subfield->[1]); |
| 1538 |
$marcrecord->delete_field($field); |
1625 |
} |
| 1539 |
$marcrecord->insert_grouped_field($field_to); |
1626 |
$field->replace_with($field_to); |
| 1540 |
$update=1; |
1627 |
$update = 1; |
| 1541 |
} |
|
|
| 1542 |
}#for each tag |
| 1543 |
}#foreach tagfield |
| 1544 |
my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ; |
| 1545 |
my $biblionumber; |
| 1546 |
if ($bibliotag<10){ |
| 1547 |
$biblionumber=$marcrecord->field($bibliotag)->data; |
| 1548 |
} |
1628 |
} |
| 1549 |
else { |
1629 |
next unless $update; |
| 1550 |
$biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf); |
1630 |
if ( my $biblionumber = GetBiblionumber($record) ) { |
|
|
1631 |
ModBiblio($record, $biblionumber, GetFrameworkCode($biblionumber)); |
| 1632 |
$modified++; |
| 1633 |
warn $modified if ($modified % 10) and $ENV{DEBUG}; |
| 1551 |
} |
1634 |
} |
| 1552 |
unless ($biblionumber){ |
1635 |
else { |
| 1553 |
warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted; |
1636 |
warn "No biblionumber in: " . $record->as_formatted; |
| 1554 |
next; |
|
|
| 1555 |
} |
1637 |
} |
| 1556 |
if ($update==1){ |
1638 |
} |
| 1557 |
&ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ; |
1639 |
return $modified; |
| 1558 |
$counteditedbiblio++; |
|
|
| 1559 |
warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG}); |
| 1560 |
} |
| 1561 |
}#foreach $marc |
| 1562 |
return $counteditedbiblio; |
| 1563 |
# now, find every other authority linked with this authority |
1640 |
# now, find every other authority linked with this authority |
| 1564 |
# now, find every other authority linked with this authority |
1641 |
# now, find every other authority linked with this authority |
| 1565 |
# my $oConnection=C4::Context->Zconn("authorityserver"); |
1642 |
# my $oConnection=C4::Context->Zconn("authorityserver"); |
|
Lines 1567-1573
sub merge {
Link Here
|
| 1567 |
# # att 9210 Auth-Internal-authtype |
1644 |
# # att 9210 Auth-Internal-authtype |
| 1568 |
# # att 9220 Auth-Internal-LN |
1645 |
# # att 9220 Auth-Internal-LN |
| 1569 |
# # ccl.properties to add for authorities |
1646 |
# # ccl.properties to add for authorities |
| 1570 |
# $query= "= ".$mergefrom; |
1647 |
# $query= "= ".$auth->{from}->{id}; |
| 1571 |
# my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); |
1648 |
# my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); |
| 1572 |
# my $count=$oResult->size() if ($oResult); |
1649 |
# my $count=$oResult->size() if ($oResult); |
| 1573 |
# my @reccache; |
1650 |
# my @reccache; |
|
Lines 1589-1597
sub merge {
Link Here
|
| 1589 |
# my @tags = $marcrecord->field($tagfield); |
1666 |
# my @tags = $marcrecord->field($tagfield); |
| 1590 |
# foreach my $tag (@tags){ |
1667 |
# foreach my $tag (@tags){ |
| 1591 |
# my $tagsubs=$tag->subfield("9"); |
1668 |
# my $tagsubs=$tag->subfield("9"); |
| 1592 |
# #warn "$tagfield:$tagsubs:$mergefrom"; |
1669 |
# #warn "$tagfield:$tagsubs:$auth->{from}->{id}"; |
| 1593 |
# if ($tagsubs== $mergefrom) { |
1670 |
# if ($tagsubs== $auth->{from}->{id}) { |
| 1594 |
# $tag->update("9" =>$mergeto); |
1671 |
# $tag->update("9" =>$auth->{to}->{id}); |
| 1595 |
# foreach my $subfield (@record_to) { |
1672 |
# foreach my $subfield (@record_to) { |
| 1596 |
# # warn "$subfield,$subfield->[0],$subfield->[1]"; |
1673 |
# # warn "$subfield,$subfield->[0],$subfield->[1]"; |
| 1597 |
# $tag->update($subfield->[0] =>$subfield->[1]); |
1674 |
# $tag->update($subfield->[0] =>$subfield->[1]); |