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;