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

(-)a/Koha/Template/Plugin/MARC.pm (+398 lines)
Line 0 Link Here
1
package Koha::Template::Plugin::MARC;
2
3
# Copyright C & P Bibliography Services 2012
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 3 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
=head1 NAME
21
22
Koha::Template::Plugin::MARC - Template::Toolkit to make MARC friendly
23
24
=head1 SYNOPSIS
25
26
[% USE record = MARC(mymarc) %] <!-- translate MARC::Record to T::T hash -->
27
<h1>[% record.f245.sa %]</h1> <!-- subfield 245$a -->
28
[% record.f245.all %] <!-- all subfields concatenated together -->
29
[% FOREACH link IN record.f856s %] <!-- process each 856 field -->
30
    <a href="whatever/[% link.su %]">[% link.sy %]</a> <!-- create a link on 856$y -->
31
[% END %] <!-- /FOREACH link IN record.856s -->
32
[% FOREACH contents IN record.f505s %] <!-- process each 505 field -->
33
    [% FOREACH subf IN contents.subfields %] <!-- process each subfield -->
34
        [% SWITCH subf.code %]
35
        [% CASE 'a' %]
36
            <span class='contents'>[% subf.value %]</span>
37
        [% CASE 't' %]
38
            <span class='title'>[% subf.value %]</span>
39
        [% CASE 'r' %]
40
            <span class='responsibility'>[% subf.value %]</span>
41
        [% END %]
42
    [% END %] <!-- /FOREACH contents.subfields -->
43
[% END %] <!-- /FOREACH contents IN record.f505s -->
44
[% FOREACH subj IN record.f6xxs %]
45
    <a href="whatever/[% subj.s9 %]">[% subj.sa %]</a> <!-- create a link on 6[0-9]{2}$a -->
46
[% END %]
47
[% FOREACH field IN record.fields %]
48
    [% SWITCH field.tag %]
49
    [% CASE '600' %]
50
        Subject: [% field.all %] is what we are all about
51
    [% CASE '700' %]
52
        Co-author: [% field.all %], I presume?
53
    [% END %]
54
[% END %]
55
56
=head1 DESCRIPTION
57
58
A Template::Toolkit plugin which given a MARC::Record object parses it into a
59
hash that can be accessed directly in Template::Toolkit.
60
61
=head1 ACCESSORS
62
63
By using some clever AUTOLOAD acrobatics, this plugin offers the user six
64
types of accessors.
65
66
=head2 Direct accessors
67
68
    [% record.f245.sa %]
69
70
    print $record->f245->sa;
71
72
By prefixing field numbers with an 'f' and subfield codes with an 's', the first
73
field/subfield with a given tag/code can be accessed.
74
75
=head2 Concatenated accessors
76
77
    [% record.f245.all %]
78
79
    print $record->f245->all;
80
81
A string consisting of all subfields concatenated together is accessible through
82
the all member of field objects.
83
84
=head2 Subfield iterators
85
86
    [% FOREACH subfield IN record.f245.subfields %]
87
        [% subfield.code %] = [% subfield.value %]
88
    [% END %]
89
90
    foreach my $subfield ($record->f245) {
91
        print $subfield->code, ' = ', $subfield->value;
92
    }
93
94
Subfield iterators are accessible through the subfields member of field objects.
95
96
=head2 Field iterators
97
98
    [% FOREACH field IN record.f500s %]
99
        [% field.all %]
100
    [% END %]
101
102
    foreach my $field ($record->f500s) {
103
        print $field->all;
104
    }
105
106
Field iterators are accessible by adding an 's' to the end of field names:
107
f500s, etc.
108
109
=head2 Section iterators
110
111
    [% FOREACH field IN record.f5xxs %]
112
        [% field.all %]
113
    [% END %]
114
115
    foreach my $field ($record->f5xxs) {
116
        print $field->all;
117
    }
118
119
All the fields in a section (identified by the first digit of the tag) can
120
be accessed with 'fNxxs' and then iterated through.
121
122
=head2 Complete field list
123
124
    [% FOREACH field IN record.fields %]
125
        [% field.all %]
126
    [% END %]
127
128
    foreach my $field ($record->fields) {
129
        print $field->all;
130
    }
