Bug 17586 [QA Followup] - Correct the number of unit tests
[koha.git] / 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 => 4;
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
38 my $schema  = Koha::Database->new->schema;
39 $schema->storage->txn_begin;
40
41 my $dbh = C4::Context->dbh;
42
43 my $biblio_1_title = 'Silence in the library';
44 my $biblio_2_title = 'The art of computer programming ກ ຂ ຄ ງ ຈ ຊ ຍ é';
45 my $biblio_1 = MARC::Record->new();
46 $biblio_1->leader('00266nam a22001097a 4500');
47 $biblio_1->append_fields(
48     MARC::Field->new('100', ' ', ' ', a => 'Moffat, Steven'),
49     MARC::Field->new('245', ' ', ' ', a => $biblio_1_title),
50 );
51 my ($biblionumber_1, $biblioitemnumber_1) = AddBiblio($biblio_1, '');
52 my $biblio_2 = MARC::Record->new();
53 $biblio_2->leader('00266nam a22001097a 4500');
54 $biblio_2->append_fields(
55     MARC::Field->new('100', ' ', ' ', a => 'Knuth, Donald Ervin'),
56     MARC::Field->new('245', ' ', ' ', a => $biblio_2_title),
57 );
58 my ($biblionumber_2, $biblioitemnumber_2) = AddBiblio($biblio_2, '');
59
60 my $bad_biblio = Koha::Biblio->new()->store();
61 my $bad_biblioitem = Koha::Biblioitem->new( { biblionumber => $bad_biblio->id, marcxml => 'something wrong' } )->store();
62 my $bad_biblionumber = $bad_biblio->id;
63
64 my $builder = t::lib::TestBuilder->new;
65 my $item_1_1 = $builder->build({
66     source => 'Item',
67     value => {
68         biblionumber => $biblionumber_1,
69         more_subfields_xml => '',
70     }
71 });
72 my $item_1_2 = $builder->build({
73     source => 'Item',
74     value => {
75         biblionumber => $biblionumber_1,
76         more_subfields_xml => '',
77     }
78 });
79 my $item_2_1 = $builder->build({
80     source => 'Item',
81     value => {
82         biblionumber => $biblionumber_2,
83         more_subfields_xml => '',
84     }
85 });
86 my $bad_item = $builder->build({
87     source => 'Item',
88     value => {
89         biblionumber => $bad_biblionumber,
90         more_subfields_xml => '',
91     }
92 });
93
94 subtest 'export csv' => sub {
95     plan tests => 3;
96     my $csv_content = q{Title=245$a|Barcode=952$p};
97     $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');
98     my $csv_profile_id = $dbh->last_insert_id( undef, undef, 'export_format', undef );
99     my $generated_csv_file = '/tmp/test_export_1.csv';
100
101     # Get all item infos
102     warning_like {
103         Koha::Exporter::Record::export(
104             {   record_type     => 'bibs',
105                 record_ids      => [ $biblionumber_1, $bad_biblionumber, $biblionumber_2 ],
106                 format          => 'csv',
107                 csv_profile_id  => $csv_profile_id,
108                 output_filepath => $generated_csv_file,
109             }
110         );
111     }
112     qr|.*Start tag expected.*|, "Export csv with wrong marcxml should raise a warning";
113     my $expected_csv = <<EOF;
114 Title|Barcode
115 "$biblio_1_title"|$item_1_1->{barcode},$item_1_2->{barcode}
116 "$biblio_2_title"|$item_2_1->{barcode}
117 EOF
118     my $generated_csv_content = read_file( $generated_csv_file );
119     is( $generated_csv_content, $expected_csv, "Export CSV: All item's infos should have been retrieved" );
120
121     $generated_csv_file = '/tmp/test_export.csv';
122     # Get only 1 item info
123     Koha::Exporter::Record::export(
124         {
125             record_type => 'bibs',
126             record_ids => [ $biblionumber_1, $biblionumber_2 ],
127             itemnumbers => [ $item_1_1->{itemnumber}, $item_2_1->{itemnumber} ],
128             format => 'csv',
129             csv_profile_id => $csv_profile_id,
130             output_filepath => $generated_csv_file,
131         }
132     );
133     $expected_csv = <<EOF;
134 Title|Barcode
135 "$biblio_1_title"|$item_1_1->{barcode}
136 "$biblio_2_title"|$item_2_1->{barcode}
137 EOF
138     $generated_csv_content = read_file( $generated_csv_file );
139     is( $generated_csv_content, $expected_csv, "Export CSV: Only 1 item info should have been retrieved" );
140 };
141
142 subtest 'export xml' => sub {
143     plan tests => 3;
144     my $generated_xml_file = '/tmp/test_export.xml';
145     warning_like {
146         Koha::Exporter::Record::export(
147             {   record_type     => 'bibs',
148                 record_ids      => [ $biblionumber_1, $bad_biblionumber, $biblionumber_2 ],
149                 format          => 'xml',
150                 output_filepath => $generated_xml_file,
151             }
152         );
153     }
154     qr|.*Start tag expected.*|, "Export xml with wrong marcxml should raise a warning";
155
156     my $generated_xml_content = read_file( $generated_xml_file );
157     $MARC::File::XML::_load_args{BinaryEncoding} = 'utf-8';
158     open my $fh, '<', $generated_xml_file;
159     my $records = MARC::Batch->new( 'XML', $fh );
160     my @records;
161     # The following statement produces
162     # Use of uninitialized value in concatenation (.) or string at /usr/share/perl5/MARC/File/XML.pm line 398, <$fh> chunk 5.
163     # Why?
164     while ( my $record = $records->next ) {
165         push @records, $record;
166     }
167     is( scalar( @records ), 2, 'Export XML: 2 records should have been exported' );
168     my $second_record = $records[1];
169     my $title = $second_record->subfield(245, 'a');
170     $title = Encode::encode('UTF-8', $title);
171     is( $title, $biblio_2_title, 'Export XML: The title is correctly encoded' );
172 };
173
174 subtest 'export iso2709' => sub {
175     plan tests => 3;
176     my $generated_mrc_file = '/tmp/test_export.mrc';
177     # Get all item infos
178     warning_like {
179         Koha::Exporter::Record::export(
180             {   record_type     => 'bibs',
181                 record_ids      => [ $biblionumber_1, $bad_biblionumber, $biblionumber_2 ],
182                 format          => 'iso2709',
183                 output_filepath => $generated_mrc_file,
184             }
185         );
186     }
187     qr|.*Start tag expected.*|, "Export iso2709 with wrong marcxml should raise a warning";
188
189     my $records = MARC::File::USMARC->in( $generated_mrc_file );
190     my @records;
191     while ( my $record = $records->next ) {
192         push @records, $record;
193     }
194     is( scalar( @records ), 2, 'Export ISO2709: 2 records should have been exported' );
195     my $second_record = $records[1];
196     my $title = $second_record->subfield(245, 'a');
197     $title = Encode::encode('UTF-8', $title);
198     is( $title, $biblio_2_title, 'Export ISO2709: The title is correctly encoded' );
199 };
200
201 subtest 'export without record_type' => sub {
202     plan tests => 1;
203
204     my $rv = Koha::Exporter::Record::export({
205             record_ids => [ $biblionumber_1, $biblionumber_2 ],
206             format => 'iso2709',
207             output_filepath => 'does_not_matter_here',
208     });
209     is( $rv, undef, 'export returns undef' );
210     #Depending on your logger config, you might have a warn in your logs
211 };
212
213 $schema->storage->txn_rollback;
214
215 1;