View | Details | Raw Unified | Return to bug 7284
Collapse All | Expand All

(-)a/C4/Biblio.pm (-3 / +4 lines)
Lines 485-497 sub BiblioAutoLink { Link Here
485
    }
485
    }
486
486
487
    my $linker = $linker_module->new();
487
    my $linker = $linker_module->new();
488
    my ($headings_changed, undef) = LinkBibHeadingsToAuthorities($linker, $record);
488
    my ($headings_changed, undef) = LinkBibHeadingsToAuthorities($linker, $record, $frameworkcode);
489
    return $headings_changed;
489
    return $headings_changed;
490
}
490
}
491
491
492
=head2 LinkBibHeadingsToAuthorities
492
=head2 LinkBibHeadingsToAuthorities
493
493
494
  my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc);
494
  my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode);
495
495
496
Links bib headings to authority records by checking
496
Links bib headings to authority records by checking
497
each authority-controlled field in the C<MARC::Record>
497
each authority-controlled field in the C<MARC::Record>
Lines 511-522 MARC record. Link Here
511
sub LinkBibHeadingsToAuthorities {
511
sub LinkBibHeadingsToAuthorities {
512
    my $linker = shift;
512
    my $linker = shift;
513
    my $bib = shift;
513
    my $bib = shift;
514
    my $frameworkcode = shift;
514
    my %results;
515
    my %results;
515
    require C4::AuthoritiesMarc;
516
    require C4::AuthoritiesMarc;
516
517
517
    my $num_headings_changed = 0;
518
    my $num_headings_changed = 0;
518
    foreach my $field ( $bib->fields() ) {
519
    foreach my $field ( $bib->fields() ) {
519
        my $heading = C4::Heading->new_from_bib_field($field);
520
        my $heading = C4::Heading->new_from_bib_field($field, $frameworkcode);
520
        next unless defined $heading;
521
        next unless defined $heading;
521
522
522
        # check existing $9
523
        # check existing $9
(-)a/C4/Heading.pm (-12 / +9 lines)
Lines 22-29 use warnings; Link Here
22
use MARC::Record;
22
use MARC::Record;
23
use MARC::Field;
23
use MARC::Field;
24
use C4::Context;
24
use C4::Context;
25
use C4::Heading::MARC21;
26
use C4::AuthoritiesMarc;
25
use C4::AuthoritiesMarc;
26
use Module::Load;
27
use Carp;
27
use Carp;
28
28
29
our $VERSION = 3.00;
29
our $VERSION = 3.00;
Lines 35-41 C4::Heading Link Here
35
=head1 SYNOPSIS
35
=head1 SYNOPSIS
36
36
37
 use C4::Heading;
37
 use C4::Heading;
38
 my $heading = C4::Heading->new_from_bib_field($field);
38
 my $heading = C4::Heading->new_from_bib_field($field, $frameworkcode);
39
 my $thesaurus = $heading->thesaurus();
39
 my $thesaurus = $heading->thesaurus();
40
 my $type = $heading->type();
40
 my $type = $heading->type();
41
 my $display_heading = $heading->display_form();
41
 my $display_heading = $heading->display_form();
Lines 50-56 headings found in bibliographic and authority records. Link Here
50
50
51
=head2 new_from_bib_field
51
=head2 new_from_bib_field
52
52
53
  my $heading = C4::Heading->new_from_bib_field($field[, $marc_flavour]);
53
  my $heading = C4::Heading->new_from_bib_field($field, $frameworkcode, [, $marc_flavour]);
54
54
55
Given a C<MARC::Field> object containing a heading from a 
55
Given a C<MARC::Field> object containing a heading from a 
56
bib record, create a C<C4::Heading> object.
56
bib record, create a C<C4::Heading> object.
Lines 67-78 is returned. Link Here
67
sub new_from_bib_field {
67
sub new_from_bib_field {
68
    my $class = shift;
68
    my $class = shift;
69
    my $field = shift;
69
    my $field = shift;
70
    my $frameworkcode = shift;
70
    my $marcflavour = @_ ? shift : C4::Context->preference('marcflavour');
71
    my $marcflavour = @_ ? shift : C4::Context->preference('marcflavour');
71
72
72
    my $marc_handler = _marc_format_handler($marcflavour);
73
    my $marc_handler = _marc_format_handler($marcflavour);
73
74
74
    my $tag = $field->tag();
75
    my $tag = $field->tag();
75
    return unless $marc_handler->valid_bib_heading_tag($tag);
76
    return unless $marc_handler->valid_bib_heading_tag($tag, $frameworkcode);
76
    my $self = {};
77
    my $self = {};
77
   
78
   
78
    $self->{'field'} = $field;
79
    $self->{'field'} = $field;
Lines 213-226 depending on the selected MARC flavour. Link Here
213
=cut
214
=cut
214
215
215
sub _marc_format_handler {
216
sub _marc_format_handler {
216
    my $marcflavour = shift;
217
    my $marcflavour = uc shift;
217
218
    my $pname = "C4::Heading::$marcflavour";
218
    if ($marcflavour eq 'UNIMARC') {
219
    load $pname;
219
        return C4::Heading::UNIMARC->new();
220
    return $pname->new();
220
    } else {
221
        return C4::Heading::MARC21->new();
222
    }
223
224
}
221
}
225
222
226
=head1 AUTHOR
223
=head1 AUTHOR
(-)a/C4/Heading/MARC21.pm (+1 lines)
Lines 103-108 sub new { Link Here
103
sub valid_bib_heading_tag {
103
sub valid_bib_heading_tag {
104
    my $self = shift;
104
    my $self = shift;
105
    my $tag = shift;
105
    my $tag = shift;
106
    my $frameworkcode = shift;
106
107
107
    if (exists $bib_heading_fields->{$tag}) {
108
    if (exists $bib_heading_fields->{$tag}) {
108
        return 1
109
        return 1
(-)a/C4/Heading/UNIMARC.pm (+202 lines)
Line 0 Link Here
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
63
BEGIN {
64
    my $dbh = C4::Context->dbh;
65
    my $sth = $dbh->prepare(
66
        "SELECT tagfield, authtypecode
67
         FROM marc_subfield_structure
68
         WHERE frameworkcode = '' AND authtypecode <> ''" );
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 = _get_search_heading($field, $field_info->{'subfields'});
112
    my $display_heading = _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
        } else {
154
            $heading .= " $value";
155
        }
156
    }
157
158
    # remove characters that are part of CCL syntax
159
    $heading =~ s/[)(=]//g;
160
161
    return $heading;
162
}
163
164
=head2 _get_display_heading
165
166
=cut
167
168
sub _get_display_heading {
169
    my $field = shift;
170
    my $subfields = shift;
171
172
    my $heading = "";
173
    my @subfields = $field->subfields();
174
    my $first = 1;
175
    for (my $i = 0; $i <= $#subfields; $i++) {
176
        my $code = $subfields[$i]->[0];
177
        my $code_re = quotemeta $code;
178
        my $value = $subfields[$i]->[1];
179
        next unless $subfields =~ qr/$code_re/;
180
        if ($first) {
181
            $first = 0;
182
            $heading = $value;
183
        } else {
184
            if (exists $subdivisions{$code}) {
185
                $heading .= "--$value";
186
            } else {
187
                $heading .= " $value";
188
            }
189
        }
190
    }
191
    return $heading;
192
}
193
194
=head1 AUTHOR
195
196
Koha Development Team <http://koha-community.org/>
197
198
Jared Camins-Esakov <jcamins@cpbibliography.com>
199
200
=cut
201
202
1;
(-)a/misc/link_bibs_to_authorities.pl (-1 / +1 lines)
Lines 185-191 sub process_bib { Link Here
185
        return;
185
        return;
186
    }
186
    }
187
187
188
    my ($headings_changed, $results) = LinkBibHeadingsToAuthorities($linker, $bib);
188
    my ($headings_changed, $results) = LinkBibHeadingsToAuthorities($linker, $bib, GetFrameworkCode($biblionumber));
189
    foreach my $key (keys %{$results->{'unlinked'}}) {
189
    foreach my $key (keys %{$results->{'unlinked'}}) {
190
        $unlinked_headings{$key} += $results->{'unlinked'}->{$key};
190
        $unlinked_headings{$key} += $results->{'unlinked'}->{$key};
191
    }
191
    }
(-)a/t/db_dependent/Linker_FirstMatch.t (-2 / +1 lines)
Lines 37-43 SKIP: { Link Here
37
    $tag =~ s/^./6/;
37
    $tag =~ s/^./6/;
38
    $bibfield->update(tag => $tag);
38
    $bibfield->update(tag => $tag);
39
    my $heading;
39
    my $heading;
40
    ok(defined ($heading = C4::Heading->new_from_bib_field($bibfield)), "Creating heading from bib field");
40
    ok(defined ($heading = C4::Heading->new_from_bib_field($bibfield, '')), "Creating heading from bib field");
41
41
42
    my $authmatch;
42
    my $authmatch;
43
    my $fuzzy; 
43
    my $fuzzy; 
44
- 

Return to bug 7284