131
132
All the fields in a record can be accessed via the fields object method.
133
134
=head1 WHAT THIS PLUGIN DOES NOT DO
135
136
This plugin will not sanity-check your code to make sure that you are accessing
137
fields and subfields with proper allowances for repetition. If you access a value
138
using [% record.f505.st %] it is presumed that was intentional, and there will be
139
no warning or error of any sort.
140
141
However, the flip-side of this is that this plugin will not dictate your code
142
style. You can access the data using direct (non-repeatable) accessors, by
143
iterating over subfields, by iterating over subfields of a specific tag, by
144
iterating over fields in a particular block (0xx, 1xx, 2xx, etc.), or by
145
iterating over all fields.
146
147
=cut
148
149
use Modern::Perl;
150
use MARC::Record;
151
use MARC::Field;
152
153
use Template::Plugin;
154
use base qw( Template::Plugin );
155
156
our $AUTOLOAD;
157
158
=head1 METHODS
159
160
=head2 load
161
162
Used by Template::Toolkit for loading this plugin.
163
164
=cut
165
166
sub load {
167
    my ($class, $context) = @_;
168
    return $class;
169
}
170
171
=head2 new
172
173
Instantiates a new object for the given MARC::Record. Can be called
174
using any of the following declarations:
175
176
    [% USE MARC(mymarc) %]
177
    [% USE marc(mymarc) %]
178
    [% USE MARC mymarc %]
179
    [% USE MARC(marc=mymarc) %]
180
    [% USE MARC marc=mymarc %]
181
182
When run from Perl, the object can be created with either of the following
183
two calling conventions:
184
185
    $record = Koha::Template::Plugin::MARC->new({}, $marc, [\%config]);
186
    $record = Koha::Template::Plugin::MARC->new([$context], { marc => $marc });
187
188
The $context hashref passed as the first argument is mandatory when using
189
positional parameters and optional when using named parameters.
190
191
=cut
192
193
sub new {
194
    my $config = ref($_[-1]) eq 'HASH' ? pop(@_) : { };
195
    my ($class, $context, $marc) = @_;
196
197
    # marc can be a positional or named argument
198
    $marc = $config->{'marc'} unless defined $marc;
199
200
    bless {
201
        %$config,
202
            marc => $marc,
203
    }, $class;
204
}
205
206
=head2 init
207
208
Initializes the MARC object. This is called only on the first access attempt
209
on the object, to avoid unnecessary processing.
210
211
=cut
212
213
sub init {
214
    my $self = shift;
215
    return $self if $self->{'record'};
216
217
    my $recordhash = { fields => [] };
218
219
    foreach my $field ($self->{'marc'}->fields()) {
220
        my $fieldobj = Koha::Template::Plugin::MARC::Field->new($field);
221
        my $tag = $fieldobj->tag();
222
        my $section = 'f' . substr($tag, 0, 1) . 'xxs';
223
        $recordhash->{"f$tag"} = $fieldobj unless $recordhash->{"f$tag"};
224
        $recordhash->{"f$tag" . 's'} = [] unless $recordhash->{"f$tag" . 's'};
225
        push @{$recordhash->{"f$tag" . 's'}}, $fieldobj;
226
        $recordhash->{"$section"} = [] unless $recordhash->{"$section"};
227
        push @{$recordhash->{"$section"}}, $fieldobj;
228
        push @{$recordhash->{'fields'}}, $fieldobj;
229
    }
230
231
    $self->{'record'} = $recordhash;
232
    return $self;
233
}
234
235
=head2 filter
236
237
    $record->filter({ '4' => 'edt' })->[0]->sa
