Attachment #13949 for bug #9202

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




package Koha::Template::Plugin::MARC;

# Copyright C & P Bibliography Services 2012

# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

=head1 NAME

Koha::Template::Plugin::MARC - Template::Toolkit to make MARC friendly

=head1 SYNOPSIS

[% USE record = MARC(mymarc) %] <!-- translate MARC::Record to T::T hash -->
<h1>[% record.f245.sa %]</h1> <!-- subfield 245$a -->
[% record.f245.all %] <!-- all subfields concatenated together -->
[% FOREACH link IN record.f856s %] <!-- process each 856 field -->
    <a href="whatever/[% link.su %]">[% link.sy %]</a> <!-- create a link on 856$y -->
[% END %] <!-- /FOREACH link IN record.856s -->
[% FOREACH contents IN record.f505s %] <!-- process each 505 field -->
    [% FOREACH subf IN contents.subfields %] <!-- process each subfield -->
        [% SWITCH subf.code %]
        [% CASE 'a' %]
            <span class='contents'>[% subf.value %]</span>
        [% CASE 't' %]
            <span class='title'>[% subf.value %]</span>
        [% CASE 'r' %]
            <span class='responsibility'>[% subf.value %]</span>
        [% END %]
    [% END %] <!-- /FOREACH contents.subfields -->
[% END %] <!-- /FOREACH contents IN record.f505s -->
[% FOREACH subj IN record.f6xxs %]
    <a href="whatever/[% subj.s9 %]">[% subj.sa %]</a> <!-- create a link on 6[0-9]{2}$a -->
[% END %]
[% FOREACH field IN record.fields %]
    [% SWITCH field.tag %]
    [% CASE '600' %]
        Subject: [% field.all %] is what we are all about
    [% CASE '700' %]
        Co-author: [% field.all %], I presume?
    [% END %]
[% END %]

=head1 DESCRIPTION

A Template::Toolkit plugin which given a MARC::Record object parses it into a
hash that can be accessed directly in Template::Toolkit.

=head1 ACCESSORS

By using some clever AUTOLOAD acrobatics, this plugin offers the user six
types of accessors.

=head2 Direct accessors

    [% record.f245.sa %]
    
    print $record->f245->sa;

By prefixing field numbers with an 'f' and subfield codes with an 's', the first
field/subfield with a given tag/code can be accessed.

=head2 Concatenated accessors

    [% record.f245.all %]
    
    print $record->f245->all;

A string consisting of all subfields concatenated together is accessible through
the all member of field objects.

=head2 Subfield iterators

    [% FOREACH subfield IN record.f245.subfields %]
        [% subfield.code %] = [% subfield.value %]
    [% END %]

    foreach my $subfield ($record->f245) {
        print $subfield->code, ' = ', $subfield->value;
    }

Subfield iterators are accessible through the subfields member of field objects.

=head2 Field iterators

    [% FOREACH field IN record.f500s %]
        [% field.all %]
    [% END %]

    foreach my $field ($record->f500s) {
        print $field->all;
    }

Field iterators are accessible by adding an 's' to the end of field names:
f500s, etc.

=head2 Section iterators

    [% FOREACH field IN record.f5xxs %]
        [% field.all %]
    [% END %]

    foreach my $field ($record->f5xxs) {
        print $field->all;
    }

All the fields in a section (identified by the first digit of the tag) can
be accessed with 'fNxxs' and then iterated through.

=head2 Complete field list

    [% FOREACH field IN record.fields %]
        [% field.all %]
    [% END %]

    foreach my $field ($record->fields) {
        print $field->all;
    }

All the fields in a record can be accessed via the fields object method.

=head1 WHAT THIS PLUGIN DOES NOT DO

This plugin will not sanity-check your code to make sure that you are accessing
fields and subfields with proper allowances for repetition. If you access a value
using [% record.f505.st %] it is presumed that was intentional, and there will be
no warning or error of any sort.

However, the flip-side of this is that this plugin will not dictate your code
style. You can access the data using direct (non-repeatable) accessors, by
iterating over subfields, by iterating over subfields of a specific tag, by
iterating over fields in a particular block (0xx, 1xx, 2xx, etc.), or by
iterating over all fields.

=cut

use Modern::Perl;
use MARC::Record;
use MARC::Field;

use Template::Plugin;
use base qw( Template::Plugin );

our $AUTOLOAD;

=head1 METHODS

=head2 load

Used by Template::Toolkit for loading this plugin.

=cut

sub load {
    my ($class, $context) = @_;
    return $class;
}

=head2 new

Instantiates a new object for the given MARC::Record. Can be called
using any of the following declarations:

    [% USE MARC(mymarc) %]
    [% USE marc(mymarc) %]
    [% USE MARC mymarc %]
    [% USE MARC(marc=mymarc) %]
    [% USE MARC marc=mymarc %]

