@@ -, +, @@
which consults not just the main entry but also See-from and See-also-from
headings.
in the cataloging module. As Owen pointed out while testing the patch,
though, longtime users of Koha will not be expecting that. In keeping with
the principles of least surprise and maximum configurability, a new syspref,
CatalogModuleRelink makes it possible to disable authority relinking in the
cataloging module only (i.e. leaving it enabled for future runs of
link_bibs_to_authorities.pl). Note that though the default behavior matches
the current behavior of Koha, it does not match the intended behavior.
Libraries that want the intended behavior rather than the current behavior
will need to adjust the CatalogModuleRelink syspref.
--auth-limit Only process those headings that match the authorities
matching the user-specified WHERE clause.
--bib-limit Only process those bib records that match the
user-specified WHERE clause.
--commit Commit the results to the database after every N records
are processed.
--link-report Display a report of all the headings that were processed.
an exact match to one and only one authority record; if the 'broader_headings'
option is enabled, it will try to link to headings to authority records for
broader headings by removing subfields from the end of the heading (NOTE:
test the results before enabling broader_headings in a production system
because its usefulness is very much dependent on individual sites' authority
files)
record that matches a given heading, even if there is more than one
authority record that matches
record that matches a given heading, even if there is more than one record
that matches
return $self->SUPER::_handle_auth_limit($authid), $fuzzy;
undestroyed, efficiency appears to approach O(log n^n)
avoid additional calls into Zebra when all that is wanted are authority
records and not statistics about their use
on, automatically create authority records for headings that don't have
any authority link when cataloging. When BiblioAddsAuthorities is on and
AutoCreateAuthorities is turned off, do not automatically generate authority
records, but allow the user to enter headings that don't match an existing
authority. When BiblioAddsAuthorities is off, this has no effect.
headings when a record is saved in the cataloging module when LinkerRelink
is turned on, even if the headings were manually linked to a different
authority by the cataloger. When turned off (the default), the automatic
linker will not relink any headings that have already been linked when a
record is saved.
(current options are as described above in the section on linker options:
"Default," "FirstMatch," and "LastMatch")
linker (at the moment, the only option available is "broader_headings," which
is described below)
that have previously been linked to an authority record when it runs. When
turned off, any heading with an existing link will be ignored.
authority record, though, depending on the value of LinkerRelink, it may
change the link.
unimplemented functions and added some unit tests.
from Match indexes.
C4::Linker routines.
Demians, 2011.01.09) Correct C4::Heading::UNIMARC class loading. Create
biblio tag to authority types data structure at initialization rather than
querying DB.
authority-controlled field.
box
entry or Main entry ($a only) box (i.e., repeat the procedure you usually
use for cataloging, whatever that may be)
the heading is inserted (note, however, that this patch does not AND IS NOT
INTENDED TO fix the bugs in the authority plugin with duplicate subfields;
those are wholly out of scope- this check is for regressions)
and if you enter a heading that doesn't currently have an authority record,
an authority record stub is automatically created, and the heading you
entered linked
*matches* an existing heading (i.e. the existing heading has only
subfield $a populated), the authid for that heading is inserted into
subfield $9
an existing heading, the authid for that heading is inserted into
subfield $9
and if you enter a heading that doesn't currently have an authority record,
an authority record stub is *not* created
an existing heading, the authid for that heading is inserted into
subfield $9
an existing heading, the authid for that heading is inserted into
subfield $9
the authority plugin.
authority.
the link. Save the record.
same authority record you did earlier.
authority.
the link. Save the record.
BiblioAddsAuthorities, and turn AutoCreateAuthorities and
LinkerKeepStale off
been linked (i.e. has data in $9) has a heading that does not match any
authority record in your database
want to pipe the output into less or a file, as the result is quite a lot of
information)
for report being matched, that the heading you modified in step 2 is
reported as "unlinked," and confirm that no changes were actually made to
the database (to check this, look at the bib record you edited earlier, and
check that the authid in the field you edited hasn't changed)
to pipe the output into less or a file, as the result is quite a lot of
information)
authority control plugin to populate $9
--bib-limit="biblionumber=${BIB}" (replacing ${BIB} with the biblionumber
of the record you've been editing)
--bib-limit="biblionumber=${BIB}" (replacing ${BIB} with the biblionumber
of the record you've been editing)
--bib-limit="biblionumber=${BIB}" (replacing ${BIB} with the biblionumber
of the record you've been editing)
--bib-limit="biblionumber=${BIB}" (replacing ${BIB} with the biblionumber
of the record you've been editing)
matches
--bib-limit="biblionumber=${BIB}" (replacing ${BIB} with the biblionumber
of the record you've been editing)
matches
--auth-limit="authid=${AUTH}" (replacing ${AUTH} with an authid)
bibs with that heading have been changed
---
C4/AuthoritiesMarc.pm | 185 +++----
C4/Biblio.pm | 142 +++++-
C4/Heading.pm | 156 ++++--
C4/Heading/MARC21.pm | 198 +++++---
C4/Heading/UNIMARC.pm | 207 ++++++++
C4/Linker.pm | 123 +++++
C4/Linker/Default.pm | 97 ++++
C4/Linker/FirstMatch.pm | 58 +++
C4/Linker/LastMatch.pm | 58 +++
C4/Search.pm | 101 ----
acqui/addorderiso2709.pl | 4 +-
acqui/neworderempty.pl | 4 +-
authorities/auth_finder.pl | 8 +-
cataloguing/addbiblio.pl | 91 +----
etc/zebradb/authorities/etc/bib1.att | 1 +
.../authorities/authority-koha-indexdefs.xml | 64 +++
.../authorities/authority-zebra-indexdefs.xsl | 537 ++++++++++++++++++--
.../marc21/authorities/koha-indexdefs-to-zebra.xsl | 21 +-
.../marc_defs/unimarc/authorities/record.abs | 120 +++---
.../atomicupdate/bug_7284_authority_linking_pt1 | 21 +
.../atomicupdate/bug_7284_authority_linking_pt2 | 9 +
installer/data/mysql/sysprefs.sql | 6 +
.../prog/en/includes/auth-finder-search.inc | 14 +-
.../en/modules/admin/preferences/authorities.pref | 101 +++-
misc/link_bibs_to_authorities.pl | 267 ++++++++--
t/Heading_MARC21.t | 8 +-
t/db_dependent/Linker_FirstMatch.t | 46 ++
t/db_dependent/lib/KohaTest/AuthoritiesMarc.pm | 1 -
28 files changed, 2011 insertions(+), 637 deletions(-)
create mode 100644 C4/Heading/UNIMARC.pm
create mode 100644 C4/Linker.pm
create mode 100644 C4/Linker/Default.pm
create mode 100644 C4/Linker/FirstMatch.pm
create mode 100644 C4/Linker/LastMatch.pm
create mode 100644 installer/data/mysql/atomicupdate/bug_7284_authority_linking_pt1
create mode 100755 installer/data/mysql/atomicupdate/bug_7284_authority_linking_pt2
create mode 100755 t/db_dependent/Linker_FirstMatch.t
--- a/C4/AuthoritiesMarc.pm
+++ a/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") {
--- a/C4/Biblio.pm
+++ a/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);
@@ -110,6 +111,7 @@ BEGIN {
# To link headings in a bib record
# to authority records.
push @EXPORT, qw(
+ &BiblioAutoLink
&LinkBibHeadingsToAuthorities
);
@@ -449,9 +451,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
@@ -459,9 +494,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.
@@ -469,38 +504,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
@@ -1864,6 +1973,7 @@ sub PrepHostMarcField {
my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
$marcflavour ||="MARC21";
+ require C4::Items;
my $hostrecord = GetMarcBiblio($hostbiblionumber);
my $item = C4::Items::GetItem($hostitemnumber);
--- a/C4/Heading.pm
+++ a/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;
-
- 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 ($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?
+sub _search {
+ my $self = shift;
+ my $index = shift || undef;
+ my $skipmetadata = shift || undef;
+ my @marclist;
+ my @and_or;
+ my @excluding = [];
+ my @operator;
+ my @value;
+
+ if ($index) {
+ push @marclist, $index;
+ push @and_or, 'and';
+ push @operator, $self->{'match_type'};
+ push @value, $self->{'search_form'};
}
- 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
--- a/C4/Heading/MARC21.pm
+++ a/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'});
-
- return ($auth_type, $subject, $series, $main_entry, $thesaurus, $search_heading, $display_heading);
+ 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, $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
--- a/C4/Heading/UNIMARC.pm
+++ a/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;
--- a/C4/Linker.pm
+++ a/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__
--- a/C4/Linker/Default.pm
+++ a/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
--- a/C4/Linker/FirstMatch.pm
+++ a/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
--- a/C4/Linker/LastMatch.pm
+++ a/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
--- a/C4/Search.pm
+++ a/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;
@@ -2657,105 +2655,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