238
239
    [% record.filter('4'='edt').0.sa
240
241
Filters a set of fields according to the specified criteria
242
243
=cut
244
245
sub filter {
246
    my ($self, $selectors) = @_;
247
248
    $self->init();
249
250
    my $fields = $self->{'record'}->{'fields'};
251
    foreach my $selector (keys %$selectors) {
252
        my $possibilities = [];
253
        foreach my $testfield (@$fields) {
254
            push @$possibilities, $testfield if $testfield->has($selector, $selectors->{$selector});
255
        }
256
        $fields = $possibilities;
257
    }
258
259
    return $fields;
260
}
261
262
=head2 marc
263
264
Returns the MARC::Record object associated with the instance.
265
266
=cut
267
268
sub marc {
269
    my $self = shift;
270
    return $self->{'marc'};
271
}
272
273
sub AUTOLOAD {
274
    my $self = shift;
275
    (my $a = $AUTOLOAD) =~ s/.*:://;
276
277
    $self->init;
278
279
    return $self->{'record'}->{"$a"};
280
}
281
282
1;
283
284
=head1 HELPER CLASSES
285
286
=cut
287
288
package Koha::Template::Plugin::MARC::Field;
289
290
=head2 Koha::Template::Plugin::MARC::Field
291
292
Object class to allow nested auto-loading. Not used directly.
293
294
=cut
295
296
use Modern::Perl;
297
use MARC::Field;
298
299
our $AUTOLOAD;
300
301
sub new {
302
    my ($class, $field) = @_;
303
    my $fieldhash = {
304
        'tag' => $field->tag(),
305
        'subfields' => [],
306
    };
307
    if ($field->is_control_field()) {
308
        $fieldhash->{'value'} = $field->data();
309
            push @{$fieldhash->{'subfields'}}, Koha::Template::Plugin::MARC::Subfield->new('@' => $field->data());
310
    } else {
311
        $fieldhash->{'ind1'} = $field->indicator(1);
312
        $fieldhash->{'ind2'} = $field->indicator(2);
313
        my @subfields = $field->subfields();
314
        foreach my $subf (@subfields) {
315
            $fieldhash->{"s$subf->[0]"} = $subf->[1] unless $fieldhash->{"s$subf->[0]"};
316
            $fieldhash->{'all'} .= ' ' if $fieldhash->{'all'};
317
            $fieldhash->{'all'} .= $subf->[1];
318
            push @{$fieldhash->{'subfields'}}, Koha::Template::Plugin::MARC::Subfield->new($subf->[0] => $subf->[1]);
319
        }
320
    }
321
322
    bless $fieldhash, $class;
323
}
324
325
sub has {
326
    my ($self, $selector, $match) = @_;
327
328
    unless ($selector eq 'ind1' || $selector eq 'ind2' || $selector eq 'tag') {
329
        $selector = "s$selector"; # Everything else is a subfield
330
    }
331
332
    return $self->{$selector} eq $match if (defined $self->{$selector} && defined $match);
333
    return defined $self->{$selector};
334
}
335
336
sub filter {
337
    my ($self, $selectors) = @_;
338
339
    my $result = '';
340
    foreach my $selector (keys %$selectors) {
341
        if ($selector eq 'code') {
342
            foreach my $subf (@{$self->{'subfields'}}) {
343
                if (index($selectors->{$selector}, $subf->code) >= 0) {
344
                    $result .= ' ' if $result;
345
                    $result .= $subf->value;
346
                }
347
            }
348
        }
349
    }
350
    return $result;
351
}
352
353
sub AUTOLOAD {
354
    my $self = shift;
355
    (my $a = $AUTOLOAD) =~ s/.*:://;
356
357
    return $self->{"$a"};
358
}
359
360
1;
361
362
package Koha::Template::Plugin::MARC::Subfield;
363
364
=head2 Koha::Template::Plugin::MARC::Subfield
365
366
Object class to allow nested auto-loading. Not used directly.
367
368
=cut
369
370
371
use Modern::Perl;
372
373
sub new {
374
    my ($class, $code, $value) = @_;
375
376
    bless {
377
        code => $code,
378
        value => $value,
379
    }, $class;
380
}
381
382
sub code {
383
    my $self = shift;
384
    return $self->{'code'};
385
}
386
387
sub value {
388
    my $self = shift;
389
    return $self->{'value'};
390
}
391
392
=head1 AUTHOR
393
394
Jared Camins-Esakov, C & P Bibliography Services <jcamins@cpbibliography.com>
395
396
=cut
397
398
1;
(-)a/t/Template_Plugin_MARC.t (-1 / +102 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
# Copyright C & P Bibliography Services 2012
3
4
# This file is part of Koha.
5
#
6
# Koha is free software; you can redistribute it and/or modify it under the
7
# terms of the GNU General Public License as published by the Free Software
8
# Foundation; either version 3 of the License, or (at your option) any later
9
# version.
10
#
11
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
12
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License along
16
# with Koha; if not, write to the Free Software Foundation, Inc.,
17
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
19
use Modern::Perl;
20
use MARC::Record;
21
use Template;
22
use Test::More tests => 21;
23
24
BEGIN {
25
    use_ok('Koha::Template::Plugin::MARC');
26
}
27
28
my $marc = MARC::Record->new;
29
30
$marc->add_fields(
31
        [ '001', 'abcdefghijklm' ],
32
        [ '100', '1', ' ', a => 'Carter, Philip J.' ],
33
        [ '245', '1', '0', a => 'Test your emotional intelligence :',
34
            b => 'improve your EQ and learn how to impress potential employers.' ],
35
        [ '505', '0', '0', t => 'What is emotional intelligence?',
36
            t => 'Why am I in this handbasket?',
37
            t => 'Where am I going?' ],
38
        [ '520', ' ', ' ', a => 'A thrilling book about EQ testing.' ],
39
        [ '650', ' ', '0', a => 'Emotional intelligence.' ],
40
        [ '650', ' ', '0', a => 'Personality assessment.' ],
41
        [ '650', ' ', '7', a => 'Self-evaluation.' ],
42
        [ '700', '1', '7', a => 'Smith, Jim,',
43
            d => '1900-2000.',
44
            4 => 'edt',
45
            9 => '1234' ],
46
        );
47
48
is(Koha::Template::Plugin::MARC->load({ context => 1}), 'Koha::Template::Plugin::MARC', 'load method returns correct class name');
49
50
my $record = Koha::Template::Plugin::MARC->new({}, $marc);
51
is(ref $record, 'Koha::Template::Plugin::MARC', 'Created expected object');
52
ok(defined $record->marc, 'MARC exists with positional parameters');
53
$record = Koha::Template::Plugin::MARC->new({ marc => $marc });
54
ok(defined $record->marc, 'MARC exists with named parameters');
55
is($record->f001->value, 'abcdefghijklm', 'Accessed control field using direct accessor');
56
is($record->f245->sa, 'Test your emotional intelligence :', 'Accessed 245$a using direct accessor');
57
is($record->f245->all, 'Test your emotional intelligence : improve your EQ and learn how to impress potential employers.', 'Got expected result for whole 245 using all accessor');
58
is($record->f650->sa, 'Emotional intelligence.', 'Retrieved first 650$a as expected using direct accessor');
59
is(scalar @{$record->f650s}, 3, 'Found three 650s using iterable fields accessor');
60
my $concat = '';
61
foreach my $title (@{$record->f505->subfields}) {
62
    $concat .= $title->value . ' -- ';
63
}
64
is($concat, 'What is emotional intelligence? -- Why am I in this handbasket? -- Where am I going? -- ', 'Retrieved 505 using iterable subfields accessor');
65
is(scalar @{$record->f5xxs}, 2, 'Found two notes using section accessor');
66
is(scalar @{$record->fields}, 9, 'Found nine fields using fields accessor');
67
68
is($record->filter({ '4' => 'edt' })->[0]->sa, 'Smith, Jim,', 'Filtered for editor');
69
is($record->filter({ 'tag' => '505' })->[0]->tag, '505', 'Filter for 505 field');
70
is(scalar @{$record->filter({ 'tag' => '650', 'ind2' => '7' })}, 1, 'Filter for 650 field with ind2=7');
71
is(scalar @{$record->filter({ 'ind1' => ' ' })}, 4, 'Filter for fields with ind1=[space]');
72
is(scalar @{$record->filter({ '4' })}, 1, 'Filter for any subfield 4 (the error about there being an odd number of elements was intentional)');
73
is(scalar @{$record->filter({ })}, 9, 'Filtering for nothing returns all fields');
74
75
is($record->f700->filter({ 'code' => 'ad' }), 'Smith, Jim, 1900-2000.', 'Filtered for subfields');
76
77
my $template = Template->new( { INCLUDE_PATH => '.', PLUGIN_BASE => 'Koha::Template::Plugin'} );
78
79
my $example = <<_ENDEXAMPLE_;
80
[%- USE record = MARC(mymarc) %]
81
[%- record.f245.sa %] [% record.f245.sb %]
82
[%- record.f505.all %]
83
[%- FOREACH subj IN record.f650s %]
84
    [%- subj.all %]
85
[%- END %]
86
[%- FOREACH field IN record.fields %]
87
    [%- field.tag %]:
88
    [%- FOREACH subf IN field.subfields %]
89
        [%- subf.code %] => [% subf.value %]
90
    [%- END %]
91
[%- END %]
92
_ENDEXAMPLE_
93
94
# Yes, the expected result is absolute gibberish. Whitespace is nearly
95
# impossible to troubleshoot, and this test works.
96
my $expected = <<_ENDEXPECTED_;
97
Test your emotional intelligence : improve your EQ and learn how to impress potential employers.What is emotional intelligence? Why am I in this handbasket? Where am I going?Emotional intelligence.Personality assessment.Self-evaluation.001:@ => abcdefghijklm100:a => Carter, Philip J.245:a => Test your emotional intelligence :b => improve your EQ and learn how to impress potential employers.505:t => What is emotional intelligence?t => Why am I in this handbasket?t => Where am I going?520:a => A thrilling book about EQ testing.650:a => Emotional intelligence.650:a => Personality assessment.650:a => Self-evaluation.700:a => Smith, Jim,d => 1900-2000.4 => edt9 => 1234
98
_ENDEXPECTED_
99
100
my $output;
101
$template->process(\$example, { 'mymarc' => $marc }, \$output);
102
is($output, $expected, 'Processed template for expected results');

Return to bug 9202