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