|
Lines 507-513
sub BiblioAutoLink {
Link Here
|
| 507 |
|
507 |
|
| 508 |
=head2 LinkBibHeadingsToAuthorities |
508 |
=head2 LinkBibHeadingsToAuthorities |
| 509 |
|
509 |
|
| 510 |
my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]); |
510 |
my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $verbose]); |
| 511 |
|
511 |
|
| 512 |
Links bib headings to authority records by checking |
512 |
Links bib headings to authority records by checking |
| 513 |
each authority-controlled field in the C<MARC::Record> |
513 |
each authority-controlled field in the C<MARC::Record> |
|
Lines 529-534
sub LinkBibHeadingsToAuthorities {
Link Here
|
| 529 |
my $bib = shift; |
529 |
my $bib = shift; |
| 530 |
my $frameworkcode = shift; |
530 |
my $frameworkcode = shift; |
| 531 |
my $allowrelink = shift; |
531 |
my $allowrelink = shift; |
|
|
532 |
my $verbose = shift; |
| 532 |
my %results; |
533 |
my %results; |
| 533 |
if (!$bib) { |
534 |
if (!$bib) { |
| 534 |
carp 'LinkBibHeadingsToAuthorities called on undefined bib record'; |
535 |
carp 'LinkBibHeadingsToAuthorities called on undefined bib record'; |
|
Lines 549-648
sub LinkBibHeadingsToAuthorities {
Link Here
|
| 549 |
if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) ) |
550 |
if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) ) |
| 550 |
{ |
551 |
{ |
| 551 |
$results{'linked'}->{ $heading->display_form() }++; |
552 |
$results{'linked'}->{ $heading->display_form() }++; |
|
|
553 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose; |
| 552 |
next; |
554 |
next; |
| 553 |
} |
555 |
} |
| 554 |
|
556 |
|
| 555 |
my ( $authid, $fuzzy ) = $linker->get_link($heading); |
557 |
my ( $authid, $fuzzy, $status ) = $linker->get_link($heading); |
| 556 |
if ($authid) { |
558 |
if ($authid) { |
| 557 |
$results{ $fuzzy ? 'fuzzy' : 'linked' } |
559 |
$results{ $fuzzy ? 'fuzzy' : 'linked' } |
| 558 |
->{ $heading->display_form() }++; |
560 |
->{ $heading->display_form() }++; |
| 559 |
next if defined $current_link and $current_link == $authid; |
561 |
if(defined $current_link and $current_link == $authid) { |
|
|
562 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose; |
| 563 |
next; |
| 564 |
} |
| 560 |
|
565 |
|
| 561 |
$field->delete_subfield( code => '9' ) if defined $current_link; |
566 |
$field->delete_subfield( code => '9' ) if defined $current_link; |
| 562 |
$field->add_subfields( '9', $authid ); |
567 |
$field->add_subfields( '9', $authid ); |
| 563 |
$num_headings_changed++; |
568 |
$num_headings_changed++; |
|
|
569 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => $status || 'LOCAL_FOUND'}) if $verbose; |
| 564 |
} |
570 |
} |
| 565 |
else { |
571 |
else { |
| 566 |
if ( defined $current_link |
572 |
if ( defined $current_link |
| 567 |
&& (!$allowrelink || C4::Context->preference('LinkerKeepStale')) ) |
573 |
&& (!$allowrelink || C4::Context->preference('LinkerKeepStale')) ) |
| 568 |
{ |
574 |
{ |
| 569 |
$results{'fuzzy'}->{ $heading->display_form() }++; |
575 |
$results{'fuzzy'}->{ $heading->display_form() }++; |
|
|
576 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose; |
| 570 |
} |
577 |
} |
| 571 |
elsif ( C4::Context->preference('AutoCreateAuthorities') ) { |
578 |
elsif ( C4::Context->preference('AutoCreateAuthorities') ) { |
| 572 |
if ( _check_valid_auth_link( $current_link, $field ) ) { |
579 |
if ( _check_valid_auth_link( $current_link, $field ) ) { |
| 573 |
$results{'linked'}->{ $heading->display_form() }++; |
580 |
$results{'linked'}->{ $heading->display_form() }++; |
| 574 |
} |
581 |
} |
| 575 |
else { |
582 |
else { |
| 576 |
my $authtypedata = |
583 |
$authid = AddAuthorityFromHeading($heading, $field, $bib); |
| 577 |
C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() ); |
|
|
| 578 |
my $marcrecordauth = MARC::Record->new(); |
| 579 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
| 580 |
$marcrecordauth->leader(' nz a22 o 4500'); |
| 581 |
SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' ); |
| 582 |
} |
| 583 |
$field->delete_subfield( code => '9' ) |
| 584 |
if defined $current_link; |
| 585 |
my $authfield = |
| 586 |
MARC::Field->new( $authtypedata->{auth_tag_to_report}, |
| 587 |
'', '', "a" => "" . $field->subfield('a') ); |
| 588 |
map { |
| 589 |
$authfield->add_subfields( $_->[0] => $_->[1] ) |
| 590 |
if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" ) |
| 591 |
} $field->subfields(); |
| 592 |
$marcrecordauth->insert_fields_ordered($authfield); |
| 593 |
|
| 594 |
# bug 2317: ensure new authority knows it's using UTF-8; currently |
| 595 |
# only need to do this for MARC21, as MARC::Record->as_xml_record() handles |
| 596 |
# automatically for UNIMARC (by not transcoding) |
| 597 |
# FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record |
| 598 |
# use UTF-8, but as of 2008-08-05, did not want to introduce that kind |
| 599 |
# of change to a core API just before the 3.0 release. |
| 600 |
|
| 601 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
| 602 |
$marcrecordauth->insert_fields_ordered( |
| 603 |
MARC::Field->new( |
| 604 |
'667', '', '', |
| 605 |
'a' => "Machine generated authority record." |
| 606 |
) |
| 607 |
); |
| 608 |
my $cite = |
| 609 |
$bib->author() . ", " |
| 610 |
. $bib->title_proper() . ", " |
| 611 |
. $bib->publication_date() . " "; |
| 612 |
$cite =~ s/^[\s\,]*//; |
| 613 |
$cite =~ s/[\s\,]*$//; |
| 614 |
$cite = |
| 615 |
"Work cat.: (" |
| 616 |
. C4::Context->preference('MARCOrgCode') . ")" |
| 617 |
. $bib->subfield( '999', 'c' ) . ": " |
| 618 |
. $cite; |
| 619 |
$marcrecordauth->insert_fields_ordered( |
| 620 |
MARC::Field->new( '670', '', '', 'a' => $cite ) ); |
| 621 |
} |
| 622 |
|
| 623 |
# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted; |
| 624 |
|
584 |
|
| 625 |
$authid = |
|
|
| 626 |
C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '', |
| 627 |
$heading->auth_type() ); |
| 628 |
$field->add_subfields( '9', $authid ); |
585 |
$field->add_subfields( '9', $authid ); |
| 629 |
$num_headings_changed++; |
586 |
$num_headings_changed++; |
| 630 |
$linker->update_cache($heading, $authid); |
587 |
$linker->update_cache($heading, $authid); |
| 631 |
$results{'added'}->{ $heading->display_form() }++; |
588 |
$results{'added'}->{ $heading->display_form() }++; |
|
|
589 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'CREATED'}) if $verbose; |
| 632 |
} |
590 |
} |
| 633 |
} |
591 |
} |
| 634 |
elsif ( defined $current_link ) { |
592 |
elsif ( defined $current_link ) { |
| 635 |
if ( _check_valid_auth_link( $current_link, $field ) ) { |
593 |
if ( _check_valid_auth_link( $current_link, $field ) ) { |
| 636 |
$results{'linked'}->{ $heading->display_form() }++; |
594 |
$results{'linked'}->{ $heading->display_form() }++; |
|
|
595 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'UNCHANGED'}) if $verbose; |
| 637 |
} |
596 |
} |
| 638 |
else { |
597 |
else { |
| 639 |
$field->delete_subfield( code => '9' ); |
598 |
$field->delete_subfield( code => '9' ); |
| 640 |
$num_headings_changed++; |
599 |
$num_headings_changed++; |
| 641 |
$results{'unlinked'}->{ $heading->display_form() }++; |
600 |
$results{'unlinked'}->{ $heading->display_form() }++; |
|
|
601 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => undef, status => 'NONE_FOUND'}) if $verbose; |
| 642 |
} |
602 |
} |
| 643 |
} |
603 |
} |
| 644 |
else { |
604 |
else { |
| 645 |
$results{'unlinked'}->{ $heading->display_form() }++; |
605 |
$results{'unlinked'}->{ $heading->display_form() }++; |
|
|
606 |
push(@{$results{'details'}}, { tag => $field->tag(), authid => undef, status => 'NONE_FOUND'}) if $verbose; |
| 646 |
} |
607 |
} |
| 647 |
} |
608 |
} |
| 648 |
|
609 |
|
|
Lines 674-679
sub _check_valid_auth_link {
Link Here
|
| 674 |
return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading); |
635 |
return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading); |
| 675 |
} |
636 |
} |
| 676 |
|
637 |
|
|
|
638 |
=head2 AddAuthorityFromHeading |
| 639 |
|
| 640 |
my $authid = AddAuthorityFromHeading($heading, $field, [$bib]); |
| 641 |
|
| 642 |
Creates a new authority from an heading and its associated field. |
| 643 |
|
| 644 |
Returns the id of the newly created authority. |
| 645 |
|
| 646 |
=cut |
| 647 |
|
| 648 |
sub AddAuthorityFromHeading { |
| 649 |
my $heading = shift; |
| 650 |
my $field = shift; |
| 651 |
my $bib = shift; |
| 652 |
|
| 653 |
my $authtypedata = |
| 654 |
C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() ); |
| 655 |
my $marcrecordauth = MARC::Record->new(); |
| 656 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
| 657 |
$marcrecordauth->leader(' nz a22 o 4500'); |
| 658 |
SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' ); |
| 659 |
} |
| 660 |
my $authfield = |
| 661 |
MARC::Field->new( $authtypedata->{auth_tag_to_report}, |
| 662 |
'', '', "a" => "" . $field->subfield('a') ); |
| 663 |
map { |
| 664 |
$authfield->add_subfields( $_->[0] => $_->[1] ) |
| 665 |
if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" ) |
| 666 |
} $field->subfields(); |
| 667 |
$marcrecordauth->insert_fields_ordered($authfield); |
| 668 |
|
| 669 |
# bug 2317: ensure new authority knows it's using UTF-8; currently |
| 670 |
# only need to do this for MARC21, as MARC::Record->as_xml_record() handles |
| 671 |
# automatically for UNIMARC (by not transcoding) |
| 672 |
# FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record |
| 673 |
# use UTF-8, but as of 2008-08-05, did not want to introduce that kind |
| 674 |
# of change to a core API just before the 3.0 release. |
| 675 |
|
| 676 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
| 677 |
$marcrecordauth->insert_fields_ordered( |
| 678 |
MARC::Field->new( |
| 679 |
'667', '', '', |
| 680 |
'a' => "Machine generated authority record." |
| 681 |
) |
| 682 |
); |
| 683 |
if(defined $bib) { |
| 684 |
my $cite = |
| 685 |
$bib->author() . ", " |
| 686 |
. $bib->title_proper() . ", " |
| 687 |
. $bib->publication_date() . " "; |
| 688 |
$cite =~ s/^[\s\,]*//; |
| 689 |
$cite =~ s/[\s\,]*$//; |
| 690 |
$cite = |
| 691 |
"Work cat.: (" |
| 692 |
. C4::Context->preference('MARCOrgCode') . ")" |
| 693 |
. $bib->subfield( '999', 'c' ) . ": " |
| 694 |
. $cite; |
| 695 |
$marcrecordauth->insert_fields_ordered( |
| 696 |
MARC::Field->new( '670', '', '', 'a' => $cite ) ); |
| 697 |
} |
| 698 |
|
| 699 |
# Add correct informations in field 008 and 040 so the authority can be linked correctly in future linkings |
| 700 |
my $date=POSIX::strftime("%y%m%d",localtime); |
| 701 |
my @heading_use = qw(b b b); |
| 702 |
my $thesaurus = '|'; |
| 703 |
|
| 704 |
if ($heading->{'subject_added_entry'}) { |
| 705 |
$heading_use[1] = 'a'; |
| 706 |
# Thesaurus treatment |
| 707 |
my %thesaurus_conv = ('lcsh'=>'a','lcac'=>'b','mesh'=>'c','nal'=>'d','notspecified'=>'n','cash'=>'k','rvm'=>'v'); |
| 708 |
$thesaurus = 'z'; |
| 709 |
$thesaurus = $thesaurus_conv{$heading->{'thesaurus'}} if exists $thesaurus_conv{$heading->{'thesaurus'}}; |
| 710 |
if($thesaurus eq 'z') |
| 711 |
{ |
| 712 |
$marcrecordauth->insert_fields_ordered( |
| 713 |
MARC::Field->new('040','','','f'=>$heading->{'thesaurus'}) |
| 714 |
); |
| 715 |
} |
| 716 |
} |
| 717 |
if ($heading->{'series_added_entry'}) { |
| 718 |
$heading_use[2] = 'a'; |
| 719 |
} |
| 720 |
if (not $heading->{'subject_added_entry'} and not $heading->{'series_added_entry'}) { |
| 721 |
$heading_use[0] = 'a'; |
| 722 |
} |
| 723 |
|
| 724 |
# Get a valid default value for field 008 |
| 725 |
my $default_008 = C4::Context->preference('MARCAuthorityControlField008'); |
| 726 |
if(!$default_008 or length($default_008)<34) { |
| 727 |
$default_008 = '|| aca||aabn | a|a d'; |
| 728 |
} |
| 729 |
else { |
| 730 |
$default_008 = substr($default_008,0,34) |
| 731 |
} |
| 732 |
|
| 733 |
# Insert the date, thesaurus and heading_use into field 008 |
| 734 |
my $f008 = $date . $default_008; |
| 735 |
substr($f008, 11, 1) = $thesaurus; |
| 736 |
substr($f008, 14, 3) = join('', @heading_use); |
| 737 |
|
| 738 |
$marcrecordauth->insert_fields_ordered( |
| 739 |
MARC::Field->new('008',$f008) |
| 740 |
); |
| 741 |
} |
| 742 |
|
| 743 |
# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted; |
| 744 |
|
| 745 |
my $authid = C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '', $heading->auth_type() ); |
| 746 |
return $authid; |
| 747 |
} |
| 748 |
|
| 749 |
|
| 677 |
=head2 GetRecordValue |
750 |
=head2 GetRecordValue |
| 678 |
|
751 |
|
| 679 |
my $values = GetRecordValue($field, $record, $frameworkcode); |
752 |
my $values = GetRecordValue($field, $record, $frameworkcode); |