|
Lines 567-587
sub LinkBibHeadingsToAuthorities {
Link Here
|
| 567 |
$results{'fuzzy'}->{ $heading->display_form() }++; |
567 |
$results{'fuzzy'}->{ $heading->display_form() }++; |
| 568 |
} |
568 |
} |
| 569 |
elsif ( C4::Context->preference('AutoCreateAuthorities') ) { |
569 |
elsif ( C4::Context->preference('AutoCreateAuthorities') ) { |
| 570 |
my $authtypedata = |
570 |
if ( _check_valid_auth_link( $current_link, $field ) ) { |
| 571 |
C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() ); |
571 |
$results{'linked'}->{ $heading->display_form() }++; |
| 572 |
my $marcrecordauth = MARC::Record->new(); |
|
|
| 573 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
| 574 |
$marcrecordauth->leader(' nz a22 o 4500'); |
| 575 |
SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' ); |
| 576 |
} |
572 |
} |
| 577 |
my $authfield = |
573 |
else { |
| 578 |
MARC::Field->new( $authtypedata->{auth_tag_to_report}, |
574 |
my $authtypedata = |
| 579 |
'', '', "a" => "" . $field->subfield('a') ); |
575 |
C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() ); |
| 580 |
map { |
576 |
my $marcrecordauth = MARC::Record->new(); |
| 581 |
$authfield->add_subfields( $_->[0] => $_->[1] ) |
577 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
| 582 |
if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" ) |
578 |
$marcrecordauth->leader(' nz a22 o 4500'); |
| 583 |
} $field->subfields(); |
579 |
SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' ); |
| 584 |
$marcrecordauth->insert_fields_ordered($authfield); |
580 |
} |
|
|
581 |
$field->delete_subfield( code => '9' ) |
| 582 |
if defined $current_link; |
| 583 |
my $authfield = |
| 584 |
MARC::Field->new( $authtypedata->{auth_tag_to_report}, |
| 585 |
'', '', "a" => "" . $field->subfield('a') ); |
| 586 |
map { |
| 587 |
$authfield->add_subfields( $_->[0] => $_->[1] ) |
| 588 |
if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" ) |
| 589 |
} $field->subfields(); |
| 590 |
$marcrecordauth->insert_fields_ordered($authfield); |
| 585 |
|
591 |
|
| 586 |
# bug 2317: ensure new authority knows it's using UTF-8; currently |
592 |
# bug 2317: ensure new authority knows it's using UTF-8; currently |
| 587 |
# only need to do this for MARC21, as MARC::Record->as_xml_record() handles |
593 |
# only need to do this for MARC21, as MARC::Record->as_xml_record() handles |
|
Lines 590-630
sub LinkBibHeadingsToAuthorities {
Link Here
|
| 590 |
# use UTF-8, but as of 2008-08-05, did not want to introduce that kind |
596 |
# use UTF-8, but as of 2008-08-05, did not want to introduce that kind |
| 591 |
# of change to a core API just before the 3.0 release. |
597 |
# of change to a core API just before the 3.0 release. |
| 592 |
|
598 |
|
| 593 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
599 |
if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { |
| 594 |
$marcrecordauth->insert_fields_ordered( |
600 |
$marcrecordauth->insert_fields_ordered( |
| 595 |
MARC::Field->new( |
601 |
MARC::Field->new( |
| 596 |
'667', '', '', |
602 |
'667', '', '', |
| 597 |
'a' => "Machine generated authority record." |
603 |
'a' => "Machine generated authority record." |
| 598 |
) |
604 |
) |
| 599 |
); |
605 |
); |
| 600 |
my $cite = |
606 |
my $cite = |
| 601 |
$bib->author() . ", " |
607 |
$bib->author() . ", " |
| 602 |
. $bib->title_proper() . ", " |
608 |
. $bib->title_proper() . ", " |
| 603 |
. $bib->publication_date() . " "; |
609 |
. $bib->publication_date() . " "; |
| 604 |
$cite =~ s/^[\s\,]*//; |
610 |
$cite =~ s/^[\s\,]*//; |
| 605 |
$cite =~ s/[\s\,]*$//; |
611 |
$cite =~ s/[\s\,]*$//; |
| 606 |
$cite = |
612 |
$cite = |
| 607 |
"Work cat.: (" |
613 |
"Work cat.: (" |
| 608 |
. C4::Context->preference('MARCOrgCode') . ")" |
614 |
. C4::Context->preference('MARCOrgCode') . ")" |
| 609 |
. $bib->subfield( '999', 'c' ) . ": " |
615 |
. $bib->subfield( '999', 'c' ) . ": " |
| 610 |
. $cite; |
616 |
. $cite; |
| 611 |
$marcrecordauth->insert_fields_ordered( |
617 |
$marcrecordauth->insert_fields_ordered( |
| 612 |
MARC::Field->new( '670', '', '', 'a' => $cite ) ); |
618 |
MARC::Field->new( '670', '', '', 'a' => $cite ) ); |
| 613 |
} |
619 |
} |
| 614 |
|
620 |
|
| 615 |
# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted; |
621 |
# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted; |
| 616 |
|
622 |
|
| 617 |
$authid = |
623 |
$authid = |
| 618 |
C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '', |
624 |
C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '', |
| 619 |
$heading->auth_type() ); |
625 |
$heading->auth_type() ); |
| 620 |
$field->add_subfields( '9', $authid ); |
626 |
$field->add_subfields( '9', $authid ); |
| 621 |
$num_headings_changed++; |
627 |
$num_headings_changed++; |
| 622 |
$results{'added'}->{ $heading->display_form() }++; |
628 |
$results{'added'}->{ $heading->display_form() }++; |
|
|
629 |
} |
| 623 |
} |
630 |
} |
| 624 |
elsif ( defined $current_link ) { |
631 |
elsif ( defined $current_link ) { |
| 625 |
$field->delete_subfield( code => '9' ); |
632 |
if ( _check_valid_auth_link( $current_link, $field ) ) { |
| 626 |
$num_headings_changed++; |
633 |
$results{'linked'}->{ $heading->display_form() }++; |
| 627 |
$results{'unlinked'}->{ $heading->display_form() }++; |
634 |
} |
|
|
635 |
else { |
| 636 |
$field->delete_subfield( code => '9' ); |
| 637 |
$num_headings_changed++; |
| 638 |
$results{'unlinked'}->{ $heading->display_form() }++; |
| 639 |
} |
| 628 |
} |
640 |
} |
| 629 |
else { |
641 |
else { |
| 630 |
$results{'unlinked'}->{ $heading->display_form() }++; |
642 |
$results{'unlinked'}->{ $heading->display_form() }++; |
|
Lines 635-640
sub LinkBibHeadingsToAuthorities {
Link Here
|
| 635 |
return $num_headings_changed, \%results; |
647 |
return $num_headings_changed, \%results; |
| 636 |
} |
648 |
} |
| 637 |
|
649 |
|
|
|
650 |
=head2 _check_valid_auth_link |
| 651 |
|
| 652 |
if ( _check_valid_auth_link($authid, $field) ) { |
| 653 |
... |
| 654 |
} |
| 655 |
|
| 656 |
Check whether the specified heading-auth link is valid without reference |
| 657 |
to Zebra/Solr. Ideally this code would be in C4::Heading, but that won't be |
| 658 |
possible until we have de-cycled C4::AuthoritiesMarc, so this is the |
| 659 |
safest place. |
| 660 |
|
| 661 |
=cut |
| 662 |
|
| 663 |
sub _check_valid_auth_link { |
| 664 |
my ( $authid, $field ) = @_; |
| 665 |
|
| 666 |
require C4::AuthoritiesMarc; |
| 667 |
|
| 668 |
my $authorized_heading = |
| 669 |
C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ); |
| 670 |
|
| 671 |
return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading); |
| 672 |
} |
| 673 |
|
| 638 |
=head2 GetRecordValue |
674 |
=head2 GetRecordValue |
| 639 |
|
675 |
|
| 640 |
my $values = GetRecordValue($field, $record, $frameworkcode); |
676 |
my $values = GetRecordValue($field, $record, $frameworkcode); |
| 641 |
- |
|
|