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.07.00.049;
  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 =head1 METHODS
  63
  64 =head2 new
  65
  66   my $marc_handler = C4::Heading::UNIMARC->new();
  67
  68 =cut
  69
  70 sub new {
  71     my $class = shift;
  72
  73     my $dbh = C4::Context->dbh;
  74     my $sth = $dbh->prepare(
  75         "SELECT tagfield, authtypecode
  76          FROM marc_subfield_structure
  77          WHERE frameworkcode = '' AND authtypecode <> ''"
  78     );
  79     $sth->execute();
  80     $bib_heading_fields = {};
  81     while ( my ( $tag, $auth_type ) = $sth->fetchrow ) {
  82         $bib_heading_fields->{$tag} = {
  83             auth_type => $auth_type,
  84             subfields => 'abcdefghjklmnopqrstvxyz',
  85         };
  86     }
  87
  88     return bless {}, $class;
  89 }
  90
  91 =head2 valid_bib_heading_tag
  92
  93 =cut
  94
  95 sub valid_bib_heading_tag {
  96     my ( $self, $tag ) = @_;
  97     return $bib_heading_fields->{$tag};
  98 }
  99
 100 =head2 parse_heading
 101
 102 =cut
 103
 104 sub parse_heading {
 105     my ( $self, $field ) = @_;
 106
 107     my $tag        = $field->tag;
 108     my $field_info = $bib_heading_fields->{$tag};
 109     my $auth_type  = $field_info->{'auth_type'};
 110     my $search_heading =
 111       _get_search_heading( $field, $field_info->{'subfields'} );
 112     my $display_heading =
 113       _get_display_heading( $field, $field_info->{'subfields'} );
 114
 115     return ( $auth_type, undef, $search_heading, $display_heading, 'exact' );
 116 }
 117
 118 =head1 INTERNAL FUNCTIONS
 119
 120 =head2 _get_subject_thesaurus
 121
 122 =cut
 123
 124 sub _get_subject_thesaurus {
 125     my $field = shift;
 126
 127     my $thesaurus = "notdefined";
 128     my $sf2       = $field->subfield('2');
 129     $thesaurus = $sf2 if defined($sf2);
 130
 131     return $thesaurus;
 132 }
 133
 134 =head2 _get_search_heading
 135
 136 =cut
 137
 138 sub _get_search_heading {
 139     my $field     = shift;
 140     my $subfields = shift;
 141
 142     my $heading   = "";
 143     my @subfields = $field->subfields();
 144     my $first     = 1;
 145     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 146         my $code    = $subfields[$i]->[0];
 147         my $code_re = quotemeta $code;
 148         my $value   = $subfields[$i]->[1];
 149         $value =~ s/[-,.:=;!%\/]*$//;
 150         next unless $subfields =~ qr/$code_re/;
 151         if ($first) {
 152             $first   = 0;
 153             $heading = $value;
 154         }
 155         else {
 156             $heading .= " $value";
 157         }
 158     }
 159
 160     # remove characters that are part of CCL syntax
 161     $heading =~ s/[)(=]//g;
 162
 163     return $heading;
 164 }
 165
 166 =head2 _get_display_heading
 167
 168 =cut
 169
 170 sub _get_display_heading {
 171     my $field     = shift;
 172     my $subfields = shift;
 173
 174     my $heading   = "";
 175     my @subfields = $field->subfields();
 176     my $first     = 1;
 177     for ( my $i = 0 ; $i <= $#subfields ; $i++ ) {
 178         my $code    = $subfields[$i]->[0];
 179         my $code_re = quotemeta $code;
 180         my $value   = $subfields[$i]->[1];
 181         next unless $subfields =~ qr/$code_re/;
 182         if ($first) {
 183             $first   = 0;
 184             $heading = $value;
 185         }
 186         else {
 187             if ( exists $subdivisions{$code} ) {
 188                 $heading .= "--$value";
 189             }
 190             else {
 191                 $heading .= " $value";
 192             }
 193         }
 194     }
 195     return $heading;
 196 }
 197
 198 =head1 AUTHOR
 199
 200 Koha Development Team <http://koha-community.org/>
 201
 202 Jared Camins-Esakov <jcamins@cpbibliography.com>
 203
 204 =cut
 205
 206 1;