9993d7874ba396619e54f12ed167e2d55199a400
[srvgit] / t / db_dependent / Exporter / Record.t
1 #!/usr/bin/perl
2
3 # This file is part of Koha.
4 #
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
9 #
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18 use Modern::Perl;
19
20 use Test::More tests => 6;
21 use Test::Warn;
22 use t::lib::TestBuilder;
23
24 use MARC::Record;
25 use MARC::File::USMARC;
26 use MARC::File::XML;
27 use MARC::Batch;
28 use File::Slurp;
29 use Encode;
30
31 use C4::Biblio;
32 use C4::Context;
33 use Koha::Database;
34 use Koha::Biblio;
35 use Koha::Biblioitem;
36 use Koha::Exporter::Record;
37 use Koha::Biblio::Metadatas;
38
39 my $schema  = Koha::Database->new->schema;
40 $schema->storage->txn_begin;
41
42 my $dbh = C4::Context->dbh;
43
44 my $biblio_1_title = 'Silence in the library';
45 my $biblio_2_title = 'The art of computer programming ກ ຂ ຄ ງ ຈ ຊ ຍ é';
46 my $biblio_1 = MARC::Record->new();
47 $biblio_1->leader('00266nam a22001097a 4500');
48 $biblio_1->append_fields(
49     MARC::Field->new('100', ' ', ' ', a => 'Moffat, Steven'),
50     MARC::Field->new('245', ' ', ' ', a => $biblio_1_title),
51 );
52 my ($biblionumber_1, $biblioitemnumber_1) = AddBiblio($biblio_1, '');
53 my $biblio_2 = MARC::Record->new();
54 $biblio_2->leader('00266nam a22001097a 4500');
55 $biblio_2->append_fields(
56     MARC::Field->new('100', ' ', ' ', a => 'Knuth, Donald Ervin'),
57     MARC::Field->new('245', ' ', ' ', a => $biblio_2_title),
58 );
59 my ($biblionumber_2, $biblioitemnumber_2) = AddBiblio($biblio_2, '');
60
61 my $bad_biblio = Koha::Biblio->new()->store();
62 Koha::Biblio::Metadata->new( { biblionumber => $bad_biblio->id, format => 'marcxml', metadata => 'something wrong', schema => C4::Context->preference('marcflavour') } )->store();
63 my $bad_biblionumber = $bad_biblio->id;
64
65 my $builder = t::lib::TestBuilder->new;
66 my $item_1_1 = $builder->build_sample_item(
67     {
68         biblionumber => $biblionumber_1,
69     }
70 )->unblessed;
71 my $item_1_2 = $builder->build_sample_item(
72     {
73         biblionumber => $biblionumber_1,
74     }
75 )->unblessed;
76 my $item_2_1 = $builder->build_sample_item(
77     {
78         biblionumber => $biblionumber_2,
79     }
80 )->unblessed;
81 my $bad_item = $builder->build({ # Cannot call build_sample_item, we want inconsistent data on purpose
82     source => 'Item',
83     value => {
84         biblionumber => $bad_biblionumber,
85     }
86 });
87
88 subtest 'export csv' => sub {
89     plan tests => 3;
90     my $csv_content = q{Title=245$a|Barcode=952$p};
91     $dbh->do(q|INSERT INTO export_format(profile, description, content, csv_separator, field_separator, subfield_separator, encoding, type) VALUES (?, ?, ?, ?, ?, ?, ?, ?)|, {}, "TEST_PROFILE_Records.t", "my useless desc", $csv_content, '|', ';', ',', 'utf8', 'marc');
92     my $csv_profile_id = $dbh->last_insert_id( undef, undef, 'export_format', undef );
93     my $generated_csv_file = '/tmp/test_export_1.csv';
94
95     # Get all item infos
96     warning_like {
97         Koha::Exporter::Record::export(
98             {   record_type     => 'bibs',
99                 record_ids      => [ $biblionumber_1, $bad_biblionumber, $biblionumber_2 ],
100                 format          => 'csv',
101                 csv_profile_id  => $csv_profile_id,
102                 output_filepath => $generated_csv_file,
103             }
104         );
105     }
106     qr|.*Start tag expected.*|, "Export csv with wrong marcxml should raise a warning";
107     my $expected_csv = <<EOF;
108 Title|Barcode
109 "$biblio_1_title"|$item_1_1->{barcode},$item_1_2->{barcode}
110 "$biblio_2_title"|$item_2_1->{barcode}
111 EOF
112     my $generated_csv_content = read_file( $generated_csv_file );
113     is( $generated_csv_content, $expected_csv, "Export CSV: All item's infos should have been retrieved" );
114
115     $generated_csv_file = '/tmp/test_export.csv';
116     # Get only 1 item info
117     Koha::Exporter::Record::export(
118         {
119             record_type => 'bibs',
120             record_ids => [ $biblionumber_1, $biblionumber_2 ],
121             itemnumbers => [ $item_1_1->{itemnumber}, $item_2_1->{itemnumber} ],
122             format => 'csv',
123             csv_profile_id => $csv_profile_id,
124             output_filepath => $generated_csv_file,
125         }
126     );
127     $expected_csv = <<EOF;
128 Title|Barcode
129 "$biblio_1_title"|$item_1_1->{barcode}
130 "$biblio_2_title"|$item_2_1->{barcode}
131 EOF
132     $generated_csv_content = read_file( $generated_csv_file );
133     is( $generated_csv_content, $expected_csv, "Export CSV: Only 1 item info should have been retrieved" );
134 };
135
136 subtest 'export xml' => sub {
137     plan tests => 3;
138     my $generated_xml_file = '/tmp/test_export.xml';
139     warning_like {
140         Koha::Exporter::Record::export(
141             {   record_type     => 'bibs',
142                 record_ids      => [ $biblionumber_1, $bad_biblionumber, $biblionumber_2 ],
143                 format          => 'xml',
144                 output_filepath => $generated_xml_file,
145             }
146         );
147     }
148     qr|.*Start tag expected.*|, "Export xml with wrong marcxml should raise a warning";
149
150     my $generated_xml_content = read_file( $generated_xml_file );
151     $MARC::File::XML::_load_args{BinaryEncoding} = 'utf-8';
152     open my $fh, '<', $generated_xml_file;
153     my $records = MARC::Batch->new( 'XML', $fh );
154     my @records;
155     # The following statement produces
156     # Use of uninitialized value in concatenation (.) or string at /usr/share/perl5/MARC/File/XML.pm line 398, <$fh> chunk 5.
157     # Why?
158     while ( my $record = $records->next ) {
159         push @records, $record;
160     }
161     is( scalar( @records ), 2, 'Export XML: 2 records should have been exported' );
162     my $second_record = $records[1];
163     my $title = $second_record->subfield(245, 'a');
164     $title = Encode::encode('UTF-8', $title);
165     is( $title, $biblio_2_title, 'Export XML: The title is correctly encoded' );
166 };
167
168 subtest 'export iso2709' => sub {
169     plan tests => 3;
170     my $generated_mrc_file = '/tmp/test_export.mrc';
171     # Get all item infos
172     warning_like {
173         Koha::Exporter::Record::export(
174             {   record_type     => 'bibs',
175                 record_ids      => [ $biblionumber_1, $bad_biblionumber, $biblionumber_2 ],
176                 format          => 'iso2709',
177                 output_filepath => $generated_mrc_file,
178             }
179         );
180     }
181     qr|.*Start tag expected.*|, "Export iso2709 with wrong marcxml should raise a warning";
182
183     my $records = MARC::File::USMARC->in( $generated_mrc_file );
184     my @records;
185     while ( my $record = $records->next ) {
186         push @records, $record;
187     }
188     is( scalar( @records ), 2, 'Export ISO2709: 2 records should have been exported' );
189     my $second_record = $records[1];
190     my $title = $second_record->subfield(245, 'a');
191     $title = Encode::encode('UTF-8', $title);
192     is( $title, $biblio_2_title, 'Export ISO2709: The title is correctly encoded' );
193 };
194
195 subtest 'export without record_type' => sub {
196     plan tests => 1;
197
198     my $rv = Koha::Exporter::Record::export({
199             record_ids => [ $biblionumber_1, $biblionumber_2 ],
200             format => 'iso2709',
201             output_filepath => 'does_not_matter_here',
202     });
203     is( $rv, undef, 'export returns undef' );
204     #Depending on your logger config, you might have a warn in your logs
205 };
206
207 subtest '_get_biblio_for_export' => sub {
208     plan tests => 4;
209
210     my $biblio = MARC::Record->new();
211     $biblio->leader('00266nam a22001097a 4500');
212     $biblio->append_fields(
213         MARC::Field->new( '100', ' ', ' ', a => 'Thurber, James' ),
214         MARC::Field->new( '245', ' ', ' ', a => "The 13 Clocks" ),
215     );
216     my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $biblio, '' );
217     my $branch_a = $builder->build({source => 'Branch',});
218     my $branch_b = $builder->build({source => 'Branch',});
219     my $item_branch_a = $builder->build_sample_item(
220         {
221             biblionumber => $biblionumber,
222             library      => $branch_a->{branchcode},
223         }
224     );
225     my $item_branch_b = $builder->build_sample_item(
226         {
227             biblionumber => $biblionumber,
228             library      => $branch_b->{branchcode},
229         }
230     );
231
232     my $record = Koha::Exporter::Record::_get_biblio_for_export(
233         {
234             biblionumber                   => $biblionumber,
235             export_items                   => 1,
236             only_export_items_for_branches => undef
237         }
238     );
239     my @items = $record->field('952');
240     is( scalar @items, 2, "We should retrieve all items if we don't pass specific branches and request items" );
241
242     $record = Koha::Exporter::Record::_get_biblio_for_export(
243         {
244             biblionumber                   => $biblionumber,
245             export_items                   => 1,
246             only_export_items_for_branches => [ $branch_b->{branchcode} ]
247         }
248     );
249     @items = $record->field('952');
250     is( scalar @items, 1, "We should retrieve only item for branch_b item if we request items and pass branch" );
251     is(
252         $items[0]->subfield('a'),
253         $branch_b->{branchcode},
254         "And the homebranch for that item should be branch_b branchcode"
255     );
256
257     $record = Koha::Exporter::Record::_get_biblio_for_export(
258         {
259             biblionumber                   => $biblionumber,
260             export_items                   => 0,
261             only_export_items_for_branches => [ $branch_b->{branchcode} ]
262         }
263     );
264     @items = $record->field('952');
265     is( scalar @items, 0, "We should not have any items if we don't request items and pass a branch");
266
267 };
268
269 subtest '_get_record_for_export MARC field conditions' => sub {
270     plan tests => 11;
271
272     my $biblio = MARC::Record->new();
273     $biblio->leader('00266nam a22001097a 4500');
274     $biblio->append_fields(
275         MARC::Field->new( '100', ' ', ' ', a => 'Thurber, James' ),
276         MARC::Field->new( '245', ' ', ' ', a => 'The 13 Clocks' ),
277         MARC::Field->new( '080', ' ', ' ', a => '12345' ),
278         MARC::Field->new( '035', ' ', ' ', a => '(TEST)123' ),
279         MARC::Field->new( '035', ' ', ' ', a => '(TEST)1234' ),
280     );
281     my ( $biblionumber ) = AddBiblio( $biblio, '' );
282     my $record;
283
284     $record = Koha::Exporter::Record::_get_record_for_export(
285         {
286             record_id => $biblionumber,
287             record_conditions => [['080', 'a', '=', '12345']],
288             record_type => 'bibs',
289         }
290     );
291     ok( $record, "Record condition \"080a=12345\" should match" );
292
293     $record = Koha::Exporter::Record::_get_record_for_export(
294         {
295             record_id => $biblionumber,
296             record_conditions => [['080', 'a', '!=', '12345']],
297             record_type => 'bibs',
298         }
299     );
300     is( $record, undef, "Record condition \"080a!=12345\" should not match" );
301
302     $record = Koha::Exporter::Record::_get_record_for_export(
303         {
304             record_id => $biblionumber,
305             record_conditions => [['080', 'a', '>', '1234']],
306             record_type => 'bibs',
307         }
308     );
309     ok( $record, "Record condition \"080a>1234\" should match" );
310
311     $record = Koha::Exporter::Record::_get_record_for_export(
312         {
313             record_id => $biblionumber,
314             record_conditions => [['080', 'a', '<', '123456']],
315             record_type => 'bibs',
316         }
317     );
318     ok( $record, "Record condition \"080a<123456\" should match" );
319
320     $record = Koha::Exporter::Record::_get_record_for_export(
321         {
322             record_id => $biblionumber,
323             record_conditions => [['080', 'a', '>', '123456']],
324             record_type => 'bibs',
325         }
326     );
327     is( $record, undef, "Record condition \"080a>123456\" should not match" );
328
329
330     ## Multiple subfields
331
332     $record = Koha::Exporter::Record::_get_record_for_export(
333         {
334             record_id => $biblionumber,
335             record_conditions => [['035', 'a', '!=', 'TEST(12345)']],
336             record_type => 'bibs',
337         }
338     );
339     ok( $record, "Record condition \"035a!=TEST(12345)\" should match" );
340
341     $record = Koha::Exporter::Record::_get_record_for_export(
342         {
343             record_id => $biblionumber,
344             record_conditions => [['035', 'a', '=', 'TEST(1234)']],
345             record_type => 'bibs',
346         }
347     );
348     is( $record, undef, "Record condition \"035a=TEST(1234)\" should not match" ); # Since matching all subfields required
349
350
351     ## Multiple conditions
352
353     $record = Koha::Exporter::Record::_get_record_for_export(
354         {
355             record_id => $biblionumber,
356             record_conditions => [['035', 'a', '!=', 'TEST(12345)'], ['080', 'a', '>', '1234']],
357             record_type => 'bibs',
358         }
359     );
360     ok( $record, "Record condition \"035a!=TEST(12345),080a>1234\" should match" );
361
362     $record = Koha::Exporter::Record::_get_record_for_export(
363         {
364             record_id => $biblionumber,
365             record_conditions => [['035', 'a', '!=', 'TEST(12345)'], ['080', 'a', '<', '1234']],
366             record_type => 'bibs',
367         }
368     );
369     is( $record, undef, "Record condition \"035a!=TEST(12345),080a<1234\" should not match" );
370
371
372     ## exists/not_exists
373
374     $record = Koha::Exporter::Record::_get_record_for_export(
375         {
376             record_id => $biblionumber,
377             record_conditions => [['035', 'a', '?']],
378             record_type => 'bibs',
379         }
380     );
381     ok( $record, "Record condition \"exists(035a)\" should match" );
382
383     $record = Koha::Exporter::Record::_get_record_for_export(
384         {
385             record_id => $biblionumber,
386             record_conditions => [['035', 'a', '!?']],
387             record_type => 'bibs',
388             record_type => 'bibs',
389         }
390     );
391     is( $record, undef, "Record condition \"not_exists(035a)\" should not match" );
392 };
393
394 $schema->storage->txn_rollback;