use MARC::File::USMARC;
use MARC::File::XML;
use POSIX qw(strftime);
+use Module::Load::Conditional qw(can_load);
use C4::Koha;
use C4::Dates qw/format_date/;
my $linker_module =
"C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
- eval { eval "require $linker_module"; };
- if ($@) {
+ unless ( can_load( modules => { $linker_module => undef } ) ) {
$linker_module = 'C4::Linker::Default';
- eval "require $linker_module";
- }
- if ($@) {
- return 0, 0;
+ unless ( can_load( modules => { $linker_module => undef } ) ) {
+ return 0, 0;
+ }
}
my $linker = $linker_module->new(
$results{'fuzzy'}->{ $heading->display_form() }++;
}
elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
- my $authtypedata =
- C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
- my $marcrecordauth = MARC::Record->new();
- if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
- $marcrecordauth->leader(' nz a22 o 4500');
- SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
+ if ( _check_valid_auth_link( $current_link, $field ) ) {
+ $results{'linked'}->{ $heading->display_form() }++;
}
- my $authfield =
- MARC::Field->new( $authtypedata->{auth_tag_to_report},
- '', '', "a" => "" . $field->subfield('a') );
- map {
- $authfield->add_subfields( $_->[0] => $_->[1] )
- if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
- } $field->subfields();
- $marcrecordauth->insert_fields_ordered($authfield);
+ else {
+ my $authtypedata =
+ C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
+ my $marcrecordauth = MARC::Record->new();
+ if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
+ $marcrecordauth->leader(' nz a22 o 4500');
+ SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
+ }
+ $field->delete_subfield( code => '9' )
+ if defined $current_link;
+ my $authfield =
+ MARC::Field->new( $authtypedata->{auth_tag_to_report},
+ '', '', "a" => "" . $field->subfield('a') );
+ map {
+ $authfield->add_subfields( $_->[0] => $_->[1] )
+ if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
+ } $field->subfields();
+ $marcrecordauth->insert_fields_ordered($authfield);
# bug 2317: ensure new authority knows it's using UTF-8; currently
# only need to do this for MARC21, as MARC::Record->as_xml_record() handles
# use UTF-8, but as of 2008-08-05, did not want to introduce that kind
# of change to a core API just before the 3.0 release.
- if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
- $marcrecordauth->insert_fields_ordered(
- MARC::Field->new(
- '667', '', '',
- 'a' => "Machine generated authority record."
- )
- );
- my $cite =
- $bib->author() . ", "
- . $bib->title_proper() . ", "
- . $bib->publication_date() . " ";
- $cite =~ s/^[\s\,]*//;
- $cite =~ s/[\s\,]*$//;
- $cite =
- "Work cat.: ("
- . C4::Context->preference('MARCOrgCode') . ")"
- . $bib->subfield( '999', 'c' ) . ": "
- . $cite;
- $marcrecordauth->insert_fields_ordered(
- MARC::Field->new( '670', '', '', 'a' => $cite ) );
- }
+ if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
+ $marcrecordauth->insert_fields_ordered(
+ MARC::Field->new(
+ '667', '', '',
+ 'a' => "Machine generated authority record."
+ )
+ );
+ my $cite =
+ $bib->author() . ", "
+ . $bib->title_proper() . ", "
+ . $bib->publication_date() . " ";
+ $cite =~ s/^[\s\,]*//;
+ $cite =~ s/[\s\,]*$//;
+ $cite =
+ "Work cat.: ("
+ . C4::Context->preference('MARCOrgCode') . ")"
+ . $bib->subfield( '999', 'c' ) . ": "
+ . $cite;
+ $marcrecordauth->insert_fields_ordered(
+ MARC::Field->new( '670', '', '', 'a' => $cite ) );
+ }
# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
- $authid =
- C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
- $heading->auth_type() );
- $field->add_subfields( '9', $authid );
- $num_headings_changed++;
- $results{'added'}->{ $heading->display_form() }++;
+ $authid =
+ C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
+ $heading->auth_type() );
+ $field->add_subfields( '9', $authid );
+ $num_headings_changed++;
+ $results{'added'}->{ $heading->display_form() }++;
+ }
}
elsif ( defined $current_link ) {
- $field->delete_subfield( code => '9' );
- $num_headings_changed++;
- $results{'unlinked'}->{ $heading->display_form() }++;
+ if ( _check_valid_auth_link( $current_link, $field ) ) {
+ $results{'linked'}->{ $heading->display_form() }++;
+ }
+ else {
+ $field->delete_subfield( code => '9' );
+ $num_headings_changed++;
+ $results{'unlinked'}->{ $heading->display_form() }++;
+ }
}
else {
$results{'unlinked'}->{ $heading->display_form() }++;
return $num_headings_changed, \%results;
}
+=head2 _check_valid_auth_link
+
+ if ( _check_valid_auth_link($authid, $field) ) {
+ ...
+ }
+
+Check whether the specified heading-auth link is valid without reference
+to Zebra/Solr. Ideally this code would be in C4::Heading, but that won't be
+possible until we have de-cycled C4::AuthoritiesMarc, so this is the
+safest place.
+
+=cut
+
+sub _check_valid_auth_link {
+ my ( $authid, $field ) = @_;
+
+ require C4::AuthoritiesMarc;
+
+ my $authorized_heading =
+ C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } );
+
+ return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
+}
+
=head2 GetRecordValue
my $values = GetRecordValue($field, $record, $frameworkcode);
sub GetISBDView {
my ( $biblionumber, $template ) = @_;
my $record = GetMarcBiblio($biblionumber, 1);
- return undef unless defined $record;
+ return unless defined $record;
my $itemtype = &GetFrameworkCode($biblionumber);
my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
my $tagslib = &GetMarcStructure( 1, $itemtype );
=cut
-sub GetUsedMarcStructure($) {
+sub GetUsedMarcStructure {
my $frameworkcode = shift || '';
my $query = qq/
SELECT *
($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
Returns the MARC fields & subfields mapped to the koha field
-for the given frameworkcode
+for the given frameworkcode or default framework if $frameworkcode is missing
=cut
sub GetMarcFromKohaField {
- my ( $kohafield, $frameworkcode ) = @_;
- return (0, undef) unless $kohafield and defined $frameworkcode;
+ my $kohafield = shift;
+ my $frameworkcode = shift || '';
+ return (0, undef) unless $kohafield;
my $relations = C4::Context->marcfromkohafield;
if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
return @$mf;
return $record;
} else {
- return undef;
+ return;
}
}
# if there is an authority link, build the links with an= subfield9
my $subfield9 = $field->subfield('9');
+ my $authoritylink;
if ($subfield9) {
my $linkvalue = $subfield9;
$linkvalue =~ s/(\(|\))//g;
@link_loop = ( { limit => 'an', 'link' => $linkvalue } );
+ $authoritylink = $linkvalue
}
# other subfields
}
}
- push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
+ push @marcsubjects, {
+ MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
+ authoritylink => $authoritylink,
+ };
}
return \@marcsubjects;
};
}
}
- push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
+ push @marcauthors, {
+ MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
+ authoritylink => $subfield9,
+ };
}
return \@marcauthors;
}
$sth2->finish;
}
$sth->finish;
- return undef;
+ return;
}
=head2 _koha_delete_biblioitems
$sth2->finish;
}
$sth->finish;
- return undef;
+ return;
}
=head1 UNEXPORTED FUNCTIONS