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

(-)a/C4/XSLT.pm (-1 / +1 lines)
Lines 191-197 sub XSLTParse4Display { Link Here
191
    my $frameworkcode = GetFrameworkCode($biblionumber) || '';
191
    my $frameworkcode = GetFrameworkCode($biblionumber) || '';
192
    my $record_processor = Koha::RecordProcessor->new(
192
    my $record_processor = Koha::RecordProcessor->new(
193
        {
193
        {
194
            filters => [ 'ExpandCodedFields' ],
194
            filters => [ 'ExpandCodedFields', 'Punctuation' ],
195
            options => {
195
            options => {
196
                interface     => $interface,
196
                interface     => $interface,
197
                frameworkcode => $frameworkcode
197
                frameworkcode => $frameworkcode
(-)a/Koha/Filter/MARC/Punctuation.pm (-1 / +185 lines)
Line 0 Link Here
0
- 
1
package Koha::Filter::MARC::Punctuation;
2
3
# Copyright 2024 join2
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
=head1 NAME
21
22
Koha::Filter::MARC::Punctuation - Automatically add punctuation to
23
Marc records if the leader specifies they were catalogued without it.
24
25
Documentation for proper punctuation:
26
https://www.loc.gov/aba/pcc/documents/isbdmarc2016.pdf
27
28
=head1 DESCRIPTION
29
30
If the Marc leader 18 specifies, that the record was catalogued
31
without punctuation add the proper punctuation chars to the individual
32
fields before passing the record on to fruther processing. Once this
33
filter is applied it should be safe for further steps to assume that
34
the record holds Marc punctuation. (The records in the database are
35
_not_ changed.)
36
37
Trigger to add punctuation: leader 18 is either `n` or `c`.
38
39
Currently handled fields:
40
41
- 260
42
43
=cut
44
45
use strict;
46
use warnings;
47
48
use base qw(Koha::RecordProcessor::Base);
49
our $NAME = 'Punctuation';
50
51
=head2 _decorate_260
52
53
Add punctuation to MARC field 260. The function assumes that it is only
54
called if no punctuation is part of the record.
55
56
=cut
57
58
sub _decorate_260 {
59
60
    my ($field) = @_;
61
62
    # simple chars _preceeding_ a subfield
63
    my %pchrs = (
64
65
        # 'a' => ' ; ',   # only for multiple $a
66
        'b' => ' : ',
67
        'c' => ', ',
68
69
        # 'f' => ' : ',
70
        # 'g' => ',  ',
71
        'r' => ' = ',
72
        't' => ' = ',
73
    );
74
75
    # simple chars _appended_ to a subfield
76
    my %achars = (
77
        '3' => ': ',
78
    );
79
80
    my $lastsf        = '';
81
    my @new_subfields = ();
82
83
    foreach my $subfield ( $field->subfields() ) {
84
        my ( $sf, $value ) = @$subfield;
85
86
        if ( ( $sf eq 'a' ) and ( $lastsf eq 'a' ) ) {
87
            $value = ";  $value";
88
        }
89
        if ( ( $sf eq 'a' ) and ( $lastsf eq 'b' ) ) {
90
            $value = " ; $value";
91
        }
92
93
        # for $e: assume that we always have either $f or $g
94
        if ( $sf eq 'e' ) {
95
            $value = " ($value ";
96
        }
97
98
        if ( $sf eq 'f' ) {
99
            if ( $lastsf eq 'e' ) {
100
                $value = " : $value";
101
            } else {
102
                $value = " ($value";
103
            }
104
        }
105
106
        if ( $sf eq 'g' ) {
107
            if ( $lastsf ne 'f' ) {
108
                $value = ", ($value)";
109
            } else {
110
                $value = ", $value)";
111
            }
112
        }
113
114
        $lastsf = $sf;
115
116
        if ( $sf eq 'q' ) {
117
            $value = "($value)";
118
        }
119
120
        if ( exists $pchrs{$sf} ) {
121
            $value = $pchrs{$sf} . $value;
122
        }
123
124
        # FIXME something seems wrong here, however $3 is
125
        # not used by Koha
126
        # if ( exists $achrs{$sf} ) {
127
        #     $value = $value . $achrs{$sf};
128
        # }
129
130
        push( @new_subfields, $sf, $value );
131
    }
132
    return @new_subfields;
133
}
134
135
=head2 filter
136
137
    my $newrecord = $filter->filter($record);
138
139
Return title fields with proper punctuation either as the record held
140
them already or as they were added.
141
142
Note: subfields in 260 are used to construct search links in OPAC. The
143
following will include the description chars in the search links as
144
does direct cataloguing of the punctuation. Kohas search engine seems
145
to handle this gracefully and still returns proper results.
146
147
=cut
148
149
sub filter {
150
    my ( $self, $record ) = @_;
151
152
    return
153
        unless $record and ref($record) eq 'MARC::Record';
154
155
    my $leader = $record->leader();
156
    my $punctuation_omitted =
157
        ( ( substr( $leader, 18, 1 ) eq 'c' ) or ( substr( $leader, 18, 1 ) eq 'n' ) );
158
159
    my @new_subfields = ();
160
    if ($punctuation_omitted) {
161
        foreach my $field ( $record->fields() ) {
162
            @new_subfields = ();
163
164
            # Process the implemented filters
165
            if ( $field->tag() eq '260' ) {
166
                @new_subfields = _decorate_260($field);
167
            }
168
169
            # If filtered, replace the field content
170
            if (@new_subfields) {
171
                $field->replace_with(
172
                    MARC::Field->new(
173
                        $field->tag(),
174
                        $field->indicator(1),
175
                        $field->indicator(2),
176
                        @new_subfields
177
                    )
178
                );
179
            }
180
        }
181
    }
182
    return $record;
183
}
184
185
1;

Return to bug 37325