When run from Perl, the object can be created with either of the following
two calling conventions:

    $record = Koha::Template::Plugin::MARC->new({}, $marc, [\%config]);
    $record = Koha::Template::Plugin::MARC->new([$context], { marc => $marc });

The $context hashref passed as the first argument is mandatory when using
positional parameters and optional when using named parameters.

=cut

sub new {
    my $config = ref($_[-1]) eq 'HASH' ? pop(@_) : { };
    my ($class, $context, $marc) = @_;

    # marc can be a positional or named argument
    $marc = $config->{'marc'} unless defined $marc;

    bless { 
        %$config,
            marc => $marc,
    }, $class;
}

=head2 init

Initializes the MARC object. This is called only on the first access attempt
on the object, to avoid unnecessary processing.

=cut

sub init {
    my $self = shift;
    return $self if $self->{'record'};

    my $recordhash = { fields => [] };

    foreach my $field ($self->{'marc'}->fields()) {
        my $fieldobj = Koha::Template::Plugin::MARC::Field->new($field);
        my $tag = $fieldobj->tag();
        my $section = 'f' . substr($tag, 0, 1) . 'xxs';
        $recordhash->{"f$tag"} = $fieldobj unless $recordhash->{"f$tag"};
        $recordhash->{"f$tag" . 's'} = [] unless $recordhash->{"f$tag" . 's'};
        push @{$recordhash->{"f$tag" . 's'}}, $fieldobj;
        $recordhash->{"$section"} = [] unless $recordhash->{"$section"};
        push @{$recordhash->{"$section"}}, $fieldobj;
        push @{$recordhash->{'fields'}}, $fieldobj;
    }

    $self->{'record'} = $recordhash;
    return $self;
}

