C4/Heading/UNIMARC.pm

   1 package C4::Heading::UNIMARC;
   2
   3 # Copyright (C) 2011 C & P Bibliography Services
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use 5.010;
  21 use strict;
  22 use warnings;
  23 use MARC::Record;
  24 use MARC::Field;
  25 use C4::Context;
  26
  27 our $VERSION = 3.00;
  28
  29 =head1 NAME
  30
  31 C4::Heading::UNIMARC
  32
  33 =head1 SYNOPSIS
  34
  35 use C4::Heading::UNIMARC;
  36
  37 =head1 DESCRIPTION
  38
  39 This is an internal helper class used by
  40 C<C4::Heading> to parse headings data from
  41 UNIMARC records.  Object of this type
  42 do not carry data, instead, they only
  43 dispatch functions.
  44
  45 =head1 DATA STRUCTURES
  46
  47 FIXME - this should be moved to a configuration file.
  48
  49 =head2 subdivisions
  50
  51 =cut
  52
  53 my %subdivisions = (
  54     'j' => 'formsubdiv',
  55     'x' => 'generalsubdiv',
  56     'y' => 'chronologicalsubdiv',
  57     'z' => 'geographicsubdiv',
  58 );
  59
  60 my $bib_heading_fields;
  61
  62 BEGIN {
  63     my $dbh = C4::Context->dbh;
  64     my $sth = $dbh->prepare(
  65         "SELECT tagfield, authtypecode
  66          FROM marc_subfield_structure
  67          WHERE frameworkcode = '' AND authtypecode <> ''"
  68     );
  69     $sth->execute();
  70     $bib_heading_fields = {};
  71     while ( my ( $tag, $auth_type ) = $sth->fetchrow ) {
  72         $bib_heading_fields->{$tag} = {
  73             auth_type => $auth_type,
  74             subfields => 'abcdefghjklmnopqrstvxyz',
  75         };
  76     }
  77 }
  78
  79 =head1 METHODS
  80
  81 =head2 new
  82
  83   my $marc_handler = C4::Heading::UNIMARC->new();
  84
  85 =cut
  86
  87 sub new {
  88     my $class = shift;
  89     return bless {}, $class;
  90 }
  91
  92 =head2 valid_bib_heading_tag
  93
  94 =cut
  95
  96 sub valid_bib_heading_tag {
  97     my ( $self, $tag ) = @_;
  98     return $bib_heading_fields->{$tag};
  99 }
 100
 101 =head2 parse_heading
 102
 103 =cut
 104
 105 sub parse_heading {
 106     my ( $self, $field ) = @_;
 107
 108     my $tag        = $field->tag;
 109     my $field_info = $bib_heading_fields->{$tag};
 110     my $auth_type  = $field_info->{'auth_type'};
 111     my $search_heading =
 112       _get_search_heading( $field, $field_info->{'subfields'} );
 113     my $display_heading =
 114       _get_display_heading( $field, $field_info->{'subfields'} );
 115
 116     return ( $auth_type, undef, $search_heading, $display_heading, 'exact' );
 117 }
 118
 119 =head1 INTERNAL FUNCTIONS
 120
 121 =head2 _get_subject_thesaurus
 122
 123 =cut
 124
 125 sub _get_subject_thesaurus {
 126     my $field = shift;
 127
 128     my $thesaurus = "notdefined";
 129     my $sf2       = $field->subfield('2');
 130     $thesaurus = $sf2 if defined($sf2);
 131
 132     return $thesaurus;
 133 }
 134
 135 =head2 _get_search_heading
 136
 137 =cut
 138
 139 sub _get_search_heading {
 140     my $field     = shift;
 141     my $subfields = shift;
 142
 143     my $heading   = "";
 144     my @subfields = $field->subfields();
 145     my $first     = 1;
 146     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 147         my $code    = $subfields[$i]->[0];
 148         my $code_re = quotemeta $code;
 149         my $value   = $subfields[$i]->[1];
 150         $value =~ s/[-,.:=;!%\/]*$//;
 151         next unless $subfields =~ qr/$code_re/;
 152         if ($first) {
 153             $first   = 0;
 154             $heading = $value;
 155         }
 156         else {
 157             $heading .= " $value";
 158         }
 159     }
 160
 161     # remove characters that are part of CCL syntax
 162     $heading =~ s/[)(=]//g;
 163
 164     return $heading;
 165 }
 166
 167 =head2 _get_display_heading
 168
 169 =cut
 170
 171 sub _get_display_heading {
 172     my $field     = shift;
 173     my $subfields = shift;
 174
 175     my $heading   = "";
 176     my @subfields = $field->subfields();
 177     my $first     = 1;
 178     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 179         my $code    = $subfields[$i]->[0];
 180         my $code_re = quotemeta $code;
 181         my $value   = $subfields[$i]->[1];
 182         next unless $subfields =~ qr/$code_re/;
 183         if ($first) {
 184             $first   = 0;
 185             $heading = $value;
 186         }
 187         else {
 188             if ( exists $subdivisions{$code} ) {
 189                 $heading .= "--$value";
 190             }
 191             else {
 192                 $heading .= " $value";
 193             }
 194         }
 195     }
 196     return $heading;
 197 }
 198
 199 =head1 AUTHOR
 200
 201 Koha Development Team <http://koha-community.org/>
 202
 203 Jared Camins-Esakov <jcamins@cpbibliography.com>
 204
 205 =cut
 206
 207 1;