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