diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm
index b3c50706b2..c3b0db30aa 100644
--- a/C4/AuthoritiesMarc.pm
+++ b/C4/AuthoritiesMarc.pm
@@ -17,9 +17,8 @@ package C4::AuthoritiesMarc;
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
-#use warnings; FIXME - Bug 2505
+use warnings;
use C4::Context;
-use C4::Koha;
use MARC::Record;
use C4::Biblio;
use C4::Search;
@@ -41,7 +40,6 @@ BEGIN {
&GetAuthType
&GetAuthTypeCode
&GetAuthMARCFromKohaField
- &AUTHhtml2marc
&AddAuthority
&ModAuthority
@@ -98,15 +96,16 @@ sub GetAuthMARCFromKohaField {
=head2 SearchAuthorities
(\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or,
- $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby)
+ $excluding, $operator, $value, $offset,$length,$authtypecode,
+ $sortby[, $skipmetadata])
returns ref to array result and count of results returned
=cut
sub SearchAuthorities {
- my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) = @_;
-# warn "CALL : $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby";
+ my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby,$skipmetadata) = @_;
+ # warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby);
my $dbh=C4::Context->dbh;
if (C4::Context->preference('NoZebra')) {
@@ -225,23 +224,45 @@ sub SearchAuthorities {
for(my $i = 0 ; $i <= $#{$value} ; $i++)
{
if (@$value[$i]){
- if (@$tags[$i] eq "mainmainentry") {
-
- $attr =" \@attr 1=Heading-Main ";
-
- }elsif (@$tags[$i] eq "mainentry") {
- $attr =" \@attr 1=Heading ";
- }else{
- $attr =" \@attr 1=Any ";
+ if ( @$tags[$i] eq "mainmainentry" ) {
+ $attr = " \@attr 1=Heading-Main ";
}
- if (@$operator[$i] eq 'is') {
- $attr.=" \@attr 4=1 \@attr 5=100 ";##Phrase, No truncation,all of subfield field must match
- }elsif (@$operator[$i] eq "="){
- $attr.=" \@attr 4=107 "; #Number Exact match
- }elsif (@$operator[$i] eq "start"){
- $attr.=" \@attr 3=2 \@attr 4=1 \@attr 5=1 ";#Firstinfield Phrase, Right truncated
- } else {
- $attr .=" \@attr 5=1 \@attr 4=6 ";## Word list, right truncated, anywhere
+ elsif ( @$tags[$i] eq "mainentry" ) {
+ $attr = " \@attr 1=Heading ";
+ }
+ elsif ( @$tags[$i] eq "any" ) {
+ $attr = " \@attr 1=Any ";
+ }
+ elsif ( @$tags[$i] eq "match" ) {
+ $attr = " \@attr 1=Match ";
+ }
+ elsif ( @$tags[$i] eq "match-heading" ) {
+ $attr = " \@attr 1=Match-heading ";
+ }
+ elsif ( @$tags[$i] eq "see-from" ) {
+ $attr = " \@attr 1=Match-heading-see-from ";
+ }
+ elsif ( @$tags[$i] eq "thesaurus" ) {
+ $attr = " \@attr 1=Subject-heading-thesaurus ";
+ }
+ if ( @$operator[$i] eq 'is' ) {
+ $attr .= " \@attr 4=1 \@attr 5=100 "
+ ; ##Phrase, No truncation,all of subfield field must match
+ }
+ elsif ( @$operator[$i] eq "=" ) {
+ $attr .= " \@attr 4=107 "; #Number Exact match
+ }
+ elsif ( @$operator[$i] eq "start" ) {
+ $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 "
+ ; #Firstinfield Phrase, Right truncated
+ }
+ elsif ( @$operator[$i] eq "exact" ) {
+ $attr .= " \@attr 4=1 \@attr 5=100 \@attr 6=3 "
+ ; ##Phrase, No truncation,all of subfield field must match
+ }
+ else {
+ $attr .= " \@attr 5=1 \@attr 4=6 "
+ ; ## Word list, right truncated, anywhere
}
@$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value
$attr =$attr."\"".@$value[$i]."\"";
@@ -251,8 +272,8 @@ sub SearchAuthorities {
}#if value
}
##Add how many queries generated
- if ($query=~/\S+/){
- $query= $and x $attr_cnt . $query . $q2;
+ if (defined $query && $query=~/\S+/){
+ $query= $and x $attr_cnt . $query . (defined $q2 ? $q2 : '');
} else {
$query= $q2;
}
@@ -309,35 +330,42 @@ sub SearchAuthorities {
my $separator=C4::Context->preference('authoritysep');
$authrecord = MARC::File::USMARC::decode($marcdata);
my $authid=$authrecord->field('001')->data();
- my $summary=BuildSummary($authrecord,$authid,$authtypecode);
- my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
- my $sth = $dbh->prepare($query_auth_tag);
- $sth->execute($authtypecode);
- my $auth_tag_to_report = $sth->fetchrow;
- my $reported_tag;
- my $mainentry = $authrecord->field($auth_tag_to_report);
- if ($mainentry) {
- foreach ($mainentry->subfields()) {
- $reported_tag .='$'.$_->[0].$_->[1];
- }
- }
my %newline;
- $newline{summary} = $summary;
$newline{authid} = $authid;
- $newline{even} = $counter % 2;
- $newline{reported_tag} = $reported_tag;
+ if ( !$skipmetadata ) {
+ my $summary =
+ BuildSummary( $authrecord, $authid, $authtypecode );
+ my $query_auth_tag =
+"SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
+ my $sth = $dbh->prepare($query_auth_tag);
+ $sth->execute($authtypecode);
+ my $auth_tag_to_report = $sth->fetchrow;
+ my $reported_tag;
+ my $mainentry = $authrecord->field($auth_tag_to_report);
+ if ($mainentry) {
+
+ foreach ( $mainentry->subfields() ) {
+ $reported_tag .= '$' . $_->[0] . $_->[1];
+ }
+ }
+ $newline{summary} = $summary;
+ $newline{even} = $counter % 2;
+ $newline{reported_tag} = $reported_tag;
+ }
$counter++;
push @finalresult, \%newline;
}## while counter
- ###
- for (my $z=0; $z<@finalresult; $z++){
- my $count=CountUsage($finalresult[$z]{authid});
- $finalresult[$z]{used}=$count;
- }# all $z's
-
+ ###
+ if (! $skipmetadata) {
+ for (my $z=0; $z<@finalresult; $z++){
+ my $count=CountUsage($finalresult[$z]{authid});
+ $finalresult[$z]{used}=$count;
+ }# all $z's
+ }
+
}## if nbresult
NOLUCK:
- # $oAResult->destroy();
+ $oAResult->destroy();
# $oAuth[0]->destroy();
return (\@finalresult, $nbresults);
@@ -854,53 +882,6 @@ sub GetAuthType {
}
-sub AUTHhtml2marc {
- my ($rtags,$rsubfields,$rvalues,%indicators) = @_;
- my $dbh=C4::Context->dbh;
- my $prevtag = -1;
- my $record = MARC::Record->new();
-#---- TODO : the leader is missing
-
-# my %subfieldlist=();
- my $prevvalue; # if tag <10
- my $field; # if tag >=10
- for (my $i=0; $i< @$rtags; $i++) {
- # rebuild MARC::Record
- if (@$rtags[$i] ne $prevtag) {
- if ($prevtag < 10) {
- if ($prevvalue) {
- $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
- }
- } else {
- if ($field) {
- $record->add_fields($field);
- }
- }
- $indicators{@$rtags[$i]}.=' ';
- if (@$rtags[$i] <10) {
- $prevvalue= @$rvalues[$i];
- undef $field;
- } else {
- undef $prevvalue;
- $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
- }
- $prevtag = @$rtags[$i];
- } else {
- if (@$rtags[$i] <10) {
- $prevvalue=@$rvalues[$i];
- } else {
- if (length(@$rvalues[$i])>0) {
- $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
- }
- }
- $prevtag= @$rtags[$i];
- }
- }
- # the last has not been included inside the loop... do it now !
- $record->add_fields($field) if $field;
- return $record;
-}
-
=head2 FindDuplicateAuthority
$record= &FindDuplicateAuthority( $record, $authtypecode)
@@ -1015,14 +996,14 @@ sub BuildSummary{
$resultstring =~ s/\n/
/g;
$summary = $resultstring;
} else {
- my $heading;
- my $altheading;
- my $seealso;
- my $broaderterms;
- my $narrowerterms;
- my $see;
- my $seeheading;
- my $notes;
+ my $heading = '';
+ my $altheading = '';
+ my $seealso = '';
+ my $broaderterms = '';
+ my $narrowerterms = '';
+ my $see = '';
+ my $seeheading = '';
+ my $notes = '';
my @fields = $record->fields();
if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
# construct UNIMARC summary, that is quite different from MARC21 one
@@ -1471,7 +1452,7 @@ sub get_auth_type_location {
my $auth_type_code = @_ ? shift : '';
my ($tag, $subfield) = GetAuthMARCFromKohaField('auth_header.authtypecode', $auth_type_code);
- if (defined $tag and defined $subfield and $tag != 0 and $subfield != 0) {
+ if (defined $tag and defined $subfield and $tag != 0 and $subfield ne '' and $subfield ne ' ') {
return ($tag, $subfield);
} else {
if (C4::Context->preference('marcflavour') eq "MARC21") {
diff --git a/C4/Biblio.pm b/C4/Biblio.pm
index 50830ecdba..81da91be74 100644
--- a/C4/Biblio.pm
+++ b/C4/Biblio.pm
@@ -34,6 +34,7 @@ use C4::Dates qw/format_date/;
use C4::Log; # logaction
use C4::ClassSource;
use C4::Charset;
+use C4::Linker;
use vars qw($VERSION @ISA @EXPORT);
@@ -111,6 +112,7 @@ BEGIN {
# To link headings in a bib record
# to authority records.
push @EXPORT, qw(
+ &BiblioAutoLink
&LinkBibHeadingsToAuthorities
);
@@ -450,9 +452,42 @@ sub DelBiblio {
return;
}
+
+=head2 BiblioAutoLink
+
+ my $headings_linked = BiblioAutoLink($record, $frameworkcode)
+
+Automatically links headings in a bib record to authorities.
+
+=cut
+
+sub BiblioAutoLink {
+ my $record = shift;
+ my $frameworkcode = shift;
+ my ( $num_headings_changed, %results );
+
+ my $linker_module =
+ "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
+ eval { eval "require $linker_module"; };
+ if ($@) {
+ $linker_module = 'C4::Linker::Default';
+ eval "require $linker_module";
+ }
+ if ($@) {
+ return 0, 0;
+ }
+
+ my $linker = $linker_module->new(
+ { 'options' => C4::Context->preference("LinkerOptions") } );
+ my ( $headings_changed, undef ) =
+ LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
+ # By default we probably don't want to relink things when cataloging
+ return $headings_changed;
+}
+
=head2 LinkBibHeadingsToAuthorities
- my $headings_linked = LinkBibHeadingsToAuthorities($marc);
+ my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
Links bib headings to authority records by checking
each authority-controlled field in the C
@@ -460,9 +495,9 @@ object C<$marc>, looking for a matching authority record,
and setting the linking subfield $9 to the ID of that
authority record.
-If no matching authority exists, or if multiple
-authorities match, no $9 will be added, and any
-existing one inthe field will be deleted.
+If $allowrelink is false, existing authids will never be
+replaced, regardless of the values of LinkerKeepStale and
+LinkerRelink.
Returns the number of heading links changed in the
MARC record.
@@ -470,38 +505,112 @@ MARC record.
=cut
sub LinkBibHeadingsToAuthorities {
+ my $linker = shift;
+ my $bib = shift;
+ my $frameworkcode = shift;
+ my $allowrelink = shift;
+ my %results;
require C4::Heading;
- my $bib = shift;
+ require C4::AuthoritiesMarc;
+ $allowrelink = 1 unless defined $allowrelink;
my $num_headings_changed = 0;
foreach my $field ( $bib->fields() ) {
- my $heading = C4::Heading->new_from_bib_field($field);
+ my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
next unless defined $heading;
# check existing $9
my $current_link = $field->subfield('9');
- # look for matching authorities
- my $authorities = $heading->authorities();
+ if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
+ {
+ $results{'linked'}->{ $heading->display_form() }++;
+ next;
+ }
- # want only one exact match
- if ( $#{$authorities} == 0 ) {
- my $authority = MARC::Record->new_from_usmarc( $authorities->[0] );
- my $authid = $authority->field('001')->data();
- next if defined $current_link and $current_link eq $authid;
+ my ( $authid, $fuzzy ) = $linker->get_link($heading);
+ if ($authid) {
+ $results{ $fuzzy ? 'fuzzy' : 'linked' }
+ ->{ $heading->display_form() }++;
+ next if defined $current_link and $current_link == $authid;
$field->delete_subfield( code => '9' ) if defined $current_link;
$field->add_subfields( '9', $authid );
$num_headings_changed++;
- } else {
- if ( defined $current_link ) {
+ }
+ else {
+ if ( defined $current_link
+ && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
+ {
+ $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' );
+ }
+ 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
+# automatically for UNIMARC (by not transcoding)
+# FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
+# 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 ) );
+ }
+
+ # 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() }++;
+ }
+ elsif ( defined $current_link ) {
$field->delete_subfield( code => '9' );
$num_headings_changed++;
+ $results{'unlinked'}->{ $heading->display_form() }++;
+ }
+ else {
+ $results{'unlinked'}->{ $heading->display_form() }++;
}
}
}
- return $num_headings_changed;
+ return $num_headings_changed, \%results;
}
=head2 GetRecordValue
@@ -1891,6 +2000,7 @@ sub PrepHostMarcField {
my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
$marcflavour ||="MARC21";
+ require C4::Items;
my $hostrecord = GetMarcBiblio($hostbiblionumber);
my $item = C4::Items::GetItem($hostitemnumber);
diff --git a/C4/Heading.pm b/C4/Heading.pm
index d9e13d4223..98bb4a87fc 100644
--- a/C4/Heading.pm
+++ b/C4/Heading.pm
@@ -1,7 +1,7 @@
package C4::Heading;
# Copyright (C) 2008 LibLime
-#
+#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
@@ -18,11 +18,11 @@ package C4::Heading;
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
-#use warnings; FIXME - Bug 2505
+use warnings;
use MARC::Record;
use MARC::Field;
use C4::Context;
-use C4::Heading::MARC21;
+use Module::Load;
use Carp;
our $VERSION = 3.00;
@@ -34,11 +34,11 @@ C4::Heading
=head1 SYNOPSIS
use C4::Heading;
- my $heading = C4::Heading->new_from_bib_field($field);
+ my $heading = C4::Heading->new_from_bib_field($field, $frameworkcode);
my $thesaurus = $heading->thesaurus();
my $type = $heading->type();
- my $display_heading = $heading->display();
- my $search_string = $heading->search_string();
+ my $display_heading = $heading->display_form();
+ my $search_form = $heading->search_form();
=head1 DESCRIPTION
@@ -49,7 +49,7 @@ headings found in bibliographic and authority records.
=head2 new_from_bib_field
- my $heading = C4::Heading->new_from_bib_field($field[, $marc_flavour]);
+ my $heading = C4::Heading->new_from_bib_field($field, $frameworkcode, [, $marc_flavour]);
Given a C object containing a heading from a
bib record, create a C object.
@@ -64,24 +64,54 @@ is returned.
=cut
sub new_from_bib_field {
- my $class = shift;
- my $field = shift;
- my $marcflavour = @_ ? shift : C4::Context->preference('marcflavour');
+ my $class = shift;
+ my $field = shift;
+ my $frameworkcode = shift;
+ my $marcflavour = @_ ? shift : C4::Context->preference('marcflavour');
my $marc_handler = _marc_format_handler($marcflavour);
my $tag = $field->tag();
- return unless $marc_handler->valid_bib_heading_tag($tag);
+ return unless $marc_handler->valid_bib_heading_tag( $tag, $frameworkcode );
my $self = {};
-
- ($self->{'auth_type'}, $self->{'subject_added_entry'}, $self->{'series_added_entry'}, $self->{'main_entry'},
- $self->{'thesaurus'}, $self->{'search_form'}, $self->{'display_form'}) =
- $marc_handler->parse_heading($field);
+
+ $self->{'field'} = $field;
+ (
+ $self->{'auth_type'}, $self->{'thesaurus'},
+ $self->{'search_form'}, $self->{'display_form'},
+ $self->{'match_type'}
+ ) = $marc_handler->parse_heading($field);
bless $self, $class;
return $self;
}
+=head2 auth_type
+
+ my $auth_type = $heading->auth_type();
+
+Return the auth_type of the heading.
+
+=cut
+
+sub auth_type {
+ my $self = shift;
+ return $self->{'auth_type'};
+}
+
+=head2 field
+
+ my $field = $heading->field();
+
+Return the MARC::Field the heading is based on.
+
+=cut
+
+sub field {
+ my $self = shift;
+ return $self->{'field'};
+}
+
=head2 display_form
my $display = $heading->display_form();
@@ -95,24 +125,33 @@ sub display_form {
return $self->{'display_form'};
}
+=head2 search_form
+
+ my $search_form = $heading->search_form();
+
+Return the "canonical" search form of the heading.
+
+=cut
+
+sub search_form {
+ my $self = shift;
+ return $self->{'search_form'};
+}
+
=head2 authorities
- my $authorities = $heading->authorities;
+ my $authorities = $heading->authorities([$skipmetadata]);
Return a list of authority records for this
-heading.
+heading. If passed a true value for $skipmetadata,
+SearchAuthorities will return only authids.
=cut
sub authorities {
- my $self = shift;
- my $query = qq(Match-heading,do-not-truncate,ext="$self->{'search_form'}");
- $query .= $self->_query_limiters();
- require C4::Search;
- my ($error, $results, $total_hits) = C4::Search::SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
- if (defined $error) {
- carp "Error:$error from search $query";
- }
+ my $self = shift;
+ my $skipmetadata = shift;
+ my ( $results, $total ) = _search( $self, 'match-heading', $skipmetadata );
return $results;
}
@@ -127,37 +166,47 @@ that are a preferred form of the heading.
sub preferred_authorities {
my $self = shift;
- my $query = "Match-heading-see-from,do-not-truncate,ext='$self->{'search_form'}'";
- $query .= $self->_query_limiters();
- require C4::Search;
- my ($error, $results, $total_hits) = C4::Search::SimpleSearch( $query, undef, undef, [ "authorityserver" ] );
- if (defined $error) {
- carp "Error:$error from search $query";
- }
+ my $skipmetadata = shift || undef;
+ my ( $results, $total ) = _search( 'see-from', $skipmetadata );
return $results;
}
=head1 INTERNAL METHODS
-=head2 _query_limiters
+=head2 _search
=cut
-sub _query_limiters {
- my $self = shift;
+sub _search {
+ my $self = shift;
+ my $index = shift || undef;
+ my $skipmetadata = shift || undef;
+ my @marclist;
+ my @and_or;
+ my @excluding = [];
+ my @operator;
+ my @value;
- my $limiters = " AND at='$self->{'auth_type'}'";
- if ($self->{'subject_added_entry'}) {
- $limiters .= " AND Heading-use-subject-added-entry=a"; # FIXME -- is this properly in C4::Heading::MARC21?
- $limiters .= " AND Subject-heading-thesaurus=$self->{'thesaurus'}";
+ if ($index) {
+ push @marclist, $index;
+ push @and_or, 'and';
+ push @operator, $self->{'match_type'};
+ push @value, $self->{'search_form'};
}
- if ($self->{'series_added_entry'}) {
- $limiters .= " AND Heading-use-series-added-entry=a"; # FIXME -- is this properly in C4::Heading::MARC21?
- }
- if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
- $limiters .= " AND Heading-use-main-or-added-entry=a" # FIXME -- is this properly in C4::Heading::MARC21?
- }
- return $limiters;
+
+ # if ($self->{'thesaurus'}) {
+ # push @marclist, 'thesaurus';
+ # push @and_or, 'and';
+ # push @excluding, '';
+ # push @operator, 'is';
+ # push @value, $self->{'thesaurus'};
+ # }
+ require C4::AuthoritiesMarc;
+ return C4::AuthoritiesMarc::SearchAuthorities(
+ \@marclist, \@and_or, \@excluding, \@operator,
+ \@value, 0, 20, $self->{'auth_type'},
+ '', $skipmetadata
+ );
}
=head1 INTERNAL FUNCTIONS
@@ -170,14 +219,11 @@ depending on the selected MARC flavour.
=cut
sub _marc_format_handler {
- my $marcflavour = shift;
-
- if ($marcflavour eq 'UNIMARC') {
- return C4::Heading::UNIMARC->new();
- } else {
- return C4::Heading::MARC21->new();
- }
-
+ my $marcflavour = uc shift;
+ $marcflavour = 'MARC21' if ( $marcflavour eq 'NORMARC' );
+ my $pname = "C4::Heading::$marcflavour";
+ load $pname;
+ return $pname->new();
}
=head1 AUTHOR
diff --git a/C4/Heading/MARC21.pm b/C4/Heading/MARC21.pm
index 77cdac2d2f..d873e8d6c3 100644
--- a/C4/Heading/MARC21.pm
+++ b/C4/Heading/MARC21.pm
@@ -1,7 +1,7 @@
package C4::Heading::MARC21;
# Copyright (C) 2008 LibLime
-#
+#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
@@ -18,7 +18,7 @@ package C4::Heading::MARC21;
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
-#use warnings; FIXME - Bug 2505
+use warnings;
use MARC::Record;
use MARC::Field;
@@ -49,27 +49,69 @@ FIXME - this should be moved to a configuration file.
=cut
my $bib_heading_fields = {
- '100' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrst', main_entry => 1 },
- '110' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprst', main_entry => 1 },
- '111' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqst', main_entry => 1 },
- '130' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', main_entry => 1 },
+ '100' => {
+ auth_type => 'PERSO_NAME',
+ subfields => 'abcdfghjklmnopqrst',
+ main_entry => 1
+ },
+ '110' => {
+ auth_type => 'CORPO_NAME',
+ subfields => 'abcdfghklmnoprst',
+ main_entry => 1
+ },
+ '111' => {
+ auth_type => 'MEETI_NAME',
+ subfields => 'acdfghjklnpqst',
+ main_entry => 1
+ },
+ '130' => {
+ auth_type => 'UNIF_TITLE',
+ subfields => 'adfghklmnoprst',
+ main_entry => 1
+ },
'440' => { auth_type => 'UNIF_TITLE', subfields => 'anp', series => 1 },
- '600' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrstvxyz', subject => 1 },
- '610' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprstvxyz', subject => 1 },
- '611' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqstvxyz', subject => 1 },
- '630' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprstvxyz', subject => 1 },
- '648' => { auth_type => 'CHRON_TERM', subfields => 'avxyz', subject => 1 },
+ '600' => {
+ auth_type => 'PERSO_NAME',
+ subfields => 'abcdfghjklmnopqrstvxyz',
+ subject => 1
+ },
+ '610' => {
+ auth_type => 'CORPO_NAME',
+ subfields => 'abcdfghklmnoprstvxyz',
+ subject => 1
+ },
+ '611' => {
+ auth_type => 'MEETI_NAME',
+ subfields => 'acdfghjklnpqstvxyz',
+ subject => 1
+ },
+ '630' => {
+ auth_type => 'UNIF_TITLE',
+ subfields => 'adfghklmnoprstvxyz',
+ subject => 1
+ },
+ '648' => { auth_type => 'CHRON_TERM', subfields => 'avxyz', subject => 1 },
'650' => { auth_type => 'TOPIC_TERM', subfields => 'abvxyz', subject => 1 },
- '651' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz', subject => 1 },
- '655' => { auth_type => 'GENRE/FORM', subfields => 'avxyz', subject => 1 },
- '700' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrst' },
- '710' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprst' },
- '711' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqst' },
+ '651' => { auth_type => 'GEOGR_NAME', subfields => 'avxyz', subject => 1 },
+ '655' => { auth_type => 'GENRE/FORM', subfields => 'avxyz', subject => 1 },
+ '700' => { auth_type => 'PERSO_NAME', subfields => 'abcdfghjklmnopqrst' },
+ '710' => { auth_type => 'CORPO_NAME', subfields => 'abcdfghklmnoprst' },
+ '711' => { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst' },
'730' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst' },
- '800' => { auth_type => 'PERSO_NAME', subfields => 'abcdefghjklmnopqrst', series => 1 },
- '810' => { auth_type => 'CORPO_NAME', subfields => 'abcdefghklmnoprst', series => 1 },
- '811' => { auth_type => 'MEETI_NAME', subfields => 'acdefghjklnpqst', series => 1 },
- '830' => { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', series => 1 },
+ '800' => {
+ auth_type => 'PERSO_NAME',
+ subfields => 'abcdfghjklmnopqrst',
+ series => 1
+ },
+ '810' => {
+ auth_type => 'CORPO_NAME',
+ subfields => 'abcdfghklmnoprst',
+ series => 1
+ },
+ '811' =>
+ { auth_type => 'MEETI_NAME', subfields => 'acdfghjklnpqst', series => 1 },
+ '830' =>
+ { auth_type => 'UNIF_TITLE', subfields => 'adfghklmnoprst', series => 1 },
};
=head2 subdivisions
@@ -101,12 +143,14 @@ sub new {
=cut
sub valid_bib_heading_tag {
- my $self = shift;
- my $tag = shift;
+ my $self = shift;
+ my $tag = shift;
+ my $frameworkcode = shift;
- if (exists $bib_heading_fields->{$tag}) {
- return 1
- } else {
+ if ( exists $bib_heading_fields->{$tag} ) {
+ return 1;
+ }
+ else {
return 0;
}
@@ -117,21 +161,24 @@ sub valid_bib_heading_tag {
=cut
sub parse_heading {
- my $self = shift;
+ my $self = shift;
my $field = shift;
- my $tag = $field->tag;
+ my $tag = $field->tag;
my $field_info = $bib_heading_fields->{$tag};
my $auth_type = $field_info->{'auth_type'};
- my $subject = $field_info->{'subject'} ? 1 : 0;
- my $series = $field_info->{'series'} ? 1 : 0;
- my $main_entry = $field_info->{'main_entry'} ? 1 : 0;
- my $thesaurus = $subject ? _get_subject_thesaurus($field) : "lcsh"; # use 'lcsh' for names, UT, etc.
- my $search_heading = _get_search_heading($field, $field_info->{'subfields'});
- my $display_heading = _get_display_heading($field, $field_info->{'subfields'});
+ my $thesaurus =
+ $tag =~ m/6../
+ ? _get_subject_thesaurus($field)
+ : "lcsh"; # use 'lcsh' for names, UT, etc.
+ my $search_heading =
+ _get_search_heading( $field, $field_info->{'subfields'} );
+ my $display_heading =
+ _get_display_heading( $field, $field_info->{'subfields'} );
- return ($auth_type, $subject, $series, $main_entry, $thesaurus, $search_heading, $display_heading);
+ return ( $auth_type, $thesaurus, $search_heading, $display_heading,
+ 'exact' );
}
=head1 INTERNAL FUNCTIONS
@@ -142,24 +189,31 @@ sub parse_heading {
sub _get_subject_thesaurus {
my $field = shift;
- my $ind2 = $field->indicator(2);
+ my $ind2 = $field->indicator(2);
my $thesaurus = "notdefined";
- if ($ind2 eq '0') {
+ if ( $ind2 eq '0' ) {
$thesaurus = "lcsh";
- } elsif ($ind2 eq '1') {
+ }
+ elsif ( $ind2 eq '1' ) {
$thesaurus = "lcac";
- } elsif ($ind2 eq '2') {
+ }
+ elsif ( $ind2 eq '2' ) {
$thesaurus = "mesh";
- } elsif ($ind2 eq '3') {
+ }
+ elsif ( $ind2 eq '3' ) {
$thesaurus = "nal";
- } elsif ($ind2 eq '4') {
+ }
+ elsif ( $ind2 eq '4' ) {
$thesaurus = "notspecified";
- } elsif ($ind2 eq '5') {
+ }
+ elsif ( $ind2 eq '5' ) {
$thesaurus = "cash";
- } elsif ($ind2 eq '6') {
+ }
+ elsif ( $ind2 eq '6' ) {
$thesaurus = "rvm";
- } elsif ($ind2 eq '7') {
+ }
+ elsif ( $ind2 eq '7' ) {
my $sf2 = $field->subfield('2');
$thesaurus = $sf2 if defined($sf2);
}
@@ -172,24 +226,27 @@ sub _get_subject_thesaurus {
=cut
sub _get_search_heading {
- my $field = shift;
+ my $field = shift;
my $subfields = shift;
- my $heading = "";
+ my $heading = "";
my @subfields = $field->subfields();
- my $first = 1;
- for (my $i = 0; $i <= $#subfields; $i++) {
- my $code = $subfields[$i]->[0];
+ my $first = 1;
+ for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
+ my $code = $subfields[$i]->[0];
my $code_re = quotemeta $code;
- my $value = $subfields[$i]->[1];
+ my $value = $subfields[$i]->[1];
+ $value =~ s/[-,.:=;!%\/]$//;
next unless $subfields =~ qr/$code_re/;
if ($first) {
- $first = 0;
+ $first = 0;
$heading = $value;
- } else {
- if (exists $subdivisions{$code}) {
+ }
+ else {
+ if ( exists $subdivisions{$code} ) {
$heading .= " $subdivisions{$code} $value";
- } else {
+ }
+ else {
$heading .= " $value";
}
}
@@ -206,24 +263,26 @@ sub _get_search_heading {
=cut
sub _get_display_heading {
- my $field = shift;
+ my $field = shift;
my $subfields = shift;
- my $heading = "";
+ my $heading = "";
my @subfields = $field->subfields();
- my $first = 1;
- for (my $i = 0; $i <= $#subfields; $i++) {
- my $code = $subfields[$i]->[0];
+ my $first = 1;
+ for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
+ my $code = $subfields[$i]->[0];
my $code_re = quotemeta $code;
- my $value = $subfields[$i]->[1];
+ my $value = $subfields[$i]->[1];
next unless $subfields =~ qr/$code_re/;
if ($first) {
- $first = 0;
+ $first = 0;
$heading = $value;
- } else {
- if (exists $subdivisions{$code}) {
+ }
+ else {
+ if ( exists $subdivisions{$code} ) {
$heading .= "--$value";
- } else {
+ }
+ else {
$heading .= " $value";
}
}
@@ -231,6 +290,17 @@ sub _get_display_heading {
return $heading;
}
+# Additional limiters that we aren't using:
+# if ($self->{'subject_added_entry'}) {
+# $limiters .= " AND Heading-use-subject-added-entry=a";
+# }
+# if ($self->{'series_added_entry'}) {
+# $limiters .= " AND Heading-use-series-added-entry=a";
+# }
+# if (not $self->{'subject_added_entry'} and not $self->{'series_added_entry'}) {
+# $limiters .= " AND Heading-use-main-or-added-entry=a"
+# }
+
=head1 AUTHOR
Koha Development Team
diff --git a/C4/Heading/UNIMARC.pm b/C4/Heading/UNIMARC.pm
new file mode 100644
index 0000000000..78536b844a
--- /dev/null
+++ b/C4/Heading/UNIMARC.pm
@@ -0,0 +1,207 @@
+package C4::Heading::UNIMARC;
+
+# Copyright (C) 2011 C & P Bibliography Services
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use 5.010;
+use strict;
+use warnings;
+use MARC::Record;
+use MARC::Field;
+use C4::Context;
+
+our $VERSION = 3.00;
+
+=head1 NAME
+
+C4::Heading::UNIMARC
+
+=head1 SYNOPSIS
+
+use C4::Heading::UNIMARC;
+
+=head1 DESCRIPTION
+
+This is an internal helper class used by
+C to parse headings data from
+UNIMARC records. Object of this type
+do not carry data, instead, they only
+dispatch functions.
+
+=head1 DATA STRUCTURES
+
+FIXME - this should be moved to a configuration file.
+
+=head2 subdivisions
+
+=cut
+
+my %subdivisions = (
+ 'j' => 'formsubdiv',
+ 'x' => 'generalsubdiv',
+ 'y' => 'chronologicalsubdiv',
+ 'z' => 'geographicsubdiv',
+);
+
+my $bib_heading_fields;
+
+BEGIN {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT tagfield, authtypecode
+ FROM marc_subfield_structure
+ WHERE frameworkcode = '' AND authtypecode <> ''"
+ );
+ $sth->execute();
+ $bib_heading_fields = {};
+ while ( my ( $tag, $auth_type ) = $sth->fetchrow ) {
+ $bib_heading_fields->{$tag} = {
+ auth_type => $auth_type,
+ subfields => 'abcdefghjklmnopqrstvxyz',
+ };
+ }
+}
+
+=head1 METHODS
+
+=head2 new
+
+ my $marc_handler = C4::Heading::UNIMARC->new();
+
+=cut
+
+sub new {
+ my $class = shift;
+ return bless {}, $class;
+}
+
+=head2 valid_bib_heading_tag
+
+=cut
+
+sub valid_bib_heading_tag {
+ my ( $self, $tag ) = @_;
+ return $bib_heading_fields->{$tag};
+}
+
+=head2 parse_heading
+
+=cut
+
+sub parse_heading {
+ my ( $self, $field ) = @_;
+
+ my $tag = $field->tag;
+ my $field_info = $bib_heading_fields->{$tag};
+ my $auth_type = $field_info->{'auth_type'};
+ my $search_heading =
+ _get_search_heading( $field, $field_info->{'subfields'} );
+ my $display_heading =
+ _get_display_heading( $field, $field_info->{'subfields'} );
+
+ return ( $auth_type, undef, $search_heading, $display_heading, 'exact' );
+}
+
+=head1 INTERNAL FUNCTIONS
+
+=head2 _get_subject_thesaurus
+
+=cut
+
+sub _get_subject_thesaurus {
+ my $field = shift;
+
+ my $thesaurus = "notdefined";
+ my $sf2 = $field->subfield('2');
+ $thesaurus = $sf2 if defined($sf2);
+
+ return $thesaurus;
+}
+
+=head2 _get_search_heading
+
+=cut
+
+sub _get_search_heading {
+ my $field = shift;
+ my $subfields = shift;
+
+ my $heading = "";
+ my @subfields = $field->subfields();
+ my $first = 1;
+ for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
+ my $code = $subfields[$i]->[0];
+ my $code_re = quotemeta $code;
+ my $value = $subfields[$i]->[1];
+ $value =~ s/[-,.:=;!%\/]*$//;
+ next unless $subfields =~ qr/$code_re/;
+ if ($first) {
+ $first = 0;
+ $heading = $value;
+ }
+ else {
+ $heading .= " $value";
+ }
+ }
+
+ # remove characters that are part of CCL syntax
+ $heading =~ s/[)(=]//g;
+
+ return $heading;
+}
+
+=head2 _get_display_heading
+
+=cut
+
+sub _get_display_heading {
+ my $field = shift;
+ my $subfields = shift;
+
+ my $heading = "";
+ my @subfields = $field->subfields();
+ my $first = 1;
+ for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
+ my $code = $subfields[$i]->[0];
+ my $code_re = quotemeta $code;
+ my $value = $subfields[$i]->[1];
+ next unless $subfields =~ qr/$code_re/;
+ if ($first) {
+ $first = 0;
+ $heading = $value;
+ }
+ else {
+ if ( exists $subdivisions{$code} ) {
+ $heading .= "--$value";
+ }
+ else {
+ $heading .= " $value";
+ }
+ }
+ }
+ return $heading;
+}
+
+=head1 AUTHOR
+
+Koha Development Team
+
+Jared Camins-Esakov
+
+=cut
+
+1;
diff --git a/C4/Linker.pm b/C4/Linker.pm
new file mode 100644
index 0000000000..f030258380
--- /dev/null
+++ b/C4/Linker.pm
@@ -0,0 +1,123 @@
+package C4::Linker;
+
+# Copyright 2011 C & P Bibliography Services
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+=head1 NAME
+
+C4::Linker - Base class for linking authorities to bibliographic records
+
+=head1 SYNOPSIS
+
+ use C4::Linker (%params );
+
+=head1 DESCRIPTION
+
+Base class for C4::Linker::X. Subclasses need to provide the following methods
+
+B - return the authid for the authority that should be
+linked to the provided MARC::Field object, and a boolean to indicate whether
+the match is "fuzzy" (the semantics of "fuzzy" are up to the individual plugin).
+In order to handle authority limits, get_link should always end with:
+ return $self->SUPER::_handle_auth_limit($authid), $fuzzy;
+
+B - return a MARC::Field object with the heading flipped
+to the preferred form.
+
+=head1 FUNCTIONS
+
+=cut
+
+use strict;
+use warnings;
+use Carp;
+use C4::Context;
+
+use base qw(Class::Accessor);
+
+__PACKAGE__->mk_accessors(qw( ));
+
+sub new {
+ my $class = shift;
+ my $param = shift;
+
+ my $self = {};
+
+ while ( my ( $key, $value ) = each %$param ) {
+ if ( $key eq 'auth_limit' && $value ) {
+ my $dbh = C4::Context->dbh;
+ my $sql =
+ "SELECT authid FROM auth_header WHERE $value ORDER BY authid ASC";
+ my $sth = $dbh->prepare($sql);
+ $sth->execute();
+ while ( my ($authid) = $sth->fetchrow_array() ) {
+ push @{ $self->{'auths_to_link'} }, $authid;
+ }
+ }
+ elsif ( $key eq 'options' && $value ) {
+ foreach my $opt ( split( /\|/, $value ) ) {
+ $self->{$opt} = 1;
+ }
+ }
+ elsif ($value) {
+ $self->{$key} = $value;
+ }
+ }
+
+ bless $self, $class;
+ return $self;
+}
+
+=head2 _handle_auth_limit
+
+ return $self->SUPER::_handle_auth_limit($authid), $fuzzy;
+
+=back
+
+Function to be called by subclasses to handle authority record limits.
+
+=cut
+
+sub _handle_auth_limit {
+ my $self = shift;
+ my $authid = shift;
+
+ if ( defined $self->{'auths_to_link'} && defined $authid && !grep { $_ == $authid }
+ @{ $self->{'auths_to_link'} } )
+ {
+ undef $authid;
+ }
+ return $authid;
+}
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+C4::Linker::Default
+
+=head1 AUTHOR
+
+Jared Camins-Esakov, C & P Bibliography Services, Ejcamins@cpbibliography.comE
+
+=cut
+
+1;
+
+__END__
diff --git a/C4/Linker/Default.pm b/C4/Linker/Default.pm
new file mode 100644
index 0000000000..653dabd7c6
--- /dev/null
+++ b/C4/Linker/Default.pm
@@ -0,0 +1,97 @@
+package C4::Linker::Default;
+
+# Copyright 2011 C & P Bibliography Services
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use warnings;
+use Carp;
+use MARC::Field;
+use C4::Heading;
+
+use base qw(C4::Linker);
+
+sub get_link {
+ my $self = shift;
+ my $heading = shift;
+ my $behavior = shift || 'default';
+ my $search_form = $heading->search_form();
+ my $authid;
+ my $fuzzy = 0;
+
+ if ( $self->{'cache'}->{$search_form}->{'cached'} ) {
+ $authid = $self->{'cache'}->{$search_form}->{'authid'};
+ $fuzzy = $self->{'cache'}->{$search_form}->{'fuzzy'};
+ }
+ else {
+
+ # look for matching authorities
+ my $authorities = $heading->authorities(1); # $skipmetadata = true
+
+ if ( $behavior eq 'default' && $#{$authorities} == 0 ) {
+ $authid = $authorities->[0]->{'authid'};
+ }
+ elsif ( $behavior eq 'first' && $#{$authorities} >= 0 ) {
+ $authid = $authorities->[0]->{'authid'};
+ $fuzzy = $#{$authorities} > 0;
+ }
+ elsif ( $behavior eq 'last' && $#{$authorities} >= 0 ) {
+ $authid = $authorities->[ $#{$authorities} ]->{'authid'};
+ $fuzzy = $#{$authorities} > 0;
+ }
+
+ if ( !defined $authid && $self->{'broader_headings'} ) {
+ my $field = $heading->field();
+ my @subfields = $field->subfields();
+ if ( scalar @subfields > 1 ) {
+ pop @subfields;
+ $field->replace_with(
+ MARC::Field->new(
+ $field->tag,
+ $field->indicator(1),
+ $field->indicator(2),
+ map { $_[0] => $_[1] } @subfields
+ )
+ );
+ ( $authid, $fuzzy ) =
+ $self->get_link( C4::Heading->new_from_bib_field($field),
+ $behavior );
+ }
+ }
+
+ $self->{'cache'}->{$search_form}->{'cached'} = 1;
+ $self->{'cache'}->{$search_form}->{'authid'} = $authid;
+ $self->{'cache'}->{$search_form}->{'fuzzy'} = $fuzzy;
+ }
+ return $self->SUPER::_handle_auth_limit($authid), $fuzzy;
+}
+
+sub flip_heading {
+ my $self = shift;
+ my $heading = shift;
+
+ # TODO: implement
+}
+
+1;
+__END__
+
+=head1 NAME
+
+C4::Linker::Default - match only if there is a single matching auth
+
+=cut
diff --git a/C4/Linker/FirstMatch.pm b/C4/Linker/FirstMatch.pm
new file mode 100644
index 0000000000..ed03d7301a
--- /dev/null
+++ b/C4/Linker/FirstMatch.pm
@@ -0,0 +1,58 @@
+package C4::Linker::FirstMatch;
+
+# Copyright 2011 C & P Bibliography Services
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use warnings;
+use Carp;
+use C4::Heading;
+use C4::Linker::Default; # Use Default for flipping
+
+use base qw(C4::Linker);
+
+sub new {
+ my $class = shift;
+ my $param = shift;
+
+ my $self = $class->SUPER::new($param);
+ $self->{'default_linker'} = C4::Linker::Default->new($param);
+ bless $self, $class;
+ return $self;
+}
+
+sub get_link {
+ my $self = shift;
+ my $heading = shift;
+ return $self->{'default_linker'}->get_link( $heading, 'first' );
+}
+
+sub flip_heading {
+ my $self = shift;
+ my $heading = shift;
+
+ return $self->{'default_linker'}->flip($heading);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+C4::Linker::FirstMatch - match against the first authority record
+
+=cut
diff --git a/C4/Linker/LastMatch.pm b/C4/Linker/LastMatch.pm
new file mode 100644
index 0000000000..9357e951b0
--- /dev/null
+++ b/C4/Linker/LastMatch.pm
@@ -0,0 +1,58 @@
+package C4::Linker::LastMatch;
+
+# Copyright 2011 C & P Bibliography Services
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use warnings;
+use Carp;
+use C4::Heading;
+use C4::Linker::Default; # Use Default for flipping
+
+use base qw(C4::Linker);
+
+sub new {
+ my $class = shift;
+ my $param = shift;
+
+ my $self = $class->SUPER::new($param);
+ $self->{'default_linker'} = C4::Linker::Default->new($param);
+ bless $self, $class;
+ return $self;
+}
+
+sub get_link {
+ my $self = shift;
+ my $heading = shift;
+ return $self->{'default_linker'}->get_link( $heading, 'last' );
+}
+
+sub flip_heading {
+ my $self = shift;
+ my $heading = shift;
+
+ return $self->{'default_linker'}->flip($heading);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+C4::Linker::LastMatch - match against the last authority record
+
+=cut
diff --git a/C4/Search.pm b/C4/Search.pm
index 60635a3d23..04ce112a54 100644
--- a/C4/Search.pm
+++ b/C4/Search.pm
@@ -70,10 +70,8 @@ This module provides searching functions for Koha's bibliographic databases
&NZgetRecords
&AddSearchHistory
&GetDistinctValues
- &BiblioAddAuthorities
&enabled_staff_search_views
);
-#FIXME: i had to add BiblioAddAuthorities here because in Biblios.pm it caused circular dependencies (C4::Search uses C4::Biblio, and BiblioAddAuthorities uses SimpleSearch from C4::Search)
# make all your functions, whether exported or not;
@@ -2651,105 +2649,6 @@ sub z3950_search_args {
return $array;
}
-=head2 BiblioAddAuthorities
-
-( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode);
-
-this function finds the authorities linked to the biblio
- * search in the authority DB for the same authid (in $9 of the biblio)
- * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
- * search in the authority DB for the same values (exactly) (in all subfields of the biblio)
-OR adds a new authority record
-
-=over 2
-
-=item C
-
- * $record is the MARC record in question (marc blob)
- * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework)
-
-=item C