=head2 filter

    $record->filter({ '4' => 'edt' })->[0]->sa

    [% record.filter('4'='edt').0.sa

Filters a set of fields according to the specified criteria

=cut

sub filter {
    my ($self, $selectors) = @_;

    $self->init();

    my $fields = $self->{'record'}->{'fields'};
    foreach my $selector (keys %$selectors) {
        my $possibilities = [];
        foreach my $testfield (@$fields) {
            push @$possibilities, $testfield if $testfield->has($selector, $selectors->{$selector});
        }
        $fields = $possibilities;
    }

    return $fields;
}

=head2 marc

Returns the MARC::Record object associated with the instance.

=cut

sub marc {
    my $self = shift;
    return $self->{'marc'};
}

sub AUTOLOAD {
    my $self = shift;
    (my $a = $AUTOLOAD) =~ s/.*:://;

    $self->init;
    
    return $self->{'record'}->{"$a"};
}

1;

=head1 HELPER CLASSES

=cut

package Koha::Template::Plugin::MARC::Field;

=head2 Koha::Template::Plugin::MARC::Field

Object class to allow nested auto-loading. Not used directly.

=cut

use Modern::Perl;
use MARC::Field;

our $AUTOLOAD;

sub new {
    my ($class, $field) = @_;
    my $fieldhash = {
        'tag' => $field->tag(),
        'subfields' => [],
    };
    if ($field->is_control_field()) {
        $fieldhash->{'value'} = $field->data();
            push $fieldhash->{'subfields'}, Koha::Template::Plugin::MARC::Subfield->new('@' => $field->data());
    } else {
        $fieldhash->{'ind1'} = $field->indicator(1);
        $fieldhash->{'ind2'} = $field->indicator(2);
        my @subfields = $field->subfields();
        foreach my $subf (@subfields) {
            $fieldhash->{"s$subf->[0]"} = $subf->[1] unless $fieldhash->{"s$subf->[0]"};
            $fieldhash->{'all'} .= ' ' if $fieldhash->{'all'};
            $fieldhash->{'all'} .= $subf->[1];
            push $fieldhash->{'subfields'}, Koha::Template::Plugin::MARC::Subfield->new($subf->[0] => $subf->[1]);
        }
    }

    bless $fieldhash, $class;
}

sub has {
    my ($self, $selector, $match) = @_;

    unless ($selector eq 'ind1' || $selector eq 'ind2' || $selector eq 'tag') {
        $selector = "s$selector"; # Everything else is a subfield
    }

    return $self->{$selector} eq $match if (defined $self->{$selector} && defined $match);
    return defined $self->{$selector};
}

sub filter {
    my ($self, $selectors) = @_;

    my $result = '';
    foreach my $selector (keys %$selectors) {
        if ($selector eq 'code') {
            foreach my $subf (@{$self->{'subfields'}}) {
                if (index($selectors->{$selector}, $subf->code) >= 0) {
                    $result .= ' ' if $result;
                    $result .= $subf->value;
                }
            }
        }
    }
    return $result;
}

sub AUTOLOAD {
    my $self = shift;
    (my $a = $AUTOLOAD) =~ s/.*:://;

    return $self->{"$a"};
}

1;

package Koha::Template::Plugin::MARC::Subfield;

=head2 Koha::Template::Plugin::MARC::Subfield

Object class to allow nested auto-loading. Not used directly.

=cut


use Modern::Perl;

sub new {
    my ($class, $code, $value) = @_;

    bless {
        code => $code,
        value => $value,
    }, $class;
}

sub code {
    my $self = shift;
    return $self->{'code'};
}

sub value {
    my $self = shift;
    return $self->{'value'};
}

=head1 AUTHOR

Jared Camins-Esakov, C & P Bibliography Services <jcamins@cpbibliography.com>

=cut

1;




#!/usr/bin/perl
# Copyright C & P Bibliography Services 2012

# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;
use MARC::Record;
use Template;
use Test::More tests => 21;

BEGIN {
    use_ok('Koha::Template::Plugin::MARC');
}

my $marc = MARC::Record->new;

$marc->add_fields(
        [ '001', 'abcdefghijklm' ],
        [ '100', '1', ' ', a => 'Carter, Philip J.' ],
        [ '245', '1', '0', a => 'Test your emotional intelligence :',
            b => 'improve your EQ and learn how to impress potential employers.' ],
        [ '505', '0', '0', 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', ' ', '0', a => 'Emotional intelligence.' ],
        [ '650', ' ', '0', a => 'Personality assessment.' ],
        [ '650', ' ', '7', a => 'Self-evaluation.' ],
        [ '700', '1', '7', a => 'Smith, Jim,',
            d => '1900-2000.',
            4 => 'edt',
            9 => '1234' ],
        );

is(Koha::Template::Plugin::MARC->load({ context => 1}), 'Koha::Template::Plugin::MARC', 'load method returns correct class name');

my $record = Koha::Template::Plugin::MARC->new({}, $marc);
is(ref $record, 'Koha::Template::Plugin::MARC', 'Created expected object');
ok(defined $record->marc, 'MARC exists with positional parameters');
$record = Koha::Template::Plugin::MARC->new({ marc => $marc });
ok(defined $record->marc, 'MARC exists with named parameters');
is($record->f001->value, 'abcdefghijklm', 'Accessed control field using direct accessor');
is($record->f245->sa, 'Test your emotional intelligence :', 'Accessed 245$a using direct accessor');
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');
is($record->f650->sa, 'Emotional intelligence.', 'Retrieved first 650$a as expected using direct accessor');
is(scalar @{$record->f650s}, 3, 'Found three 650s using iterable fields accessor');
my $concat = '';
foreach my $title (@{$record->f505->subfields}) {
    $concat .= $title->value . ' -- ';
}
is($concat, 'What is emotional intelligence? -- Why am I in this handbasket? -- Where am I going? -- ', 'Retrieved 505 using iterable subfields accessor');
is(scalar @{$record->f5xxs}, 2, 'Found two notes using section accessor');
is(scalar @{$record->fields}, 9, 'Found nine fields using fields accessor');

is($record->filter({ '4' => 'edt' })->[0]->sa, 'Smith, Jim,', 'Filtered for editor');
is($record->filter({ 'tag' => '505' })->[0]->tag, '505', 'Filter for 505 field');
is(scalar @{$record->filter({ 'tag' => '650', 'ind2' => '7' })}, 1, 'Filter for 650 field with ind2=7');
is(scalar @{$record->filter({ 'ind1' => ' ' })}, 4, 'Filter for fields with ind1=[space]');
is(scalar @{$record->filter({ '4' })}, 1, 'Filter for any subfield 4 (the error about there being an odd number of elements was intentional)');
is(scalar @{$record->filter({ })}, 9, 'Filtering for nothing returns all fields');

is($record->f700->filter({ 'code' => 'ad' }), 'Smith, Jim, 1900-2000.', 'Filtered for subfields');

my $template = Template->new( { INCLUDE_PATH => '.', PLUGIN_BASE => 'Koha::Template::Plugin'} );

my $example = <<_ENDEXAMPLE_;
[%- USE record = MARC(mymarc) %]
[%- record.f245.sa %] [% record.f245.sb %]
[%- record.f505.all %]
[%- FOREACH subj IN record.f650s %]
    [%- subj.all %]
[%- END %]
[%- FOREACH field IN record.fields %]
    [%- field.tag %]:
    [%- FOREACH subf IN field.subfields %]
        [%- subf.code %] => [% subf.value %]
    [%- END %]
[%- END %]
_ENDEXAMPLE_

# Yes, the expected result is absolute gibberish. Whitespace is nearly
# impossible to troubleshoot, and this test works.
my $expected = <<_ENDEXPECTED_;
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
_ENDEXPECTED_

my $output;
$template->process(\$example, { 'mymarc' => $marc }, \$output);
is($output, $expected, 'Processed template for expected results');

Return to bug 9202

Line 0 Link Here

(-)a/Koha/Template/Plugin/MARC.pm (+398 lines)
		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;

Line 0 Link Here

(-)a/t/Template_Plugin_MARC.t (-1 / +102 lines)
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');