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