From 548fb8830dd6678efe29b3011b9d5d6de081f63a Mon Sep 17 00:00:00 2001 From: Jared Camins-Esakov Date: Sat, 7 Jan 2012 13:40:45 -0500 Subject: [PATCH] Bug 7284: Add UNIMARC handler for C4::Heading Content-Type: text/plain; charset="UTF-8" Look in the framework configuration tables to figure out which tags should be authority controlled for UNIMARC, and add a simple implementation for C4::Heading::UNIMARC which will work with the GRS-1 indexing used by UNIMARC. --- C4/Biblio.pm | 7 +- C4/Heading.pm | 7 +- C4/Heading/MARC21.pm | 1 + C4/Heading/UNIMARC.pm | 198 ++++++++++++++++++++++++++++++++++++ misc/link_bibs_to_authorities.pl | 2 +- t/db_dependent/Linker_FirstMatch.t | 2 +- 6 files changed, 209 insertions(+), 8 deletions(-) create mode 100644 C4/Heading/UNIMARC.pm diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 00b7ad4..878312c 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -485,13 +485,13 @@ sub BiblioAutoLink { } my $linker = $linker_module->new(); - my ($headings_changed, undef) = LinkBibHeadingsToAuthorities($linker, $record); + my ($headings_changed, undef) = LinkBibHeadingsToAuthorities($linker, $record, $frameworkcode); return $headings_changed; } =head2 LinkBibHeadingsToAuthorities - my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc); + my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode); Links bib headings to authority records by checking each authority-controlled field in the C @@ -511,12 +511,13 @@ MARC record. sub LinkBibHeadingsToAuthorities { my $linker = shift; my $bib = shift; + my $frameworkcode = shift; my %results; require C4::AuthoritiesMarc; 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 diff --git a/C4/Heading.pm b/C4/Heading.pm index a51f9aa..0b35126 100644 --- a/C4/Heading.pm +++ b/C4/Heading.pm @@ -35,7 +35,7 @@ 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_form(); @@ -50,7 +50,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. @@ -67,12 +67,13 @@ is returned. sub new_from_bib_field { 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->{'field'} = $field; diff --git a/C4/Heading/MARC21.pm b/C4/Heading/MARC21.pm index 6e54698..3ef0811 100644 --- a/C4/Heading/MARC21.pm +++ b/C4/Heading/MARC21.pm @@ -103,6 +103,7 @@ sub new { sub valid_bib_heading_tag { my $self = shift; my $tag = shift; + my $frameworkcode = shift; if (exists $bib_heading_fields->{$tag}) { return 1 diff --git a/C4/Heading/UNIMARC.pm b/C4/Heading/UNIMARC.pm new file mode 100644 index 0000000..3de06f0 --- /dev/null +++ b/C4/Heading/UNIMARC.pm @@ -0,0 +1,198 @@ +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 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', +); + +=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 = shift; + my $tag = shift; + my $frameworkcode = shift; + + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT authtypecode FROM marc_subfield_structure WHERE tagfield = ? AND frameworkcode = ?;"); + $sth->execute($tag, $frameworkcode); + if ($sth->fetchrow) { + return 1 + } else { + return 0; + } + +} + +=head2 parse_heading + +=cut + +sub parse_heading { + my $self = shift; + my $field = shift; + + my $tag = $field->tag; + + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT authtypecode FROM marc_subfield_structure WHERE tagfield = ? AND frameworkcode = ?;"); + $sth->execute($tag, $frameworkcode); + my $auth_type = $sth->fetchrow; + my $thesaurus = undef; # UNIMARC searches don't support thesauri yet + my $search_heading = _get_search_heading($field, 'abcdefghijklmnopqrstuvwxyz'); + my $display_heading = _get_display_heading($field, 'abcdefghijklmnopqrstuvwxyz'); + + return ($auth_type, $thesaurus, $search_heading, $display_heading, 'is'); +} + +=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/misc/link_bibs_to_authorities.pl b/misc/link_bibs_to_authorities.pl index 691fe39..aef3c29 100755 --- a/misc/link_bibs_to_authorities.pl +++ b/misc/link_bibs_to_authorities.pl @@ -185,7 +185,7 @@ sub process_bib { return; } - my ($headings_changed, $results) = LinkBibHeadingsToAuthorities($linker, $bib); + my ($headings_changed, $results) = LinkBibHeadingsToAuthorities($linker, $bib, GetFrameworkCode($biblionumber)); foreach my $key (keys %{$results->{'unlinked'}}) { $unlinked_headings{$key} += $results->{'unlinked'}->{$key}; } diff --git a/t/db_dependent/Linker_FirstMatch.t b/t/db_dependent/Linker_FirstMatch.t index 4a0ed5a..6ff8254 100755 --- a/t/db_dependent/Linker_FirstMatch.t +++ b/t/db_dependent/Linker_FirstMatch.t @@ -37,7 +37,7 @@ SKIP: { $tag =~ s/^./6/; $bibfield->update(tag => $tag); my $heading; - ok(defined ($heading = C4::Heading->new_from_bib_field($bibfield)), "Creating heading from bib field"); + ok(defined ($heading = C4::Heading->new_from_bib_field($bibfield, '')), "Creating heading from bib field"); my $authmatch; my $fuzzy; -- 1.7.2.5