--- /dev/null
+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
+# 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., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use MARC::Record;
+use MARC::Field;
+use C4::Context;
+use C4::Heading::MARC21;
+use C4::Search;
+
+our $VERSION = 3.00;
+
+=head1 NAME
+
+C4::Heading
+
+=head1 SYNOPSIS
+
+use C4::Heading;
+my $heading = C4::Heading->new_from_bib_field($field);
+my $thesaurus = $heading->thesaurus();
+my $type = $heading->type();
+my $display_heading = $heading->display();
+my $search_string = $heading->search_string();
+
+=head1 DESCRIPTION
+
+C<C4::Heading> implements a simple class to representing
+headings found in bibliographic and authority records.
+
+=head1 METHODS
+
+=head2 new_from_bib_field
+
+=over 4
+
+my $heading = C4::Heading->new_from_bib_field($field[, $marc_flavour]);
+
+=back
+
+Given a C<MARC::Field> object containing a heading from a
+bib record, create a C<C4::Heading> object.
+
+The optional second parameter is the MARC flavour (i.e., MARC21
+or UNIMARC); if this parameter is not supplied, it is
+taken from the Koha application context.
+
+If the MARC field supplied is not a valid heading, undef
+is returned.
+
+=cut
+
+sub new_from_bib_field {
+ my $class = shift;
+ my $field = 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);
+ 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);
+
+ bless $self, $class;
+ return $self;
+}
+
+=head2 display_form
+
+=over 4
+
+my $display = $heading->display_form();
+
+=back
+
+Return the "canonical" display form of the heading.
+
+=cut
+
+sub display_form {
+ my $self = shift;
+ return $self->{'display_form'};
+}
+
+=head2 authorities
+
+=over 4
+
+my $authorities = $heading->authorities;
+
+=back
+
+Return a list of authority records for this
+heading.
+
+=cut
+
+sub authorities {
+ my $self = shift;
+ my $query = "Match-heading,ext='$self->{'search_form'}'";
+ $query .= $self->_query_limiters();
+ my $results = SimpleSearch($query, "authorityserver");
+ return $results;
+}
+
+=head2 preferred_authorities
+
+=over 4
+
+my $preferred_authorities = $heading->preferred_authorities;
+
+=back
+
+Return a list of authority records for headings
+that are a preferred form of the heading.
+
+=cut
+
+sub preferred_authorities {
+ my $self = shift;
+ my $query = "Match-heading-see-from,ext='$self->{'search_form'}'";
+ $query .= $self->_query_limiters();
+ my $results = SimpleSearch($query, "authorityserver");
+ return $results;
+}
+
+=head1 INTERNAL METHODS
+
+=head2 _query_limiters
+
+=cut
+
+sub _query_limiters {
+ my $self = shift;
+ my $limiters = "";
+
+ 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?
+ }
+ return $limiters;
+}
+
+=head1 INTERNAL FUNCTIONS
+
+=head2 _marc_format_handler
+
+Returns a C4::Heading::MARC21 or C4::Heading::UNIMARC object
+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();
+ }
+
+}
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
+
+Galen Charlton <galen.charlton@liblime.com>
+
+=cut
+
+1;
--- /dev/null
+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
+# 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., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use MARC::Record;
+use MARC::Field;
+
+our $VERSION = 3.00;
+
+=head1 NAME
+
+C4::Heading::MARC21
+
+=head1 SYNOPSIS
+
+use C4::Heading::MARC21;
+
+=head1 DESCRIPTION
+
+This is an internal helper class used by
+C<C4::Heading> to parse headings data from
+MARC21 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 bib_heading_fields
+
+=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 },
+ '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 },
+ '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' },
+ '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 },
+};
+
+=head2 subdivisions
+
+=cut
+
+my %subdivisions = (
+ 'v' => 'formsubdiv',
+ 'x' => 'generalsubdiv',
+ 'y' => 'chronologicalsubdiv',
+ 'z' => 'geographicsubdiv',
+);
+
+=head1 METHODS
+
+=head2 new
+
+=over 4
+
+my $marc_handler = C4::Heading::MARC21->new();
+
+=back
+
+=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;
+
+ if (exists $bib_heading_fields->{$tag}) {
+ return 1
+ } else {
+ return 0;
+ }
+
+}
+
+=head2 parse_heading
+
+=cut
+
+sub parse_heading {
+ my $self = shift;
+ my $field = shift;
+
+ 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);
+}
+
+=head1 INTERNAL FUNCTIONS
+
+=head2 _get_subject_thesaurus
+
+=cut
+
+sub _get_subject_thesaurus {
+ my $field = shift;
+ my $ind2 = $field->indicator(2);
+
+ my $thesaurus = "notdefined";
+ if ($ind2 eq '0') {
+ $thesaurus = "lcsh";
+ } elsif ($ind2 eq '1') {
+ $thesaurus = "lcac";
+ } elsif ($ind2 eq '2') {
+ $thesaurus = "mesh";
+ } elsif ($ind2 eq '3') {
+ $thesaurus = "nal";
+ } elsif ($ind2 eq '4') {
+ $thesaurus = "notspecified";
+ } elsif ($ind2 eq '5') {
+ $thesaurus = "cash";
+ } elsif ($ind2 eq '6') {
+ $thesaurus = "rvm";
+ } elsif ($ind2 eq '7') {
+ 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 $value = $subfields[$i]->[1];
+ next unless $subfields =~ qr/$code/;
+ if ($first) {
+ $first = 0;
+ $heading = $value;
+ } else {
+ if (exists $subdivisions{$code}) {
+ $heading .= " $subdivisions{$code} $value";
+ } else {
+ $heading .= " $value";
+ }
+ }
+ }
+ 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 $value = $subfields[$i]->[1];
+ next unless $subfields =~ qr/$code/;
+ if ($first) {
+ $first = 0;
+ $heading = $value;
+ } else {
+ if (exists $subdivisions{$code}) {
+ $heading .= "--$value";
+ } else {
+ $heading .= " $value";
+ }
+ }
+ }
+ return $heading;
+}
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
+
+Galen Charlton <galen.charlton@liblime.com>
+
+=cut
+
+1;