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