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

(-)a/t/db_dependent/database_dependent.pl (-35 lines)
Lines 1-35 Link Here
1
#!/usr/bin/perl
2
3
use warnings;
4
use strict;
5
6
=head2
7
8
9
10
=cut
11
12
use C4::Context;
13
use Data::Dumper;
14
use Test::More;
15
16
use Test::Class::Load qw ( . ); # run from the t/db_dependent directory
17
18
KohaTest::clear_test_database();
19
KohaTest::create_test_database();
20
21
KohaTest::start_zebrasrv();
22
KohaTest::start_zebraqueue_daemon();
23
24
if ($ENV{'TEST_CLASS'}) {
25
    # assume only one test class is specified;
26
    # should extend to allow multiples, but that will 
27
    # mean changing how test classes are loaded.
28
    eval "KohaTest::$ENV{'TEST_CLASS'}->runtests";
29
} else {
30
    Test::Class->runtests;
31
}
32
33
KohaTest::stop_zebraqueue_daemon();
34
KohaTest::stop_zebrasrv();
35
(-)a/t/db_dependent/lib/KohaTest.pm (-834 lines)
Lines 1-834 Link Here
1
package KohaTest;
2
use base qw(Test::Class);
3
4
use Test::More;
5
use Data::Dumper;
6
7
eval "use Test::Class";
8
plan skip_all => "Test::Class required for performing database tests" if $@;
9
# Or, maybe I should just die there.
10
11
use C4::Auth;
12
use C4::Biblio;
13
use C4::Bookseller qw( AddBookseller );
14
use C4::Context;
15
use C4::Items;
16
use C4::Members;
17
use C4::Search;
18
use C4::Installer;
19
use C4::Languages;
20
use File::Temp qw/ tempdir /;
21
use CGI;
22
use Time::localtime;
23
24
# Since this is an abstract base class, this prevents these tests from
25
# being run directly unless we're testing a subclass. It just makes
26
# things faster.
27
__PACKAGE__->SKIP_CLASS( 1 );
28
29
INIT {
30
    if ($ENV{SINGLE_TEST}) {
31
        # if we're running the tests in one
32
        # or more test files specified via
33
        #
34
        #   make test-single TEST_FILES=lib/KohaTest/Foo.pm
35
        #
36
        # use this INIT trick taken from the POD for
37
        # Test::Class::Load.
38
        start_zebrasrv();
39
        Test::Class->runtests;
40
        stop_zebrasrv();
41
    }
42
}
43
44
use Attribute::Handlers;
45
46
=head2 Expensive test method attribute
47
48
If a test method is decorated with an Expensive
49
attribute, it is skipped unless the RUN_EXPENSIVE_TESTS
50
environment variable is defined.
51
52
To declare an entire test class and its subclasses expensive,
53
define a SKIP_CLASS with the Expensive attribute:
54
55
    sub SKIP_CLASS : Expensive { }
56
57
=cut
58
59
sub Expensive : ATTR(CODE) {
60
    my ($package, $symbol, $sub, $attr, $data, $phase) = @_;
61
    my $name = *{$symbol}{NAME};
62
    if ($name eq 'SKIP_CLASS') {
63
        if ($ENV{'RUN_EXPENSIVE_TESTS'}) {
64
            *{$symbol} = sub { 0; }
65
        } else {
66
            *{$symbol} = sub { "Skipping expensive test classes $package (and subclasses)"; }
67
        }
68
    } else {
69
        unless ($ENV{'RUN_EXPENSIVE_TESTS'}) {
70
            # a test method that runs no tests and just returns a scalar is viewed by Test::Class as a skip
71
            *{$symbol} = sub { "Skipping expensive test $package\:\:$name"; }
72
        }
73
    }
74
}
75
76
=head2 startup methods
77
78
these are run once, at the beginning of the whole test suite
79
80
=cut
81
82
sub startup_15_truncate_tables : Test( startup => 1 ) {
83
    my $self = shift;
84
85
#     my @truncate_tables = qw( accountlines
86
#                               accountoffsets
87
#                               action_logs
88
#                               alert
89
#                               aqbasket
90
#                               aqbookfund
91
#                               aqbooksellers
92
#                               aqbudget
93
#                               aqorderdelivery
94
#                               aqorders
95
#                               auth_header
96
#                               auth_subfield_structure
97
#                               auth_tag_structure
98
#                               auth_types
99
#                               authorised_values
100
#                               biblio
101
#                               biblio_framework
102
#                               biblioitems
103
#                               borrowers
104
#                               branchcategories
105
#                               branches
106
#                               branchrelations
107
#                               branchtransfers
108
#                               browser
109
#                               categories
110
#                               cities
111
#                               class_sort_rules
112
#                               class_sources
113
#                               currency
114
#                               deletedbiblio
115
#                               deletedbiblioitems
116
#                               deletedborrowers
117
#                               deleteditems
118
#                               ethnicity
119
#                               import_batches
120
#                               import_biblios
121
#                               import_items
122
#                               import_record_matches
123
#                               import_records
124
#                               issues
125
#                               issuingrules
126
#                               items
127
#                               itemtypes
128
#                               labels
129
#                               labels_conf
130
#                               labels_profile
131
#                               labels_templates
132
#                               language_descriptions
133
#                               language_rfc4646_to_iso639
134
#                               language_script_bidi
135
#                               language_script_mapping
136
#                               language_subtag_registry
137
#                               letter
138
#                               marc_matchers
139
#                               marc_subfield_structure
140
#                               marc_tag_structure
141
#                               matchchecks
142
#                               matcher_matchpoints
143
#                               matchpoint_component_norms
144
#                               matchpoint_components
145
#                               matchpoints
146
#                               notifys
147
#                               old_issues
148
#                               old_reserves
149
#                               opac_news
150
#                               overduerules
151
#                               patroncards
152
#                               patronimage
153
#                               printers
154
#                               printers_profile
155
#                               repeatable_holidays
156
#                               reports_dictionary
157
#                               reserveconstraints
158
#                               reserves
159
#                               reviews
160
#                               roadtype
161
#                               saved_reports
162
#                               saved_sql
163
#                               serial
164
#                               serialitems
165
#                               services_throttle
166
#                               sessions
167
#                               special_holidays
168
#                               statistics
169
#                               stopwords
170
#                               subscription
171
#                               subscriptionhistory
172
#                               subscriptionroutinglist
173
#                               suggestions
174
#                               systempreferences
175
#                               tags
176
#                               userflags
177
#                               virtualshelfcontents
178
#                               virtualshelves
179
#                               z3950servers
180
#                               zebraqueue
181
#                         );
182
183
    my @truncate_tables = qw( accountlines
184
                              accountoffsets
185
                              alert
186
                              aqbasket
187
                              aqbooksellers
188
                              aqorderdelivery
189
                              aqorders
190
                              auth_header
191
                              branchcategories
192
                              branchrelations
193
                              branchtransfers
194
                              browser
195
                              cities
196
                              deletedbiblio
197
                              deletedbiblioitems
198
                              deletedborrowers
199
                              deleteditems
200
                              ethnicity
201
                              issues
202
                              issuingrules
203
                              matchchecks
204
                              notifys
205
                              old_issues
206
                              old_reserves
207
                              overduerules
208
                              patroncards
209
                              patronimage
210
                              printers
211
                              printers_profile
212
                              reports_dictionary
213
                              reserveconstraints
214
                              reserves
215
                              reviews
216
                              roadtype
217
                              saved_reports
218
                              saved_sql
219
                              serial
220
                              serialitems
221
                              services_throttle
222
                              special_holidays
223
                              statistics
224
                              subscription
225
                              subscriptionhistory
226
                              subscriptionroutinglist
227
                              suggestions
228
                              tags
229
                              virtualshelfcontents
230
                        );
231
232
    my $failed_to_truncate = 0;
233
    foreach my $table ( @truncate_tables ) {
234
        my $dbh = C4::Context->dbh();
235
        $dbh->do( "truncate $table" )
236
          or $failed_to_truncate = 1;
237
    }
238
    is( $failed_to_truncate, 0, 'truncated tables' );
239
}
240
241
=head2 startup_20_add_bookseller
242
243
we need a bookseller for many of the tests, so let's insert one. Feel
244
free to use this one, or insert your own.
245
246
=cut
247
248
sub startup_20_add_bookseller : Test(startup => 1) {
249
    my $self = shift;
250
251
    my $booksellerinfo = { name => 'bookseller ' . $self->random_string(),
252
                      };
253
254
    my $id = AddBookseller( $booksellerinfo );
255
    ok( $id, "created bookseller: $id" );
256
    $self->{'booksellerid'} = $id;
257
258
    return;
259
}
260
261
=head2 startup_22_add_bookfund
262
263
we need a bookfund for many of the tests. This currently uses one that
264
is in the skeleton database.  free to use this one, or insert your
265
own.
266
267
sub startup_22_add_bookfund : Test(startup => 2) {
268
    my $self = shift;
269
270
    my $bookfundid = 'GEN';
271
    my $bookfund = GetBookFund( $bookfundid, undef );
272
    # diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund  ) ) );
273
    is( $bookfund->{'bookfundid'},   $bookfundid,      "found bookfund: '$bookfundid'" );
274
    is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" );
275
276
    $self->{'bookfundid'} = $bookfundid;
277
    return;
278
}
279
280
=cut
281
282
=head2 startup_24_add_branch
283
284
=cut
285
286
sub startup_24_add_branch : Test(startup => 1) {
287
    my $self = shift;
288
289
    my $branch_info = {
290
        add            => 1,
291
        branchcode     => $self->random_string(3),
292
        branchname     => $self->random_string(),
293
        branchaddress1 => $self->random_string(),
294
        branchaddress2 => $self->random_string(),
295
        branchaddress3 => $self->random_string(),
296
        branchphone    => $self->random_phone(),
297
        branchfax      => $self->random_phone(),
298
        brancemail     => $self->random_email(),
299
        branchip       => $self->random_ip(),
300
        branchprinter  => $self->random_string(),
301
      };
302
    C4::Branch::ModBranch($branch_info);
303
    $self->{'branchcode'} = $branch_info->{'branchcode'};
304
    ok( $self->{'branchcode'}, "created branch: $self->{'branchcode'}" );
305
306
}
307
308
=head2 startup_24_add_member
309
310
Add a patron/member for the tests to use
311
312
=cut
313
314
sub startup_24_add_member : Test(startup => 1) {
315
    my $self = shift;
316
317
    my $memberinfo = { surname      => 'surname '  . $self->random_string(),
318
                       firstname    => 'firstname' . $self->random_string(),
319
                       address      => 'address'   . $self->random_string(),
320
                       city         => 'city'      . $self->random_string(),
321
                       cardnumber   => 'card'      . $self->random_string(),
322
                       branchcode   => 'CPL', # CPL => Centerville
323
                       categorycode => 'PT',  # PT  => PaTron
324
                       dateexpiry   => '2010-01-01',
325
                       password     => 'testpassword',
326
                       dateofbirth  => $self->random_date(),
327
                  };
328
329
    my $borrowernumber = AddMember( %$memberinfo );
330
    ok( $borrowernumber, "created member: $borrowernumber" );
331
    $self->{'memberid'} = $borrowernumber;
332
333
    return;
334
}
335
336
=head2 startup_30_login
337
338
=cut
339
340
sub startup_30_login : Test( startup => 2 ) {
341
    my $self = shift;
342
343
    $self->{'sessionid'} = '12345678'; # does this value matter?
344
    my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} );
345
    ok( $borrower_details->{'cardnumber'}, 'cardnumber' );
346
347
    # make a cookie and force it into $cgi.
348
    # This would be a lot easier with Test::MockObject::Extends.
349
    my $cgi = CGI->new( { userid   => $borrower_details->{'cardnumber'},
350
                          password => 'testpassword' } );
351
    my $setcookie = $cgi->cookie( -name  => 'CGISESSID',
352
                                  -value => $self->{'sessionid'} );
353
    $cgi->{'.cookies'} = { CGISESSID => $setcookie };
354
    is( $cgi->cookie('CGISESSID'), $self->{'sessionid'}, 'the CGISESSID cookie is set' );
355
    # diag( Data::Dumper->Dump( [ $cgi->cookie('CGISESSID') ], [ qw( cookie ) ] ) );
356
357
    # C4::Auth::checkauth sometimes emits a warning about unable to append to sessionlog. That's OK.
358
    my ( $userid, $cookie, $sessionID ) = C4::Auth::checkauth( $cgi, 'noauth', {}, 'intranet' );
359
    # diag( Data::Dumper->Dump( [ $userid, $cookie, $sessionID ], [ qw( userid cookie sessionID ) ] ) );
360
361
    # my $session = C4::Auth::get_session( $sessionID );
362
    # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) );
363
364
365
}
366
367
=head2 setup methods
368
369
setup methods are run before every test method
370
371
=cut
372
373
=head2 teardown methods
374
375
teardown methods are many time, once at the end of each test method.
376
377
=cut
378
379
=head2 shutdown methods
380
381
shutdown methods are run once, at the end of the test suite
382
383
=cut
384
385
=head2 utility methods
386
387
These are not test methods, but they're handy
388
389
=cut
390
391
=head3 random_string
392
393
Nice for generating names and such. It's not actually random, more
394
like arbitrary.
395
396
=cut
397
398
sub random_string {
399
    my $self = shift;
400
401
    my $wordsize = shift || 6;  # how many letters in your string?
402
403
    # leave out these characters: "oOlL10". They're too confusing.
404
    my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 );
405
406
    my $randomstring;
407
    foreach ( 0..$wordsize ) {
408
        $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ];
409
    }
410
    return $randomstring;
411
412
}
413
414
=head3 random_phone
415
416
generates a random phone number. Currently, it's not actually random. It's an unusable US phone number
417
418
=cut
419
420
sub random_phone {
421
    my $self = shift;
422
423
    return '212-555-5555';
424
425
}
426
427
=head3 random_email
428
429
generates a random email address. They're all in the unusable
430
'example.com' domain that is designed for this purpose.
431
432
=cut
433
434
sub random_email {
435
    my $self = shift;
436
437
    return $self->random_string() . '@example.com';
438
439
}
440
441
=head3 random_ip
442
443
returns an IP address suitable for testing purposes.
444
445
=cut
446
447
sub random_ip {
448
    my $self = shift;
449
450
    return '127.0.0.2';
451
452
}
453
454
=head3 random_date
455
456
returns a somewhat random date in the iso (yyyy-mm-dd) format.
457
458
=cut
459
460
sub random_date {
461
    my $self = shift;
462
463
    my $year  = 1800 + int( rand(300) );    # 1800 - 2199
464
    my $month = 1 + int( rand(12) );        # 1 - 12
465
    my $day   = 1 + int( rand(28) );        # 1 - 28
466
                                            # stop at the 28th to keep us from generating February 31st and such.
467
468
    return sprintf( '%04d-%02d-%02d', $year, $month, $day );
469
470
}
471
472
=head3 tomorrow
473
474
returns tomorrow's date as YYYY-MM-DD.
475
476
=cut
477
478
sub tomorrow {
479
    my $self = shift;
480
481
    return $self->days_from_now( 1 );
482
483
}
484
485
=head3 yesterday
486
487
returns yesterday's date as YYYY-MM-DD.
488
489
=cut
490
491
sub yesterday {
492
    my $self = shift;
493
494
    return $self->days_from_now( -1 );
495
}
496
497
498
=head3 days_from_now
499
500
returns an arbitrary date based on today in YYYY-MM-DD format.
501
502
=cut
503
504
sub days_from_now {
505
    my $self = shift;
506
    my $days = shift or return;
507
508
    my $seconds = time + $days * 60*60*24;
509
    my $yyyymmdd = sprintf( '%04d-%02d-%02d',
510
                            localtime( $seconds )->year() + 1900,
511
                            localtime( $seconds )->mon() + 1,
512
                            localtime( $seconds )->mday() );
513
    return $yyyymmdd;
514
}
515
516
=head3 add_biblios
517
518
  $self->add_biblios( count     => 10,
519
                      add_items => 1, );
520
521
  named parameters:
522
     count: number of biblios to add
523
     add_items: should you add items for each one?
524
525
  returns:
526
    I don't know yet.
527
528
  side effects:
529
    adds the biblionumbers to the $self->{'biblios'} listref
530
531
  Notes:
532
    Should I allow you to pass in biblio information, like title?
533
    Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace.
534
    This runs 10 tests, plus 4 for each "count", plus 3 more for each item added.
535
536
=cut
537
538
sub add_biblios {
539
    my $self = shift;
540
    my %param = @_;
541
542
    $param{'count'}     = 1 unless defined( $param{'count'} );
543
    $param{'add_items'} = 0 unless defined( $param{'add_items'} );
544
545
    foreach my $counter ( 1..$param{'count'} ) {
546
        my $marcrecord  = MARC::Record->new();
547
        isa_ok( $marcrecord, 'MARC::Record' );
548
        my @marc_fields = ( MARC::Field->new( '100', '1', '0',
549
                                              a => 'Twain, Mark',
550
                                              d => "1835-1910." ),
551
                            MARC::Field->new( '245', '1', '4',
552
                                              a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ),
553
                                              c => "Mark Twain ; illustrated by E.W. Kemble." ),
554
                            MARC::Field->new( '952', '0', '0',
555
                                              p => '12345678' . $self->random_string() ),   # barcode
556
                            MARC::Field->new( '952', '0', '0',
557
                                              o => $self->random_string() ),   # callnumber
558
                            MARC::Field->new( '952', '0', '0',
559
                                              a => 'CPL',
560
                                              b => 'CPL' ),
561
                       );
562
563
        my $appendedfieldscount = $marcrecord->append_fields( @marc_fields );
564
565
        diag $MARC::Record::ERROR if ( $MARC::Record::ERROR );
566
        is( $appendedfieldscount, scalar @marc_fields, 'added correct number of MARC fields' );
567
568
        my $frameworkcode = ''; # XXX I'd like to put something reasonable here.
569
        my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode );
570
        ok( $biblionumber, "the biblionumber is $biblionumber" );
571
        ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" );
572
        if ( $param{'add_items'} ) {
573
            # my @iteminfo = AddItem( {}, $biblionumber );
574
            my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber );
575
            is( $iteminfo[0], $biblionumber,     "biblionumber is $biblionumber" );
576
            is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" );
577
            ok( $iteminfo[2], "itemnumber is $iteminfo[2]" );
578
        push @{ $self->{'items'} },
579
          { biblionumber     => $iteminfo[0],
580
            biblioitemnumber => $iteminfo[1],
581
            itemnumber       => $iteminfo[2],
582
          };
583
        }
584
        push @{$self->{'biblios'}}, $biblionumber;
585
    }
586
587
    $self->reindex_marc();
588
    my $query = 'Finn Test';
589
    my ( $error, $results, undef ) = SimpleSearch( $query );
590
    if ( !defined $error && $param{'count'} <=  @{$results} ) {
591
        pass( "found all $param{'count'} titles" );
592
    } else {
593
        fail( "we never found all $param{'count'} titles" );
594
    }
595
596
}
597
598
=head3 reindex_marc
599
600
Do a fast reindexing of all of the bib and authority
601
records and mark all zebraqueue entries done.
602
603
Useful for test routines that need to do a
604
lot of indexing without having to wait for
605
zebraqueue.
606
607
=cut
608
609
sub reindex_marc {
610
    my $self = shift;
611
612
    # mark zebraqueue done regardless of the indexing mode
613
    my $dbh = C4::Context->dbh();
614
    $dbh->do("UPDATE zebraqueue SET done = 1 WHERE done = 0");
615
616
    my $directory = tempdir(CLEANUP => 1);
617
    foreach my $record_type qw(biblio authority) {
618
        mkdir "$directory/$record_type";
619
        my $sth = $dbh->prepare($record_type eq "biblio" ? "SELECT marc FROM biblioitems" : "SELECT marc FROM auth_header");
620
        $sth->execute();
621
        open my $out, '>:encoding(UTF-8)', "$directory/$record_type/records";
622
        while (my ($blob) = $sth->fetchrow_array) {
623
            print {$out} $blob;
624
        }
625
        close $out;
626
        my $zebra_server = "${record_type}server";
627
        my $zebra_config  = C4::Context->zebraconfig($zebra_server)->{'config'};
628
        my $zebra_db_dir  = C4::Context->zebraconfig($zebra_server)->{'directory'};
629
        my $zebra_db = $record_type eq 'biblio' ? 'biblios' : 'authorities';
630
        system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 init > /dev/null 2>\&1";
631
        system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 update $directory/${record_type} > /dev/null 2>\&1";
632
        system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 commit > /dev/null 2>\&1";
633
    }
634
635
}
636
637
638
=head3 clear_test_database
639
640
  removes all tables from test database so that install starts with a clean slate
641
642
=cut
643
644
sub clear_test_database {
645
646
    diag "removing tables from test database";
647
648
    my $dbh = C4::Context->dbh;
649
    my $schema = C4::Context->config("database");
650
651
    my @tables = get_all_tables($dbh, $schema);
652
    foreach my $table (@tables) {
653
        drop_all_foreign_keys($dbh, $table);
654
    }
655
656
    foreach my $table (@tables) {
657
        drop_table($dbh, $table);
658
    }
659
}
660
661
sub get_all_tables {
662
  my ($dbh, $schema) = @_;
663
  my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?");
664
  my @tables = ();
665
  $sth->execute($schema);
666
  while (my ($table) = $sth->fetchrow_array) {
667
    push @tables, $table;
668
  }
669
  $sth->finish;
670
  return @tables;
671
}
672
673
sub drop_all_foreign_keys {
674
    my ($dbh, $table) = @_;
675
    # get the table description
676
    my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
677
    $sth->execute;
678
    my $vsc_structure = $sth->fetchrow;
679
    # split on CONSTRAINT keyword
680
    my @fks = split /CONSTRAINT /,$vsc_structure;
681
    # parse each entry
682
    foreach (@fks) {
683
        # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
684
        $_ = /(.*) FOREIGN KEY.*/;
685
        my $id = $1;
686
        if ($id) {
687
            # we have found 1 foreign, drop it
688
            $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
689
            if ( $dbh->err ) {
690
                diag "unable to DROP FOREIGN KEY '$id' on TABLE '$table' due to: " . $dbh->errstr();
691
            }
692
            undef $id;
693
        }
694
    }
695
}
696
697
sub drop_table {
698
    my ($dbh, $table) = @_;
699
    $dbh->do("DROP TABLE $table");
700
    if ( $dbh->err ) {
701
        diag "unable to drop table: '$table' due to: " . $dbh->errstr();
702
    }
703
}
704
705
=head3 create_test_database
706
707
  sets up the test database.
708
709
=cut
710
711
sub create_test_database {
712
713
    diag 'creating testing database...';
714
    my $installer = C4::Installer->new() or die 'unable to create new installer';
715
    # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] );
716
    my $all_languages = getAllLanguages();
717
    my $error = $installer->load_db_schema();
718
    die "unable to load_db_schema: $error" if ( $error );
719
    my $list = $installer->sql_file_list('en', 'marc21', { optional  => 1,
720
                                                           mandatory => 1 } );
721
    my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list);
722
    $installer->set_version_syspref();
723
    $installer->set_marcflavour_syspref('MARC21');
724
    diag 'database created.'
725
}
726
727
728
=head3 start_zebrasrv
729
730
  This method deletes and reinitializes the zebra database directory,
731
  and then spans off a zebra server.
732
733
=cut
734
735
sub start_zebrasrv {
736
737
    stop_zebrasrv();
738
    diag 'cleaning zebrasrv...';
739
740
    foreach my $zebra_server ( qw( biblioserver authorityserver ) ) {
741
        my $zebra_config  = C4::Context->zebraconfig($zebra_server)->{'config'};
742
        my $zebra_db_dir  = C4::Context->zebraconfig($zebra_server)->{'directory'};
743
        foreach my $zebra_db_name ( qw( biblios authorities ) ) {
744
            my $command = "zebraidx -c $zebra_config -d $zebra_db_name init";
745
            my $return = system( $command . ' > /dev/null 2>&1' );
746
            if ( $return != 0 ) {
747
                diag( "command '$command' died with value: " . $? >> 8 );
748
            }
749
750
            $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name";
751
            diag $command;
752
            $return = system( $command . ' > /dev/null 2>&1' );
753
            if ( $return != 0 ) {
754
                diag( "command '$command' died with value: " . $? >> 8 );
755
            }
756
        }
757
    }
758
759
    diag 'starting zebrasrv...';
760
761
    my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
762
    my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s',
763
                           $ENV{'KOHA_CONF'},
764
                           File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ),
765
                           $pidfile,
766
                      );
767
    diag $command;
768
    my $output = qx( $command );
769
    if ( $output ) {
770
        diag $output;
771
    }
772
    if ( -e $pidfile, 'pidfile exists' ) {
773
        diag 'zebrasrv started.';
774
    } else {
775
        die 'unable to start zebrasrv';
776
    }
777
    return $output;
778
}
779
780
=head3 stop_zebrasrv
781
782
  using the PID file for the zebra server, send it a TERM signal with
783
  "kill". We can't tell if the process actually dies or not.
784
785
=cut
786
787
sub stop_zebrasrv {
788
789
    my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
790
    if ( -e $pidfile ) {
791
        open( my $pidh, '<', $pidfile )
792
          or return;
793
        if ( defined $pidh ) {
794
            my ( $pid ) = <$pidh> or return;
795
            close $pidh;
796
            my $killed = kill 15, $pid; # 15 is TERM
797
            if ( $killed != 1 ) {
798
                warn "unable to kill zebrasrv with pid: $pid";
799
            }
800
        }
801
    }
802
}
803
804
805
=head3 start_zebraqueue_daemon
806
807
  kick off a zebraqueue_daemon.pl process.
808
809
=cut
810
811
sub start_zebraqueue_daemon {
812
813
    my $command = q(run/bin/koha-index-daemon-ctl.sh start);
814
    diag $command;
815
    my $started = system( $command );
816
    diag "started: $started";
817
818
}
819
820
=head3 stop_zebraqueue_daemon
821
822
823
=cut
824
825
sub stop_zebraqueue_daemon {
826
827
    my $command = q(run/bin/koha-index-daemon-ctl.sh stop);
828
    diag $command;
829
    my $started = system( $command );
830
    diag "started: $started";
831
832
}
833
834
1;
(-)a/t/db_dependent/lib/KohaTest/Accounts.pm (-29 lines)
Lines 1-29 Link Here
1
package KohaTest::Accounts;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Accounts;
10
sub testing_class { 'C4::Accounts' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( recordpayment
16
                      makepayment
17
                      getnextacctno
18
                      manualinvoice
19
                      fixcredit
20
                      refund
21
                      getcharges
22
                      getcredits
23
                      getrefunds
24
                );	# removed fixaccounts (unused by codebase)
25
    
26
    can_ok( $self->testing_class, @methods );    
27
}
28
29
1;
(-)a/t/db_dependent/lib/KohaTest/Acquisition.pm (-140 lines)
Lines 1-140 Link Here
1
package KohaTest::Acquisition;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Acquisition;
10
use C4::Budgets;
11
use C4::Context;
12
use C4::Members;
13
use Time::localtime;
14
15
sub testing_class { 'C4::Acquisition' };
16
17
18
sub methods : Test( 1 ) {
19
    my $self = shift;
20
    my @methods = qw(  GetBasket 
21
                       NewBasket 
22
                       CloseBasket 
23
                       GetPendingOrders 
24
                       GetOrders 
25
                       GetOrder 
26
                       NewOrder 
27
                       ModOrder 
28
                       ModReceiveOrder 
29
                       SearchOrder 
30
                       DelOrder 
31
                       GetParcel 
32
                       GetParcels 
33
                       GetLateOrders 
34
                       GetHistory 
35
                       GetRecentAcqui 
36
                );
37
    
38
    can_ok( $self->testing_class, @methods );    
39
}
40
41
=head3 create_new_basket
42
43
  creates a baseket by creating an order with no baseket number.
44
45
  named parameters:
46
    authorizedby
47
    invoice
48
    date
49
50
  returns: baseket number, order number
51
52
  runs 4 tests
53
54
=cut
55
56
sub create_new_basket {
57
    my $self = shift;
58
    my %param = @_;
59
    $param{'authorizedby'} = $self->{'memberid'} unless exists $param{'authorizedby'};
60
    $param{'invoice'}      = 123                 unless exists $param{'invoice'};
61
    
62
    my $today = sprintf( '%04d-%02d-%02d',
63
                         localtime->year() + 1900,
64
                         localtime->mon() + 1,
65
                         localtime->mday() );
66
    
67
    # I actually think that this parameter is unused.
68
    $param{'date'}         = $today              unless exists $param{'date'};
69
70
    $self->add_biblios( add_items => 1 );
71
    ok( scalar @{$self->{'biblios'}} > 0, 'we have added at least one biblio' );
72
73
    my $rand = int(rand(10000));
74
    my $basketno = NewBasket( $self->{'booksellerid'}, $param{'authorizedby'},  "Basket $rand");
75
#             $basketnote, $basketbooksellernote, $basketcontractnumber );
76
#   The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
77
    my $budget_id = AddBudget( { budget_name => "Budget $rand" } );
78
    my ( undef, $ordernumber ) = NewOrder( {
79
            basketno => $basketno,
80
            budget_id => $budget_id,
81
            biblionumber => $self->{'biblios'}[0],
82
            quantity => 1,
83
            bookfundid => $self->{'bookfundid'},
84
            rrp => 1,
85
            ecost => 1,
86
            booksellerinvoicenumber => $param{'invoice'},
87
        } );
88
    ok( $basketno, "my basket number is $basketno" );
89
    ok( $ordernumber,   "my order number is $ordernumber" );
90
    
91
    my $order = GetOrder( $ordernumber );
92
    is( $order->{'ordernumber'}, $ordernumber, 'got the right order' )
93
      or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) );
94
    
95
    is( $order->{'budgetdate'}, $today, "the budget date is $today" );
96
97
    # XXX should I stuff these in $self?
98
    return ( $basketno, $ordernumber );
99
    
100
}
101
102
103
sub enable_independant_branches {
104
    my $self = shift;
105
    
106
    my $member = GetMember( 'borrowernumber' =>$self->{'memberid'} );
107
    
108
    C4::Context::set_userenv( 0, # usernum
109
                              $self->{'memberid'}, # userid
110
                              undef, # usercnum
111
                              undef, # userfirstname
112
                              undef, # usersurname
113
                              $member->{'branchcode'}, # userbranch
114
                              undef, # branchname
115
                              0, # userflags
116
                              undef, # emailaddress
117
                              undef, # branchprinter
118
                         );
119
120
    # set a preference. There's surely a method for this, but I can't find it.
121
    my $retval = C4::Context->dbh->do( q(update systempreferences set value = '1' where variable = 'IndependentBranches') );
122
    ok( $retval, 'set the preference' );
123
    
124
    ok( C4::Context->userenv, 'usernev' );
125
    isnt( C4::Context->userenv->{flags}, 1, 'flag != 1' )
126
      or diag( Data::Dumper->Dump( [ C4::Context->userenv ], [ 'userenv' ] ) );
127
128
    is( C4::Context->userenv->{branch}, $member->{'branchcode'}, 'we have set the right branch in C4::Context: ' . $member->{'branchcode'} );
129
    
130
}
131
132
sub disable_independant_branches {
133
    my $self = shift;
134
135
    my $retval = C4::Context->dbh->do( q(update systempreferences set value = '0' where variable = 'IndependentBranches') );
136
    ok( $retval, 'set the preference back' );
137
138
    
139
}
140
1;
(-)a/t/db_dependent/lib/KohaTest/Acquisition/GetHistory.pm (-208 lines)
Lines 1-208 Link Here
1
package KohaTest::Acquisition::GetHistory;
2
use base qw( KohaTest::Acquisition );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Acquisition;
10
use C4::Context;
11
use C4::Members;
12
use C4::Biblio;
13
use C4::Bookseller;
14
15
=head3 no_history
16
17
18
19
=cut
20
21
sub no_history : Test( 4 ) {
22
    my $self = shift;
23
24
    # my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on )
25
26
    my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory();
27
    # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
28
29
    is( scalar @$order_loop, 0, 'order_loop is empty' );
30
    is( $total_qty,          0, 'total_qty' );
31
    is( $total_price,        0, 'total_price' );
32
    is( $total_qtyreceived,  0, 'total_qtyreceived' );
33
34
    
35
}
36
37
=head3 one_order
38
39
=cut
40
41
my $INVOICE = "1234-56 AB";
42
sub one_order : Test( 55 ) {
43
    my $self = shift;
44
    
45
    my ( $basketno, $ordernumber ) = $self->create_new_basket(invoice => $INVOICE);
46
    ok( $basketno, "basketno is $basketno" );
47
    ok( $ordernumber, "ordernumber is $ordernumber" );
48
49
    # No arguments fetches no history.
50
    {
51
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = eval { GetHistory() };
52
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
53
        
54
        is( $order_loop, undef, 'order_loop is empty' );
55
    }
56
57
    my $bibliodata = GetBiblioData( $self->{'biblios'}[0] );
58
    ok( $bibliodata->{'title'}, 'the biblio has a title' )
59
      or diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) );
60
    
61
    # searching by title should find it.
62
    {
63
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( title => $bibliodata->{'title'} );
64
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
65
    
66
        is( scalar @$order_loop, 1, 'order_loop searched by title' );
67
        is( $total_qty,          1, 'total_qty searched by title' );
68
        is( $total_price,        1, 'total_price searched by title' );
69
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by title' );
70
71
        # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
72
    }
73
74
    # searching by isbn
75
    {
76
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( isbn => $bibliodata->{'isbn'} );
77
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
78
79
        is( scalar @$order_loop, 1, 'order_loop searched by isbn' );
80
        is( $total_qty,          1, 'total_qty searched by isbn' );
81
        is( $total_price,        1, 'total_price searched by isbn' );
82
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by isbn' );
83
84
        # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
85
    }
86
87
    # searching by ean
88
    {
89
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( ean => $bibliodata->{'ean'} );
90
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
91
92
        is( scalar @$order_loop, 1, 'order_loop searched by ean' );
93
        is( $total_qty,          1, 'total_qty searched by ean' );
94
        is( $total_price,        1, 'total_price searched by ean' );
95
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by ean' );
96
97
        # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
98
    }
99
100
101
    # searching by basket number
102
    {
103
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( basket => $basketno );
104
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
105
    
106
        is( scalar @$order_loop, 1, 'order_loop searched by basket no' );
107
        is( $total_qty,          1, 'total_qty searched by basket no' );
108
        is( $total_price,        1, 'total_price searched by basket no' );
109
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by basket no' );
110
111
        # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
112
    }
113
114
    # searching by invoice number
115
    {
116
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( booksellerinvoicenumber  => $INVOICE );
117
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
118
    
119
        is( scalar @$order_loop, 1, 'order_loop searched by invoice no' );
120
        is( $total_qty,          1, 'total_qty searched by invoice no' );
121
        is( $total_price,        1, 'total_price searched by invoice no' );
122
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by invoice no' );
123
124
        # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
125
    }
126
127
    # searching by author
128
    {
129
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( author => $bibliodata->{'author'} );
130
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
131
    
132
        is( scalar @$order_loop, 1, 'order_loop searched by author' );
133
        is( $total_qty,          1, 'total_qty searched by author' );
134
        is( $total_price,        1, 'total_price searched by author' );
135
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by author' );
136
    }
137
138
    # searching by name
139
    {
140
        # diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) );
141
142
        my $bookseller = GetBookSellerFromId( $self->{'booksellerid'} );
143
        ok( $bookseller->{'name'}, 'bookseller name' )
144
          or diag( Data::Dumper->Dump( [ $bookseller ], [ 'bookseller' ] ) );
145
        
146
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( name => $bookseller->{'name'} );
147
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
148
    
149
        is( scalar @$order_loop, 1, 'order_loop searched by name' );
150
        is( $total_qty,          1, 'total_qty searched by name' );
151
        is( $total_price,        1, 'total_price searched by name' );
152
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by name' );
153
    }
154
155
    # searching by from_date
156
    {
157
        my $tomorrow = $self->tomorrow();
158
        # diag( "tomorrow is $tomorrow" );
159
160
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( to_placed_on =>  $tomorrow );
161
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
162
    
163
        is( scalar @$order_loop, 1, 'order_loop searched by to_date' );
164
        is( $total_qty,          1, 'total_qty searched by to_date' );
165
        is( $total_price,        1, 'total_price searched by to_date' );
166
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by to_date' );
167
    }
168
169
    # searching by from_date
170
    {
171
        my $yesterday = $self->yesterday();
172
        # diag( "yesterday was $yesterday" );
173
    
174
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( from_placed_on =>  $yesterday );
175
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
176
    
177
        is( scalar @$order_loop, 1, 'order_loop searched by from_date' );
178
        is( $total_qty,          1, 'total_qty searched by from_date' );
179
        is( $total_price,        1, 'total_price searched by from_date' );
180
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by from_date' );
181
    }
182
183
    # set up some things necessary to make GetHistory use the IndependentBranches
184
    $self->enable_independant_branches();    
185
186
    # just search by title here, we need to search by something.
187
    {
188
        my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( title => $bibliodata->{'title'} );
189
        # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
190
    
191
        is( scalar @$order_loop, 1, 'order_loop searched by title' );
192
        is( $total_qty,          1, 'total_qty searched by title' );
193
        is( $total_price,        1, 'total_price searched by title' );
194
        is( $total_qtyreceived,  0, 'total_qtyreceived searched by title' );
195
196
        # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
197
    }
198
    
199
    # reset that.
200
    $self->disable_independant_branches();    
201
202
    
203
204
    
205
}
206
207
208
1;
(-)a/t/db_dependent/lib/KohaTest/Acquisition/GetLateOrders.pm (-106 lines)
Lines 1-106 Link Here
1
package KohaTest::Acquisition::GetLateOrders;
2
use base qw( KohaTest::Acquisition );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Acquisition;
10
use C4::Context;
11
use C4::Members;
12
13
=head3 no_orders
14
15
=cut
16
17
sub no_orders : Test( 1 ) {
18
    my $self = shift;
19
20
    my @orders = GetLateOrders( 1 );
21
    is( scalar @orders, 0, 'There are no orders, so we found 0.' ) 
22
      or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
23
24
}
25
26
=head3 one_order
27
28
=cut
29
30
sub one_order : Test( 29 ) {
31
    my $self = shift;
32
33
    my ( $basketid, $ordernumber ) = $self->create_new_basket();
34
    ok( $basketid, 'a new basket was created' );
35
    ok( $ordernumber, 'the basket has an order in it.' );
36
    # we need this basket to be closed.
37
    CloseBasket( $basketid );
38
    
39
    my @orders = GetLateOrders( 0 );
40
41
    {
42
        my @orders = GetLateOrders( 0 );
43
        is( scalar @orders, 1, 'An order closed today is 0 days late.' ) 
44
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
45
    }
46
    {
47
        my @orders = GetLateOrders( 1 );
48
        is( scalar @orders, 0, 'An order closed today is not 1 day late.' ) 
49
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
50
    }
51
    {
52
        my @orders = GetLateOrders( -1 );
53
        is( scalar @orders, 1, 'an order closed today is -1 day late.' ) 
54
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
55
    }
56
57
    # provide some vendor information
58
    {
59
        my @orders = GetLateOrders( 0, $self->{'booksellerid'} );
60
        is( scalar @orders, 1, 'We found this late order with the right supplierid.' ) 
61
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
62
    }
63
    {
64
        my @orders = GetLateOrders( 0, $self->{'booksellerid'} + 1 );
65
        is( scalar @orders, 0, 'We found no late orders with the wrong supplierid.' ) 
66
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
67
    }
68
69
    # provide some branch information
70
    my $member = GetMember( borrowernumber=>$self->{'memberid'} );
71
    # diag( Data::Dumper->Dump( [ $member ], [ 'member' ] ) );
72
    {
73
        my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} );
74
        is( scalar @orders, 1, 'We found this late order with the right branchcode.' ) 
75
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
76
    }
77
    {
78
        my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' );
79
        is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' ) 
80
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
81
    }
82
83
    # set up some things necessary to make GetLateOrders use the IndependentBranches
84
    $self->enable_independant_branches();    
85
86
    {
87
        my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} );
88
        is( scalar @orders, 1, 'We found this late order with the right branchcode.' ) 
89
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
90
    }
91
    {
92
        my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' );
93
        is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' ) 
94
          or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
95
    }
96
97
    # reset that.
98
    $self->disable_independant_branches();    
99
100
}
101
102
103
104
105
106
1;
(-)a/t/db_dependent/lib/KohaTest/Acquisition/GetParcel.pm (-66 lines)
Lines 1-66 Link Here
1
package KohaTest::Acquisition::GetParcel;
2
use base qw( KohaTest::Acquisition );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
use Time::localtime;
9
10
use C4::Acquisition;
11
12
=head3 no_parcel
13
14
at first, there should be no parcels for our bookseller.
15
16
=cut
17
18
sub no_parcel : Test( 1 ) {
19
    my $self = shift;
20
21
    my @parcel = GetParcel( $self->{'booksellerid'}, undef, undef );
22
    is( scalar @parcel, 0, 'our new bookseller has no parcels' )
23
      or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) );
24
}
25
26
=head3 one_parcel
27
28
we create an order, mark it as received, and then see if we can find
29
it with GetParcel.
30
31
=cut
32
33
sub one_parcel : Test( 17 ) {
34
    my $self = shift;
35
36
    my $invoice = 123;    # XXX what should this be?
37
38
    my $today = sprintf( '%04d-%02d-%02d',
39
                         localtime->year() + 1900,
40
                         localtime->mon() + 1,
41
                         localtime->mday() );
42
    my ( $basketno, $ordernumber ) = $self->create_new_basket();
43
    
44
    ok( $basketno, "my basket number is $basketno" );
45
    ok( $ordernumber,   "my order number is $ordernumber" );
46
    my $datereceived = ModReceiveOrder( $self->{'biblios'}[0],             # biblionumber
47
                                        $ordernumber,       # $ordernumber,
48
                                        undef,         # $quantrec,
49
                                        undef,         # $user,
50
                                        undef,         # $cost,
51
                                        undef,         # $ecost,
52
                                        $invoice,         # $invoiceno,
53
                                        undef,         # $freight,
54
                                        undef,         # $rrp,
55
                                        $self->{'bookfundid'},         # $bookfund,
56
                                        $today,         # $datereceived
57
                                   );
58
    is( $datereceived, $today, "the parcel was received on $datereceived" );
59
60
    my @parcel = GetParcel( $self->{'booksellerid'}, $invoice, $today );
61
    is( scalar @parcel, 1, 'we found one (1) parcel.' )
62
      or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) );
63
64
}
65
66
1;
(-)a/t/db_dependent/lib/KohaTest/Acquisition/GetParcels.pm (-290 lines)
Lines 1-290 Link Here
1
package KohaTest::Acquisition::GetParcels;
2
use base qw( KohaTest::Acquisition );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
use Time::localtime;
9
10
use C4::Acquisition;
11
12
=head2 NOTE
13
14
Please do not confuse this with the test suite for C4::Acquisition::GetParcel.
15
16
=head3 no_parcels
17
18
at first, there should be no parcels for our bookseller.
19
20
=cut
21
22
sub no_parcels : Test( 1 ) {
23
    my $self = shift;
24
25
    my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
26
                             # order
27
                             # code ( aqorders.booksellerinvoicenumber )
28
                             # datefrom
29
                             # date to
30
                        );
31
                            
32
    is( scalar @parcels, 0, 'our new bookseller has no parcels' )
33
      or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
34
}
35
36
=head3 one_parcel
37
38
we create an order, mark it as received, and then see if we can find
39
it with GetParcels.
40
41
=cut
42
43
sub one_parcel : Test( 19 ) {
44
    my $self = shift;
45
46
    my $invoice = 123;    # XXX what should this be?
47
    my $today = sprintf( '%04d-%02d-%02d',
48
                         localtime->year() + 1900,
49
                         localtime->mon() + 1,
50
                         localtime->mday() );
51
52
    $self->create_order( authorizedby => 1,   # XXX what should this be?
53
                         invoice      => $invoice,
54
                         date         => $today );
55
    
56
    my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
57
                             # order
58
                             # code ( aqorders.booksellerinvoicenumber )
59
                             # datefrom
60
                             # date to
61
                        );
62
    is( scalar @parcels, 1, 'we found one (1) parcel.' )
63
      or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
64
65
    my $thisparcel = shift( @parcels );
66
    is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' )
67
      or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
68
      
69
    is( $thisparcel->{'datereceived'},             $today,   'datereceived' );
70
    is( $thisparcel->{'biblio'},                   1,        'biblio' );
71
    is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' );
72
73
    # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
74
75
}
76
77
=head3 two_parcels
78
79
we create another order, mark it as received, and then see if we can find
80
them all with GetParcels.
81
82
=cut
83
84
sub two_parcels : Test( 31 ) {
85
    my $self = shift;
86
87
    my $invoice = 1234;    # XXX what should this be?
88
    my $today = sprintf( '%04d-%02d-%02d',
89
                         localtime->year() + 1900,
90
                         localtime->mon() + 1,
91
                         localtime->mday() );
92
    $self->create_order( authorizedby => 1,   # XXX what should this be?
93
                         invoice      => $invoice,
94
                         date         => $today );
95
96
    {
97
        # fetch them all and check that this one is last
98
        my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
99
                                  # order
100
                                  # code ( aqorders.booksellerinvoicenumber )
101
                                  # datefrom
102
                                  # date to
103
                             );
104
        is( scalar @parcels, 2, 'we found two (2) parcels.' )
105
          or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
106
        
107
        my $thisparcel = pop( @parcels );
108
        is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' )
109
          or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
110
        
111
        is( $thisparcel->{'datereceived'},             $today,   'datereceived' );
112
        is( $thisparcel->{'biblio'},                   1,        'biblio' );
113
        is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' );
114
    }
115
116
    {
117
        # fetch just one, by using the exact code
118
        my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
119
                                  undef,    # order
120
                                  $invoice, # code ( aqorders.booksellerinvoicenumber )
121
                                  undef,    # datefrom
122
                                  undef,    # date to
123
                             );
124
        is( scalar @parcels, 1, 'we found one (1) parcels.' )
125
          or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
126
        
127
        my $thisparcel = pop( @parcels );
128
        is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' )
129
          or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
130
        
131
        is( $thisparcel->{'datereceived'},             $today,   'datereceived' );
132
        is( $thisparcel->{'biblio'},                   1,        'biblio' );
133
        is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' );
134
    }
135
    
136
    {
137
        # fetch them both by using code 123, which gets 123 and 1234
138
        my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
139
                                  undef,    # order
140
                                  '123', # code ( aqorders.booksellerinvoicenumber )
141
                                  undef,    # datefrom
142
                                  undef,    # date to
143
                             );
144
        is( scalar @parcels, 2, 'we found 2 parcels.' )
145
          or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
146
        
147
    }
148
    
149
    {
150
        # fetch them both, and try to order them
151
        my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
152
                                  'aqorders.booksellerinvoicenumber',    # order
153
                                  undef, # code ( aqorders.booksellerinvoicenumber )
154
                                  undef,    # datefrom
155
                                  undef,    # date to
156
                             );
157
        is( scalar @parcels, 2, 'we found 2 parcels.' )
158
          or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
159
        is( $parcels[0]->{'booksellerinvoicenumber'}, 123 );
160
        is( $parcels[1]->{'booksellerinvoicenumber'}, 1234 );
161
        
162
    }
163
    
164
    {
165
        # fetch them both, and try to order them, descending
166
        my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
167
                                  'aqorders.booksellerinvoicenumber desc',    # order
168
                                  undef, # code ( aqorders.booksellerinvoicenumber )
169
                                  undef,    # datefrom
170
                                  undef,    # date to
171
                             );
172
        is( scalar @parcels, 2, 'we found 2 parcels.' )
173
          or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
174
        is( $parcels[0]->{'booksellerinvoicenumber'}, 1234 );
175
        is( $parcels[1]->{'booksellerinvoicenumber'}, 123 );
176
        
177
    }
178
    
179
    
180
    
181
182
    # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
183
184
}
185
186
187
=head3 z_several_parcels_with_different_dates
188
189
we create an order, mark it as received, and then see if we can find
190
it with GetParcels.
191
192
=cut
193
194
sub z_several_parcels_with_different_dates : Test( 44 ) {
195
    my $self = shift;
196
197
    my $authorizedby = 1; # XXX what should this be?
198
199
    my @inputs = ( { invoice => 10,
200
                      date     => sprintf( '%04d-%02d-%02d',
201
                                           1950,
202
                                           localtime->mon() + 1,
203
                                           10 ), # I'm using the invoice number as the day.
204
                 },
205
                    { invoice => 15,
206
                      date     => sprintf( '%04d-%02d-%02d',
207
                                           1950,
208
                                           localtime->mon() + 1,
209
                                           15 ), # I'm using the invoice number as the day.
210
                 },
211
                    { invoice => 20,
212
                      date     => sprintf( '%04d-%02d-%02d',
213
                                           1950,
214
                                           localtime->mon() + 1,
215
                                           20 ), # I'm using the invoice number as the day.
216
                 },
217
               );
218
219
    foreach my $input ( @inputs ) {
220
        $self->create_order( authorizedby => $authorizedby,
221
                             invoice      => $input->{'invoice'},
222
                             date         => $input->{'date'},
223
                        );
224
    }
225
                         
226
    my @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
227
                              undef, # order
228
                              undef, # code ( aqorders.booksellerinvoicenumber )
229
                              sprintf( '%04d-%02d-%02d',
230
                                       1950,
231
                                       localtime->mon() + 1,
232
                                       10 ), # datefrom
233
                              sprintf( '%04d-%02d-%02d',
234
                                       1950,
235
                                       localtime->mon() + 1,
236
                                       20 ), # dateto
237
                        );
238
    is( scalar @parcels, scalar @inputs, 'we found all of the parcels.' )
239
      or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
240
241
    @parcels = GetParcels( $self->{'booksellerid'},  # bookseller
242
                           undef, # order
243
                           undef, # code ( aqorders.booksellerinvoicenumber )
244
                           sprintf( '%04d-%02d-%02d',
245
                                    1950,
246
                                    localtime->mon() + 1,
247
                                    10 ), # datefrom
248
                           sprintf( '%04d-%02d-%02d',
249
                                    1950,
250
                                    localtime->mon() + 1,
251
                                    16 ), # dateto
252
                        );
253
    is( scalar @parcels, scalar @inputs - 1, 'we found all of the parcels except one' )
254
      or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
255
256
257
258
    # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
259
260
}
261
262
sub create_order {
263
    my $self = shift;
264
    my %param = @_;
265
    $param{'authorizedby'} = 1 unless exists $param{'authorizedby'};
266
    $param{'invoice'}      = 1 unless exists $param{'invoice'};
267
    $param{'date'} = sprintf( '%04d-%02d-%02d',
268
                              localtime->year() + 1900,
269
                              localtime->mon() + 1,
270
                              localtime->mday() ) unless exists $param{'date'};
271
272
    my ( $basketno, $ordernumber ) = $self->create_new_basket( %param );
273
274
    my $datereceived = ModReceiveOrder( $self->{'biblios'}[0],             # biblionumber
275
                                        $ordernumber,       # $ordernumber,
276
                                        undef,         # $quantrec,
277
                                        undef,         # $user,
278
                                        undef,         # $cost,
279
                                        undef,         # $ecost,
280
                                        $param{'invoice'},         # $invoiceno,
281
                                        undef,         # $freight,
282
                                        undef,         # $rrp,
283
                                        $self->{'bookfundid'},         # $bookfund,
284
                                        $param{'date'},         # $datereceived
285
                                   );
286
    is( $datereceived, $param{'date'}, "the parcel was received on $datereceived" );
287
288
}
289
290
1;
(-)a/t/db_dependent/lib/KohaTest/Acquisition/GetPendingOrders.pm (-82 lines)
Lines 1-82 Link Here
1
package KohaTest::Acquisition::GetPendingOrders;
2
use base qw( KohaTest::Acquisition );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Acquisition;
10
11
=head3 no_orders
12
13
at first, there should be no orders for our bookseller.
14
15
=cut
16
17
sub no_orders : Test( 1 ) {
18
    my $self = shift;
19
20
    my $orders = GetPendingOrders( $self->{'booksellerid'} );
21
    is( scalar @$orders, 0, 'our new bookseller has no pending orders' )
22
      or diag( Data::Dumper->Dump( [ $orders ], [ 'orders' ] ) );
23
}
24
25
=head3 new_order
26
27
we make an order, then see if it shows up in the pending orders
28
29
=cut
30
31
sub one_new_order : Test( 49 ) {
32
    my $self = shift;
33
34
    my ( $basketno, $ordernumber ) = $self->create_new_basket();
35
36
    ok( $basketno, "basketno is $basketno" );
37
    ok( $ordernumber, "ordernumber is $ordernumber" );
38
    
39
    my $orders = GetPendingOrders( $self->{'booksellerid'} );
40
    is( scalar @$orders, 1, 'we successfully entered one order.' );
41
42
    my @expectedfields = qw( basketno
43
                             biblioitemnumber
44
                             biblionumber
45
                             booksellerinvoicenumber
46
                             budgetdate
47
                             cancelledby
48
                             closedate
49
                             creationdate
50
                             currency
51
                             datecancellationprinted
52
                             datereceived
53
                             ecost
54
                             entrydate
55
                             firstname
56
                             freight
57
                             gst
58
                             listprice
59
                             notes
60
                             ordernumber
61
                             purchaseordernumber
62
                             quantity
63
                             quantityreceived
64
                             rrp
65
                             serialid
66
                             sort1
67
                             sort2
68
                             subscription
69
                             supplierreference
70
                             surname
71
                             timestamp
72
                             title
73
                             totalamount
74
                             unitprice );
75
    my $firstorder = $orders->[0];
76
    for my $field ( @expectedfields ) {
77
        ok( exists( $firstorder->{ $field } ), "This order has a $field field" );
78
    }
79
    
80
}
81
82
1;
(-)a/t/db_dependent/lib/KohaTest/Acquisition/NewOrder.pm (-108 lines)
Lines 1-108 Link Here
1
package KohaTest::Acquisition::NewOrder;
2
use base qw( KohaTest::Acquisition );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
use Time::localtime;
9
10
use C4::Acquisition;
11
12
=head3 new_order_no_budget
13
14
If we make a new order and don't pass in a budget date, it defaults to
15
today.
16
17
=cut
18
19
sub new_order_no_budget : Test( 4 ) {
20
    my $self = shift;
21
22
    my $authorizedby = 1; # XXX what should this be?
23
    my $invoice = 123;    # XXX what should this be?
24
    my $today = sprintf( '%04d-%02d-%02d',
25
                         localtime->year() + 1900,
26
                         localtime->mon() + 1,
27
                         localtime->mday() );
28
    my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno,
29
                                          1, # $bibnum,
30
                                          undef, # $title,
31
                                          undef, # $quantity,
32
                                          undef, # $listprice,
33
                                          $self->{'booksellerid'}, # $booksellerid,
34
                                          $authorizedby, # $authorisedby,
35
                                          undef, # $notes,
36
                                          $self->{'bookfundid'},     # $bookfund,
37
                                          undef, # $bibitemnum,
38
                                          undef, # $rrp,
39
                                          undef, # $ecost,
40
                                          undef, # $gst,
41
                                          undef, # $budget,
42
                                          undef, # $cost,
43
                                          undef, # $sub,
44
                                          $invoice, # $invoice,
45
                                          undef, # $sort1,
46
                                          undef, # $sort2,
47
                                          undef, # $purchaseorder,
48
										  undef, # $branchcode
49
                                     );
50
    ok( $basketno, "my basket number is $basketno" );
51
    ok( $ordernumber,   "my order number is $ordernumber" );
52
53
    my $order = GetOrder( $ordernumber );
54
    is( $order->{'ordernumber'}, $ordernumber, 'got the right order' )
55
      or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) );
56
    
57
    is( $order->{'budgetdate'}, $today, "the budget date is $today" );
58
}
59
60
=head3 new_order_set_budget
61
62
Let's set the budget date of this new order. It actually pretty much
63
only pays attention to the current month and year.
64
65
=cut
66
67
sub new_order_set_budget : Test( 4 ) {
68
    my $self = shift;
69
70
    my $authorizedby = 1; # XXX what should this be?
71
    my $invoice = 123;    # XXX what should this be?
72
    my $today = sprintf( '%04d-%02d-%02d',
73
                         localtime->year() + 1900,
74
                         localtime->mon() + 1,
75
                         localtime->mday() );
76
    my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno,
77
                                          1, # $bibnum,
78
                                          undef, # $title,
79
                                          undef, # $quantity,
80
                                          undef, # $listprice,
81
                                          $self->{'booksellerid'}, # $booksellerid,
82
                                          $authorizedby, # $authorisedby,
83
                                          undef, # $notes,
84
                                          $self->{'bookfundid'},     # $bookfund,
85
                                          undef, # $bibitemnum,
86
                                          undef, # $rrp,
87
                                          undef, # $ecost,
88
                                          undef, # $gst,
89
                                          'does not matter, just not undef', # $budget,
90
                                          undef, # $cost,
91
                                          undef, # $sub,
92
                                          $invoice, # $invoice,
93
                                          undef, # $sort1,
94
                                          undef, # $sort2,
95
                                          undef, # $purchaseorder,
96
										  undef, # $branchcode
97
                                     );
98
    ok( $basketno, "my basket number is $basketno" );
99
    ok( $ordernumber,   "my order number is $ordernumber" );
100
101
    my $order = GetOrder( $ordernumber );
102
    is( $order->{'ordernumber'}, $ordernumber, 'got the right order' )
103
      or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) );
104
    
105
    like( $order->{'budgetdate'}, qr(^2\d\d\d-07-01$), "the budget date ($order->{'budgetdate'}) is a July 1st." );
106
}
107
108
1;
(-)a/t/db_dependent/lib/KohaTest/AuthoritiesMarc.pm (-40 lines)
Lines 1-40 Link Here
1
package KohaTest::AuthoritiesMarc;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::AuthoritiesMarc;
10
sub testing_class { 'C4::AuthoritiesMarc' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( GetAuthMARCFromKohaField 
16
                      SearchAuthorities 
17
                      CountUsage 
18
                      CountUsageChildren 
19
                      GetAuthTypeCode 
20
                      GetTagsLabels 
21
                      AddAuthority 
22
                      DelAuthority 
23
                      ModAuthority 
24
                      GetAuthorityXML 
25
                      GetAuthority 
26
                      GetAuthType 
27
                      FindDuplicateAuthority 
28
                      BuildSummary
29
                      BuildUnimarcHierarchies
30
                      BuildUnimarcHierarchy
31
                      GetHeaderAuthority
32
                      AddAuthorityTrees
33
                      merge 
34
                      get_auth_type_location 
35
                );
36
    
37
    can_ok( $self->testing_class, @methods );    
38
}
39
40
1;
(-)a/t/db_dependent/lib/KohaTest/Biblio.pm (-66 lines)
Lines 1-66 Link Here
1
package KohaTest::Biblio;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Biblio;
10
sub testing_class { 'C4::Biblio' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw(
16
                       AddBiblio
17
                       ModBiblio
18
                       ModBiblioframework
19
                       DelBiblio
20
                       LinkBibHeadingsToAuthorities
21
                       GetBiblioData
22
                       GetBiblioItemData
23
                       GetBiblioItemByBiblioNumber
24
                       GetBiblioFromItemNumber
25
                       GetBiblio
26
                       GetBiblioItemInfosOf
27
                       GetMarcStructure
28
                       GetUsedMarcStructure
29
                       GetMarcFromKohaField
30
                       GetMarcBiblio
31
                       GetXmlBiblio
32
                       GetAuthorisedValueDesc
33
                       GetMarcNotes
34
                       GetMarcSubjects
35
                       GetMarcAuthors
36
                       GetMarcUrls
37
                       GetMarcSeries
38
                       GetFrameworkCode
39
                       GetPublisherNameFromIsbn
40
                       TransformKohaToMarc
41
                       TransformHtmlToXml
42
                       TransformHtmlToMarc
43
                       TransformMarcToKoha
44
                       _get_inverted_marc_field_map
45
                       _disambiguate
46
                       get_koha_field_from_marc
47
                       TransformMarcToKohaOneField
48
                       ModZebra
49
                       _find_value
50
                       _koha_marc_update_bib_ids
51
                       _koha_marc_update_biblioitem_cn_sort
52
                       _koha_add_biblio
53
                       _koha_modify_biblio
54
                       _koha_modify_biblioitem_nonmarc
55
                       _koha_add_biblioitem
56
                       _koha_delete_biblio
57
                       _koha_delete_biblioitems
58
                       ModBiblioMarc
59
                       get_biblio_authorised_values
60
                );
61
    
62
    can_ok( $self->testing_class, @methods );    
63
}
64
65
1;
66
(-)a/t/db_dependent/lib/KohaTest/Biblio/ModBiblio.pm (-154 lines)
Lines 1-154 Link Here
1
package KohaTest::Biblio::ModBiblio;
2
use base qw( KohaTest::Biblio );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Biblio;
10
use C4::Items;
11
12
=head2 STARTUP METHODS
13
14
These get run once, before the main test methods in this module
15
16
=head3 add_bib_to_modify
17
18
=cut
19
20
sub add_bib_to_modify : Test( startup => 3 ) {
21
    my $self = shift;
22
23
    my $bib = MARC::Record->new();
24
    $bib->leader('     ngm a22     7a 4500');   
25
    $bib->append_fields(
26
        MARC::Field->new('100', ' ', ' ', a => 'Moffat, Steven'),
27
        MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
28
    );
29
    
30
    my ($bibnum, $bibitemnum) = AddBiblio($bib, '');
31
    $self->{'bib_to_modify'} = $bibnum;
32
33
    # add an item
34
    my ($item_bibnum, $item_bibitemnum, $itemnumber) = AddItem({ homebranch => 'CPL', holdingbranch => 'CPL' } , $bibnum);
35
36
    cmp_ok($item_bibnum, '==', $bibnum, "new item is linked to correct biblionumber"); 
37
    cmp_ok($item_bibitemnum, '==', $bibitemnum, "new item is linked to correct biblioitemnumber"); 
38
39
    $self->reindex_marc(); 
40
41
    my $marc = $self->fetch_bib($bibnum);
42
    $self->sort_item_and_bibnumber_fields($marc);
43
    $self->{'bib_to_modify_formatted'} = $marc->as_formatted(); # simple way to compare later
44
}
45
46
=head2 TEST METHODS
47
48
standard test methods
49
50
=head3 bug_2297
51
52
Regression test for bug 2297 (saving a subscription duplicates MARC  item fields)
53
54
=cut
55
56
sub bug_2297 : Test( 5 ) {
57
    my $self = shift;
58
59
    my $bibnum = $self->{'bib_to_modify'};
60
    my $marc = $self->fetch_bib($bibnum);
61
    $self->check_item_count($marc, 1);
62
63
    ModBiblio($marc, $bibnum, ''); # no change made to bib
64
65
    my $modified_marc = $self->fetch_bib($bibnum);
66
    diag "checking item field count after null modification";
67
    $self->check_item_count($modified_marc, 1);
68
69
    $self->sort_item_and_bibnumber_fields($modified_marc);
70
    is($modified_marc->as_formatted(), $self->{'bib_to_modify_formatted'}, "no change to bib after null modification");
71
}
72
73
=head2 HELPER METHODS
74
75
These methods are used by other test methods, but
76
are not meant to be called directly.
77
78
=cut
79
80
=head3 fetch_bib
81
82
=cut
83
84
sub fetch_bib { # +1 to test count per call
85
    my $self = shift;
86
    my $bibnum = shift;
87
88
    my $marc = GetMarcBiblio($bibnum);
89
    ok(defined($marc), "retrieved bib record $bibnum");
90
91
    return $marc;
92
}
93
94
=head3 check_item_count
95
96
=cut
97
98
sub check_item_count { # +1 to test count per call
99
    my $self = shift;
100
    my $marc = shift;
101
    my $expected_items = shift;
102
103
    my ($itemtag, $itemsubfield) = GetMarcFromKohaField("items.itemnumber", '');
104
    my @item_fields = $marc->field($itemtag);
105
    cmp_ok(scalar(@item_fields), "==", $expected_items, "exactly one item field");
106
}
107
108
=head3 sort_item_and_bibnumber_fields
109
110
This method sorts the field containing the embedded item data
111
and the bibnumber - ModBiblio(), AddBiblio(), and ModItem() do
112
not guarantee that these fields will be sorted in tag order.
113
114
=cut
115
116
sub sort_item_and_bibnumber_fields {
117
    my $self = shift;
118
    my $marc = shift;
119
120
    my ($itemtag, $itemsubfield)     = GetMarcFromKohaField("items.itemnumber", '');
121
    my ($bibnumtag, $bibnumsubfield) = GetMarcFromKohaField("biblio.biblionumber", '');
122
123
    my @item_fields = ();
124
    foreach my $field ($marc->field($itemtag)) {
125
        push @item_fields, $field;
126
        $marc->delete_field($field);
127
    }
128
    $marc->insert_fields_ordered(@item_fields) if scalar(@item_fields);;
129
   
130
    my @bibnum_fields = (); 
131
    foreach my $field ($marc->field($bibnumtag)) {
132
        push @bibnum_fields, $field;
133
        $marc->delete_field($field);
134
    }
135
    $marc->insert_fields_ordered(@bibnum_fields) if scalar(@bibnum_fields);
136
137
}
138
139
=head2 SHUTDOWN METHODS
140
141
These get run once, after the main test methods in this module
142
143
=head3 shutdown_clean_object
144
145
=cut
146
147
sub shutdown_clean_object : Test( shutdown => 0 ) {
148
    my $self = shift;
149
150
    delete $self->{'bib_to_modify'};
151
    delete $self->{'bib_to_modify_formatted'};
152
}
153
154
1;
(-)a/t/db_dependent/lib/KohaTest/Biblio/get_biblio_authorised_values.pm (-48 lines)
Lines 1-48 Link Here
1
package KohaTest::Biblio::get_biblio_authorised_values;
2
use base qw( KohaTest::Biblio );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Biblio;
10
11
=head2 STARTUP METHODS
12
13
These get run once, before the main test methods in this module
14
15
=head3 insert_test_data
16
17
=cut
18
19
sub insert_test_data : Test( startup => 71 ) {
20
    my $self = shift;
21
    
22
    # I'm going to add a bunch of biblios so that I can search for them.
23
    $self->add_biblios( count     => 10,
24
                        add_items => 1 );
25
    
26
27
}
28
29
=head2 TEST METHODS
30
31
standard test methods
32
33
=head3 basic_test
34
35
basic usage.
36
37
=cut
38
39
sub basic_test : Test( 1 ) {
40
    my $self = shift;
41
42
    ok( $self->{'biblios'}[0], 'we have a biblionumber' );
43
    my $authorised_values = C4::Biblio::get_biblio_authorised_values( $self->{'biblios'}[0] );
44
    diag( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
45
    
46
}
47
48
1;
(-)a/t/db_dependent/lib/KohaTest/Branch.pm (-35 lines)
Lines 1-35 Link Here
1
package KohaTest::Branch;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Branch;
10
sub testing_class { 'C4::Branch' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( GetBranches
16
                      GetBranchName
17
                      ModBranch
18
                      GetBranchCategory
19
                      GetBranchCategories
20
                      GetCategoryTypes
21
                      GetBranch
22
                      GetBranchDetail
23
                      GetBranchesInCategory
24
                      GetBranchInfo
25
                      DelBranch
26
                      ModBranchCategoryInfo
27
                      DelBranchCategory
28
                      CheckBranchCategorycode
29
                );
30
    
31
    can_ok( $self->testing_class, @methods );    
32
}
33
34
1;
35
(-)a/t/db_dependent/lib/KohaTest/Branch/GetBranches.pm (-41 lines)
Lines 1-41 Link Here
1
package KohaTest::Branch::GetBranches;
2
use base qw( KohaTest::Branch );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Branch;
10
11
=head2 STARTUP METHODS
12
13
These get run once, before the main test methods in this module
14
15
=cut
16
17
=head2 TEST METHODS
18
19
standard test methods
20
21
=head3 onlymine
22
23
    When you pass in something true to GetBranches, it limits the
24
    response to only your branch.
25
26
=cut
27
28
sub onlymine : Test( 4 ) {
29
    my $self = shift;
30
31
    # C4::Branch::GetBranches uses this variable, so make sure it exists.
32
    ok( C4::Context->userenv->{'branch'}, 'we have a branch' );
33
    my $branches = C4::Branch::GetBranches( 'onlymine' );
34
    # diag( Data::Dumper->Dump( [ $branches ], [ 'branches' ] ) );
35
    is( scalar( keys %$branches ), 1, 'one key for our branch only' );
36
    ok( exists $branches->{ C4::Context->userenv->{'branch'} }, 'my branch was returned' );
37
    is( $branches->{ C4::Context->userenv->{'branch'} }->{'branchcode'}, C4::Context->userenv->{'branch'}, 'branchcode' );
38
    
39
}
40
41
1;
(-)a/t/db_dependent/lib/KohaTest/Breeding.pm (-23 lines)
Lines 1-23 Link Here
1
package KohaTest::Breeding;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Breeding;
10
sub testing_class { 'C4::Breeding' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( ImportBreeding 
16
                      BreedingSearch 
17
                );
18
    
19
    can_ok( $self->testing_class, @methods );    
20
}
21
22
1;
23
(-)a/t/db_dependent/lib/KohaTest/Calendar.pm (-34 lines)
Lines 1-34 Link Here
1
package KohaTest::Calendar;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Calendar;
10
sub testing_class { 'C4::Calendar' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( new
16
                      get_week_days_holidays
17
                      get_day_month_holidays
18
                      get_exception_holidays
19
                      get_single_holidays
20
                      insert_week_day_holiday
21
                      insert_day_month_holiday
22
                      insert_single_holiday
23
                      insert_exception_holiday
24
                      delete_holiday
25
                      isHoliday
26
                      addDate
27
                      daysBetween
28
                );
29
    
30
    can_ok( $self->testing_class, @methods );    
31
}
32
33
1;
34
(-)a/t/db_dependent/lib/KohaTest/Calendar/New.pm (-186 lines)
Lines 1-186 Link Here
1
package KohaTest::Calendar::New;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Calendar;
10
sub testing_class { 'C4::Calendar' };
11
12
13
=head2 STARTUP METHODS
14
15
These get run once, before the main test methods in this module
16
17
=cut
18
19
=head2 TEST METHODS
20
21
standard test methods
22
23
=head3 instantiation
24
25
  just test to see if I can instantiate an object
26
27
=cut
28
29
sub instantiation : Test( 14 ) {
30
    my $self = shift;
31
32
    my $calendar = C4::Calendar->new( branchcode => '' );
33
    isa_ok( $calendar, 'C4::Calendar' );
34
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
35
36
    ok( exists $calendar->{'day_month_holidays'}, 'day_month_holidays' );
37
    ok( exists $calendar->{'single_holidays'},    'single_holidays' );
38
    ok( exists $calendar->{'week_days_holidays'}, 'week_days_holidays' );
39
    ok( exists $calendar->{'exception_holidays'}, 'exception_holidays' );
40
41
    # sample data has Sundays as a holiday
42
    ok( exists $calendar->{'week_days_holidays'}->{'0'} );
43
    is( $calendar->{'week_days_holidays'}->{'0'}->{'title'},       '',        'Sunday title' );
44
    is( $calendar->{'week_days_holidays'}->{'0'}->{'description'}, 'Sundays', 'Sunday description' );
45
    
46
    # sample data has Christmas as a holiday
47
    ok( exists $calendar->{'day_month_holidays'}->{'12/25'} );
48
    is( $calendar->{'day_month_holidays'}->{'12/25'}->{'title'},       '',          'Christmas title' );
49
    is( $calendar->{'day_month_holidays'}->{'12/25'}->{'description'}, 'Christmas', 'Christmas description' );
50
    
51
    # sample data has New Year's Day as a holiday
52
    ok( exists $calendar->{'day_month_holidays'}->{'1/1'} );
53
    is( $calendar->{'day_month_holidays'}->{'1/1'}->{'title'},       '',                'New Year title' );
54
    is( $calendar->{'day_month_holidays'}->{'1/1'}->{'description'}, q(New Year's Day), 'New Year description' );
55
    
56
}
57
58
sub week_day_holidays : Test( 8 ) {
59
    my $self = shift;
60
61
    my $calendar = C4::Calendar->new( branchcode => '' );
62
    isa_ok( $calendar, 'C4::Calendar' );
63
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
64
65
    ok( exists $calendar->{'week_days_holidays'}, 'week_days_holidays' );
66
67
    my %new_holiday = ( weekday     => 1,
68
                        title       => 'example week_day_holiday',
69
                        description => 'This is an example week_day_holiday used for testing' );
70
    my $new_calendar = $calendar->insert_week_day_holiday( %new_holiday );
71
72
    # the calendar object returned from insert_week_day_holiday should be updated
73
    isa_ok( $new_calendar, 'C4::Calendar' );
74
    is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'title'}, $new_holiday{'title'}, 'title' );
75
    is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'description'}, $new_holiday{'description'}, 'description' );
76
77
    # new calendar objects should have the newly inserted holiday.
78
    my $refreshed_calendar = C4::Calendar->new( branchcode => '' );
79
    isa_ok( $refreshed_calendar, 'C4::Calendar' );
80
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
81
    is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'title'}, $new_holiday{'title'}, 'title' );
82
    is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'description'}, $new_holiday{'description'}, 'description' );
83
84
}
85
  
86
87
sub day_month_holidays : Test( 8 ) {
88
    my $self = shift;
89
90
    my $calendar = C4::Calendar->new( branchcode => '' );
91
    isa_ok( $calendar, 'C4::Calendar' );
92
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
93
94
    ok( exists $calendar->{'day_month_holidays'}, 'day_month_holidays' );
95
96
    my %new_holiday = ( day        => 4,
97
                        month       => 5,
98
                        title       => 'example day_month_holiday',
99
                        description => 'This is an example day_month_holiday used for testing' );
100
    my $new_calendar = $calendar->insert_day_month_holiday( %new_holiday );
101
102
    # the calendar object returned from insert_week_day_holiday should be updated
103
    isa_ok( $new_calendar, 'C4::Calendar' );
104
    my $mmdd = sprintf('%s/%s', $new_holiday{'month'}, $new_holiday{'day'} ) ;
105
    is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'title'}, $new_holiday{'title'}, 'title' );
106
    is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'description'}, $new_holiday{'description'}, 'description' );
107
108
    # new calendar objects should have the newly inserted holiday.
109
    my $refreshed_calendar = C4::Calendar->new( branchcode => '' );
110
    isa_ok( $refreshed_calendar, 'C4::Calendar' );
111
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
112
    is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'title'}, $new_holiday{'title'}, 'title' );
113
    is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'description'}, $new_holiday{'description'}, 'description' );
114
115
}
116
  
117
118
119
sub exception_holidays : Test( 8 ) {
120
    my $self = shift;
121
122
    my $calendar = C4::Calendar->new( branchcode => '' );
123
    isa_ok( $calendar, 'C4::Calendar' );
124
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
125
126
    ok( exists $calendar->{'exception_holidays'}, 'exception_holidays' );
127
128
    my %new_holiday = ( day        => 4,
129
                        month       => 5,
130
                        year        => 2010,
131
                        title       => 'example exception_holiday',
132
                        description => 'This is an example exception_holiday used for testing' );
133
    my $new_calendar = $calendar->insert_exception_holiday( %new_holiday );
134
    # diag( Data::Dumper->Dump( [ $new_calendar ], [ 'newcalendar' ] ) );
135
136
    # the calendar object returned from insert_week_day_holiday should be updated
137
    isa_ok( $new_calendar, 'C4::Calendar' );
138
    my $yyyymmdd = sprintf('%s/%s/%s', $new_holiday{'year'}, $new_holiday{'month'}, $new_holiday{'day'} ) ;
139
    is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' );
140
    is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' );
141
142
    # new calendar objects should have the newly inserted holiday.
143
    my $refreshed_calendar = C4::Calendar->new( branchcode => '' );
144
    isa_ok( $refreshed_calendar, 'C4::Calendar' );
145
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
146
    is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' );
147
    is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' );
148
149
}
150
151
152
sub single_holidays : Test( 8 ) {
153
    my $self = shift;
154
155
    my $calendar = C4::Calendar->new( branchcode => '' );
156
    isa_ok( $calendar, 'C4::Calendar' );
157
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
158
159
    ok( exists $calendar->{'single_holidays'}, 'single_holidays' );
160
161
    my %new_holiday = ( day        => 4,
162
                        month       => 5,
163
                        year        => 2011,
164
                        title       => 'example single_holiday',
165
                        description => 'This is an example single_holiday used for testing' );
166
    my $new_calendar = $calendar->insert_single_holiday( %new_holiday );
167
    # diag( Data::Dumper->Dump( [ $new_calendar ], [ 'newcalendar' ] ) );
168
169
    # the calendar object returned from insert_week_day_holiday should be updated
170
    isa_ok( $new_calendar, 'C4::Calendar' );
171
    my $yyyymmdd = sprintf('%s/%s/%s', $new_holiday{'year'}, $new_holiday{'month'}, $new_holiday{'day'} ) ;
172
    is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' );
173
    is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' );
174
175
    # new calendar objects should have the newly inserted holiday.
176
    my $refreshed_calendar = C4::Calendar->new( branchcode => '' );
177
    isa_ok( $refreshed_calendar, 'C4::Calendar' );
178
    # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) );
179
    is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' );
180
    is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' );
181
182
}
183
  
184
185
1;
186
(-)a/t/db_dependent/lib/KohaTest/Category.pm (-23 lines)
Lines 1-23 Link Here
1
package KohaTest::Category;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Category;
10
sub testing_class { 'C4::Category' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( 
16
                    new
17
                    all
18
                );
19
    
20
    can_ok( $self->testing_class, @methods );    
21
}
22
23
1;
(-)a/t/db_dependent/lib/KohaTest/Circulation.pm (-144 lines)
Lines 1-144 Link Here
1
package KohaTest::Circulation;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Circulation;
10
sub testing_class { 'C4::Circulation' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( barcodedecode 
16
                      decode 
17
                      transferbook 
18
                      TooMany 
19
                      itemissues 
20
                      CanBookBeIssued 
21
                      AddIssue 
22
                      GetLoanLength 
23
                      GetIssuingRule 
24
                      GetBranchBorrowerCircRule
25
                      AddReturn 
26
                      MarkIssueReturned 
27
                      _FixOverduesOnReturn
28
                      _FixAccountForLostAndReturned
29
                      GetItemIssue 
30
                      GetItemIssues 
31
                      GetBiblioIssues 
32
                      GetUpcomingDueIssues
33
                      CanBookBeRenewed 
34
                      AddRenewal 
35
                      GetRenewCount 
36
                      GetIssuingCharges 
37
                      AddIssuingCharge 
38
                      GetTransfers 
39
                      GetTransfersFromTo 
40
                      DeleteTransfer 
41
                      AnonymiseIssueHistory 
42
                      updateWrongTransfer 
43
                      UpdateHoldingbranch 
44
                      CalcDateDue  
45
                      CheckValidDatedue 
46
                      CheckRepeatableHolidays
47
                      CheckSpecialHolidays
48
                      CheckRepeatableSpecialHolidays
49
                      CheckValidBarcode
50
                      ReturnLostItem
51
                      ProcessOfflinePayment
52
                );
53
    
54
    can_ok( $self->testing_class, @methods );    
55
}
56
57
=head3 setup_add_biblios
58
59
everything in the C4::Circulation really requires items, so let's do this in the setup phase.
60
61
=cut
62
63
sub setup_add_biblios : Tests( setup => 8 ) {
64
    my $self = shift;
65
66
    # we want to use a fresh batch of items, so clear these lists:
67
    delete $self->{'items'};
68
    delete $self->{'biblios'};
69
70
    $self->add_biblios( add_items => 1 );
71
}
72
73
74
=head3 checkout_first_item
75
76
named parameters:
77
  borrower  => borrower hashref, computed from $self->{'memberid'} if not given
78
  barcode   => item barcode, barcode of $self->{'items'}[0] if not given
79
  issuedate => YYYY-MM-DD of date to mark issue checked out. defaults to today.
80
81
=cut
82
83
sub checkout_first_item {
84
    my $self   = shift;
85
    my $params = shift;
86
87
    # get passed in borrower, or default to the one in $self.
88
    my $borrower = $params->{'borrower'};
89
    if ( ! defined $borrower ) {
90
        my $borrowernumber = $self->{'memberid'};
91
        $borrower = C4::Members::GetMemberDetails( $borrowernumber );
92
    }
93
94
    # get the barcode passed in, or default to the first one in the items list
95
    my $barcode = $params->{'barcode'};
96
    if ( ! defined $barcode ) {
97
        return unless $self->{'items'}[0]{'itemnumber'};
98
        $barcode = $self->get_barcode_from_itemnumber( $self->{'items'}[0]{'itemnumber'} );
99
    }
100
101
    # get issuedate from parameters. Default to undef, which will be interpreted as today
102
    my $issuedate = $params->{'issuedate'};
103
104
    my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode );
105
106
    my $datedue = C4::Circulation::AddIssue(
107
        $borrower,    # borrower
108
        $barcode,     # barcode
109
        undef,        # datedue
110
        undef,        # cancelreserve
111
        $issuedate    # issuedate
112
    );
113
114
    my $issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
115
116
    return $issues->{'date_due'};
117
}
118
119
=head3 get_barcode_from_itemnumber
120
121
pass in an itemnumber, returns a barcode.
122
123
Should this get moved up to KohaTest.pm? Or, is there a better alternative in C4?
124
125
=cut
126
127
sub get_barcode_from_itemnumber {
128
    my $self       = shift;
129
    my $itemnumber = shift;
130
131
    my $sql = <<END_SQL;
132
SELECT barcode
133
  FROM items
134
  WHERE itemnumber = ?
135
END_SQL
136
    my $dbh = C4::Context->dbh()  or return;
137
    my $sth = $dbh->prepare($sql) or return;
138
    $sth->execute($itemnumber) or return;
139
    my ($barcode) = $sth->fetchrow_array;
140
    return $barcode;
141
}
142
143
1;
144
(-)a/t/db_dependent/lib/KohaTest/Circulation/AddIssue.pm (-132 lines)
Lines 1-132 Link Here
1
package KohaTest::Circulation::AddIssue;
2
use base qw(KohaTest::Circulation);
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
=head2 basic_usage
10
11
basic usage of C4::Circulation::AddIssue
12
13
Note: This logic is repeated in
14
KohaTest::Circulation::checkout_first_item, but without tests. This
15
includes tests at each step to make it easier to track down what's
16
broken as we go along.
17
18
=cut
19
20
sub basic_usage : Test( 13 ) {
21
    my $self = shift;
22
23
    my $borrowernumber = $self->{'memberid'};
24
    ok( $borrowernumber, "we're going to work with borrower: $borrowernumber" );
25
26
    my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
27
    ok( $borrower, '...and we were able to look up that borrower' );
28
    is( $borrower->{'borrowernumber'}, $borrowernumber, '...and they have the right borrowernumber' );
29
30
    my $itemnumber = $self->{'items'}[0]{'itemnumber'};
31
    ok( $itemnumber, "We're going to checkout itemnumber $itemnumber" );
32
    my $barcode = $self->get_barcode_from_itemnumber($itemnumber);
33
    ok( $barcode, "...which has barcode $barcode" );
34
35
    my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
36
    # Note that we can't check for $before_issues as undef because GetItemIssue always returns a populated hashref
37
    ok( ! defined $before_issues->{'borrowernumber'}, '...and is not currently checked out' )
38
      or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) );
39
40
    my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode );
41
    is( scalar keys %$issuingimpossible, 0, 'the item CanBookBeIssued' )
42
      or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) );
43
    is( scalar keys %$needsconfirmation, 0, '...and the transaction does not needsconfirmation' )
44
      or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) );
45
46
    # bug 2758 don't ask for confirmation if patron has $0.00 account balance
47
    # and IssuingInProcess is on
48
    my $orig_issuing_in_process = C4::Context->preference('IssuingInProcess');
49
    my $dbh = C4::Context->dbh;
50
    $dbh->do("UPDATE systempreferences SET value = 1 WHERE variable = 'IssuingInProcess'");
51
    C4::Context->clear_syspref_cache(); # FIXME not needed after a syspref mutator is written
52
    ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode );
53
    is( scalar keys %$issuingimpossible, 0, 'the item CanBookBeIssued with IssuingInProcess ON (bug 2758)' )
54
      or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) );
55
    is( scalar keys %$needsconfirmation, 0, 
56
        '...and the transaction does not needsconfirmation with IssuingInProcess ON (bug 2758)' )
57
      or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) );
58
    $dbh->do("UPDATE systempreferences SET value = ? WHERE variable = 'IssuingInProcess'", {}, $orig_issuing_in_process);
59
    C4::Context->clear_syspref_cache(); # FIXME not needed after a syspref mutator is written
60
61
    my $datedue = C4::Circulation::AddIssue( $borrower, $barcode );
62
    ok( $datedue, "the item has been issued and it is due: $datedue" );
63
    
64
    my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
65
    is( $after_issues->{'borrowernumber'}, $borrowernumber, '...and now it is checked out to our borrower' )
66
      or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) );
67
68
    my $loanlength = Date::Calc::Delta_Days( split( /-/, $after_issues->{'issuedate'} ), split( /-/, $after_issues->{'date_due'} ) );
69
    ok( $loanlength, "the loanlength is $loanlength days" );
70
71
    # save this here since we refer to it in set_issuedate.
72
    $self->{'loanlength'} = $loanlength;
73
74
}
75
76
=head2 set_issuedate
77
78
Make sure that we can set the issuedate of an issue.
79
80
Also, since we are specifying an issuedate and not a due date, the due
81
date should be calculated from the issuedate, not today.
82
83
=cut
84
85
sub set_issuedate : Test( 7 ) {
86
    my $self = shift;
87
88
    my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
89
    ok( ! defined $before_issues->{'borrowernumber'}, 'At this beginning, this item was not checked out.' )
90
      or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) );
91
92
    my $issuedate = $self->random_date();
93
    ok( $issuedate, "Check out an item on $issuedate" );
94
    my $datedue = $self->checkout_first_item( { issuedate => $issuedate } );
95
    ok( $datedue, "...and it's due on $datedue" );
96
97
    my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
98
    is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'We found this item checked out to our member.' )
99
      or diag( Data::Dumper->Dump( [ $after_issues ], [ 'issues' ] ) );
100
    is( $after_issues->{'issuedate'}, $issuedate, "...and it was issued on $issuedate" )
101
      or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) );
102
    
103
    my $loanlength = Date::Calc::Delta_Days( split( /-/, $after_issues->{'issuedate'} ), split( /-/, $after_issues->{'date_due'} ) );
104
    ok( $loanlength, "the loanlength is $loanlength days" );
105
    is( $loanlength, $self->{'loanlength'} );
106
}
107
108
sub set_lastreneweddate_on_renewal : Test( 6 ) {
109
    my $self = shift;
110
111
    my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
112
    ok( ! defined $before_issues->{'borrowernumber'}, 'At this beginning, this item was not checked out.' )
113
      or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) );
114
115
    my $datedue = $self->checkout_first_item( { issuedate => $self->yesterday() } );
116
    ok( $datedue, "The item is checked out and it's due on $datedue" );
117
118
    my $issuedate = $self->random_date();
119
    ok( $issuedate, "Check out an item again on $issuedate" );
120
    # This will actually be a renewal
121
    $datedue = $self->checkout_first_item( { issuedate => $issuedate } );
122
    ok( $datedue, "...and it's due on $datedue" );
123
124
    my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
125
    is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'We found this item checked out to our member.' )
126
      or diag( Data::Dumper->Dump( [ $after_issues ], [ 'issues' ] ) );
127
    is( $after_issues->{'lastreneweddate'}, $issuedate, "...and it was renewed on $issuedate" )
128
      or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) );
129
    
130
}
131
132
1;
(-)a/t/db_dependent/lib/KohaTest/Circulation/GetUpcomingDueIssues.pm (-26 lines)
Lines 1-26 Link Here
1
package KohaTest::Circulation::GetUpcomingDueIssues;
2
use base qw(KohaTest::Circulation);
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
=head2 basic_usage
10
11
basic usage of C4::Circulation::GetUpcomingDueIssues()
12
13
=cut
14
15
sub basic_usage : Test(2) {
16
    my $self = shift;
17
18
    my $upcoming = C4::Circulation::GetUpcomingDueIssues();
19
    isa_ok( $upcoming, 'ARRAY' );
20
21
    is( scalar @$upcoming, 0, 'no issues yet' )
22
      or diag( Data::Dumper->Dump( [$upcoming], ['upcoming'] ) );
23
}
24
25
26
1;
(-)a/t/db_dependent/lib/KohaTest/Circulation/MarkIssueReturned.pm (-85 lines)
Lines 1-85 Link Here
1
package KohaTest::Circulation::MarkIssueReturned;
2
use base qw(KohaTest::Circulation);
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
=head2 basic_usage
10
11
basic usage of C4::Circulation::MarkIssueReturned
12
13
=cut
14
15
sub basic_usage : Test( 4 ) {
16
    my $self = shift;
17
18
    my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
19
    ok( ! defined $before_issues->{'borrowernumber'}, 'our item is not checked out' )
20
      or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) );
21
22
    my $datedue = $self->checkout_first_item();
23
    ok( $datedue, "Now it is checked out and due on $datedue" );
24
25
    my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
26
    is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'Our item is checked out to our borrower' )
27
      or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) );
28
29
    C4::Circulation::MarkIssueReturned( $self->{'memberid'}, $self->{'items'}[0]{'itemnumber'} );
30
31
    my $after_return = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
32
    ok( ! defined $after_return->{'borrowernumber'}, 'The item is no longer checked out' )
33
      or diag( Data::Dumper->Dump( [ $after_return ], [ 'after_return' ] ) );
34
35
}
36
37
=head2 set_returndate
38
39
check an item out, then, check it back in, specifying the returndate.
40
41
verify that it's checked back in and the returndate is correct.
42
43
=cut
44
45
sub set_retundate : Test( 7 ) {
46
    my $self = shift;
47
48
    # It's not checked out to start with
49
    my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
50
    ok( ! defined $before_issues->{'borrowernumber'}, 'our item is not checked out' )
51
      or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) );
52
53
    # check it out
54
    my $datedue = $self->checkout_first_item();
55
    ok( $datedue, "Now it is checked out and due on $datedue" );
56
57
    # verify that it has been checked out
58
    my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
59
    is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'Our item is checked out to our borrower' )
60
      or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) );
61
62
    # mark it as returned on some date
63
    my $returndate = $self->random_date();
64
    ok( $returndate, "return this item on $returndate" );
65
66
    C4::Circulation::MarkIssueReturned( $self->{'memberid'},
67
                                        $self->{'items'}[0]{'itemnumber'},
68
                                        undef,
69
                                        $returndate );
70
71
    # validate that it is no longer checked out.
72
    my $after_return = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} );
73
    ok( ! defined $after_return->{'borrowernumber'}, 'The item is no longer checked out' )
74
      or diag( Data::Dumper->Dump( [ $after_return ], [ 'after_return' ] ) );
75
76
    # grab the history for this item and make sure it looks right
77
    my $history = C4::Circulation::GetItemIssues( $self->{'items'}[0]{'itemnumber'}, 1 );
78
    is( scalar @$history, 1, 'this item has been checked out one time.' )
79
      or diag( Data::Dumper->Dump( [ $history ], [ 'history' ] ) );
80
    is( $history->[0]{'returndate'}, $returndate, "...and it was returned on $returndate" );
81
    
82
}
83
84
85
1;
(-)a/t/db_dependent/lib/KohaTest/Context.pm (-54 lines)
Lines 1-54 Link Here
1
package KohaTest::Context;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Context;
10
sub testing_class { 'C4::Context' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw(
16
                        AUTOLOAD
17
                        boolean_preference
18
                        config
19
                        dbh
20
                        db_scheme2dbi
21
                        get_shelves_userenv
22
                        get_versions
23
                        import
24
                        KOHAVERSION
25
                        marcfromkohafield
26
                        ModZebrations
27
                        new
28
                        new_dbh
29
                        preference
30
                        read_config_file
31
                        restore_context
32
                        restore_dbh
33
                        set_context
34
                        set_dbh
35
                        set_shelves_userenv
36
                        set_userenv
37
                        stopwords
38
                        userenv
39
                        Zconn
40
                        zebraconfig
41
                        _common_config
42
                        _new_dbh
43
                        _new_marcfromkohafield
44
                        _new_stopwords
45
                        _new_userenv
46
                        _new_Zconn
47
                        _unset_userenv
48
                );
49
    
50
    can_ok( $self->testing_class, @methods );    
51
}
52
53
1;
54
(-)a/t/db_dependent/lib/KohaTest/Context/preference.pm (-54 lines)
Lines 1-54 Link Here
1
package KohaTest::Context::preference;
2
use base qw( KohaTest::Context );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Context;
10
sub testing_class { 'C4::Context' };
11
12
13
=head2 STARTUP METHODS
14
15
These get run once, before the main test methods in this module
16
17
=cut
18
19
=head2 TEST METHODS
20
21
standard test methods
22
23
=head3 preference_does_not_exist
24
25
=cut
26
27
sub preference_does_not_exist : Test( 1 ) {
28
    my $self = shift;
29
30
    my $missing = C4::Context->preference( 'doesnotexist' );
31
32
    is( $missing, undef, 'a query for a missing syspref returns undef' )
33
      or diag( Data::Dumper->Dump( [ $missing ], [ 'missing' ] ) );
34
    
35
}
36
37
38
=head3 version_preference
39
40
=cut
41
42
sub version_preference : Test( 1 ) {
43
    my $self = shift;
44
45
    my $version = C4::Context->preference( 'version' );
46
47
    ok( $version, 'C4::Context->preference returns a good version number' )
48
      or diag( Data::Dumper->Dump( [ $version ], [ 'version' ] ) );
49
    
50
}
51
52
53
54
1;
(-)a/t/db_dependent/lib/KohaTest/Dates.pm (-37 lines)
Lines 1-37 Link Here
1
package KohaTest::Dates;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Dates;
10
sub testing_class { 'C4::Dates' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( _prefformat
16
                      regexp
17
                      dmy_map
18
                      _check_date_and_time
19
                      _chron_to_ymd
20
                      _chron_to_hms
21
                      new
22
                      init
23
                      output
24
                      today
25
                      _recognize_format
26
                      DHTMLcalendar
27
                      format
28
                      visual
29
                      format_date
30
                      format_date_in_iso
31
                );
32
    
33
    can_ok( $self->testing_class, @methods );    
34
}
35
36
1;
37
(-)a/t/db_dependent/lib/KohaTest/Dates/Usage.pm (-103 lines)
Lines 1-103 Link Here
1
package KohaTest::Dates::Usage;
2
use base qw( KohaTest::Dates );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Dates qw(format_date format_date_in_iso);
10
11
12
sub startup_init_constants : Tests(startup => 0) {
13
    my $self = shift;
14
    $self->{thash} = {
15
        iso    => [ '2001-01-01',         '1989-09-21',         '1952-01-00' ],
16
        metric => [ "01-01-2001",         '21-09-1989',         '00-01-1952' ],
17
        us     => [ "01-01-2001",         '09-21-1989',         '01-00-1952' ],
18
        sql    => [ '20010101    010101', '19890921    143907', '19520100    000000' ],
19
    };
20
    $self->{formats} = [ sort keys %{ $self->{thash} } ];
21
}
22
23
sub check_formats : Test( 8 ) {
24
    my $self = shift;
25
26
    my $syspref = C4::Dates->new->format();
27
    ok( $syspref, "Your system preference is: $syspref" );
28
29
    foreach ( @{ $self->{thash}->{'iso'} } ) {
30
        ok( format_date($_), "able to format_date() on $_" );
31
    }
32
33
    foreach ( @{ $self->{thash}->{$syspref} } ) {
34
        ok( format_date_in_iso($_), "able to format_date_in_iso() on $_" );
35
    }
36
    ok( C4::Dates->today(), "(default) CLASS ->today : " . C4::Dates->today() );
37
}
38
39
sub defaults : Test( 24 ) {
40
    my $self = shift;
41
42
    foreach (@{ $self->{formats} }) {
43
        my $pre = sprintf '(%-6s)', $_;
44
        my $date = C4::Dates->new();
45
        ok( $date, "$pre Date Creation   : new()" );
46
        isa_ok( $date, 'C4::Dates' );
47
        ok( $_ eq $date->format($_),   "$pre format($_)      : " );
48
        ok( $date->visual(), "$pre visual()" );
49
        ok( $date->output(), "$pre output()" );
50
        ok( $date->today(),  "$pre object->today" );
51
52
    }
53
}
54
55
sub valid_inputs : Test( 108 ) {
56
    my $self = shift;
57
58
    foreach my $format (@{ $self->{formats} }) {
59
        my $pre = sprintf '(%-6s)', $format;
60
        foreach my $testval ( @{ $self->{thash}->{$format} } ) {
61
            my ( $val, $today );
62
            my $date = C4::Dates->new( $testval, $format );
63
            ok( $date, "$pre Date Creation   : new('$testval','$format')" );
64
            isa_ok( $date, 'C4::Dates' );
65
            ok( $date->regexp, "$pre has regexp()" );
66
            ok( $val = $date->output(), describe( "$pre output()", $val ) );
67
            foreach ( grep { !/$format/ } @{ $self->{formats} } ) {
68
                ok( $today = $date->output($_), describe( sprintf( "$pre output(%8s)", "'$_'" ), $today ) );
69
            }
70
            ok( $today = $date->today(), describe( "$pre object->today", $today ) );
71
            ok( $val = $date->output(), describe( "$pre output()", $val ) );
72
        }
73
    }
74
}
75
76
sub independence_from_class : Test( 1 ) {
77
    my $self = shift;
78
79
    my $in1  = '12/25/1952';                       # us
80
    my $in2  = '13/01/2001';                       # metric
81
    my $d1   = C4::Dates->new( $in1, 'us' );
82
    my $d2   = C4::Dates->new( $in2, 'metric' );
83
    my $out1 = $d1->output('iso');
84
    my $out2 = $d2->output('iso');
85
    ok( $out1 ne $out2, "subsequent constructors get different dataspace ($out1 != $out2)" );
86
87
}
88
89
90
91
sub describe {
92
    my $front = sprintf( "%-25s", shift );
93
    my $tail = shift || 'FAILED';
94
    return "$front : $tail";
95
}
96
97
sub shutdown_clear_constants : Tests( shutdown => 0 ) {
98
    my $self = shift;
99
    delete $self->{thash};
100
    delete $self->{formats};
101
}
102
103
1;
(-)a/t/db_dependent/lib/KohaTest/Heading.pm (-27 lines)
Lines 1-27 Link Here
1
package KohaTest::Heading;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Heading;
10
sub testing_class { 'C4::Heading' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( 
16
                    new_from_bib_field
17
                    display_form
18
                    authorities
19
                    preferred_authorities
20
                    _query_limiters
21
                    _marc_format_handler
22
                );
23
    
24
    can_ok( $self->testing_class, @methods );    
25
}
26
27
1;
(-)a/t/db_dependent/lib/KohaTest/Heading/MARC21.pm (-41 lines)
Lines 1-41 Link Here
1
package KohaTest::Heading::MARC21;
2
use base qw( KohaTest::Heading );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Heading;
10
use C4::Heading::MARC21;
11
12
use MARC::Field;
13
14
sub testing_class { 'C4::Heading::MARC21' };
15
16
sub methods : Test( 1 ) {
17
    my $self = shift;
18
    my @methods = qw( 
19
                    new
20
                    valid_bib_heading_tag
21
                    parse_heading
22
                    _get_subject_thesaurus
23
                    _get_search_heading
24
                    _get_display_heading
25
                );
26
    
27
    can_ok( $self->testing_class, @methods );    
28
}
29
30
sub bug2315 : Test( 1 ) {
31
32
    my $subject_heading = MARC::Field->new(650, ' ', '0', 
33
                                                a   => "Dalziel, Andrew (Fictitious character",
34
                                                ')' => "Fiction."
35
                                           );
36
    my $display_form = C4::Heading::MARC21::_get_display_heading($subject_heading, 'a');
37
    is($display_form, "Dalziel, Andrew (Fictitious character", "bug 2315: no crash if heading subfield has metacharacter");
38
39
}
40
41
1;
(-)a/t/db_dependent/lib/KohaTest/ImportBatch.pm (-126 lines)
Lines 1-126 Link Here
1
package KohaTest::ImportBatch;
2
use base qw(KohaTest);
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ImportBatch;
10
use C4::Matcher;
11
sub testing_class { 'C4::ImportBatch' };
12
13
14
sub routines : Test( 1 ) {
15
    my $self = shift;
16
    my @routines = qw(
17
                        GetZ3950BatchId
18
                        GetImportRecordMarc
19
                        AddImportBatch
20
                        GetImportBatch
21
                        AddBiblioToBatch
22
                        ModBiblioInBatch
23
                        BatchStageMarcRecords
24
                        AddItemsToImportBiblio
25
                        BatchFindBibDuplicates
26
                        BatchCommitBibRecords
27
                        BatchCommitItems
28
                        BatchRevertBibRecords
29
                        BatchRevertItems
30
                        CleanBatch
31
                        GetAllImportBatches
32
                        GetImportBatchRangeDesc
33
                        GetItemNumbersFromImportBatch
34
                        GetNumberOfNonZ3950ImportBatches
35
                        GetImportBibliosRange
36
                        GetBestRecordMatch
37
                        GetImportBatchStatus
38
                        SetImportBatchStatus
39
                        GetImportBatchOverlayAction
40
                        SetImportBatchOverlayAction
41
                        GetImportBatchNoMatchAction
42
                        SetImportBatchNoMatchAction
43
                        GetImportBatchItemAction
44
                        SetImportBatchItemAction
45
                        GetImportBatchItemAction
46
                        SetImportBatchItemAction
47
                        GetImportBatchMatcher
48
                        SetImportBatchMatcher
49
                        GetImportRecordOverlayStatus
50
                        SetImportRecordOverlayStatus
51
                        GetImportRecordStatus
52
                        SetImportRecordStatus
53
                        GetImportRecordMatches
54
                        SetImportRecordMatches
55
                        _create_import_record
56
                        _update_import_record_marc
57
                        _add_biblio_fields
58
                        _update_biblio_fields
59
                        _parse_biblio_fields
60
                        _update_batch_record_counts
61
                        _get_commit_action
62
                        _get_revert_action
63
                );
64
    
65
    can_ok($self->testing_class, @routines);
66
}
67
68
sub startup_50_add_matcher : Test( startup => 1 ) {
69
    my $self = shift;
70
    # create test MARC21 ISBN matcher
71
    my $matcher = C4::Matcher->new('biblio');
72
    $matcher->threshold(1000);
73
    $matcher->code('TESTISBN');
74
    $matcher->description('test MARC21 ISBN matcher');
75
    $matcher->add_simple_matchpoint('isbn', 1000, '020', 'a', -1, 0, '');
76
    my $matcher_id = $matcher->store();
77
    like($matcher_id, qr/^\d+$/, "store new matcher and get back ID");
78
79
    $self->{'matcher_id'} = $matcher_id;
80
}
81
82
sub shutdown_50_remove_matcher : Test( shutdown => 6) {
83
    my $self = shift;
84
    my @matchers = C4::Matcher::GetMatcherList();
85
    cmp_ok(scalar(@matchers), ">=", 1, "at least one matcher present");
86
    my $matcher_id;
87
    my $testisbn_count = 0;
88
    # look for TESTISBN
89
    foreach my $matcher (@matchers) {
90
        if ($matcher->{'code'} eq 'TESTISBN') {
91
            $testisbn_count++;
92
            $matcher_id = $matcher->{'matcher_id'};
93
        }
94
    }
95
    ok($testisbn_count == 1, "only one TESTISBN matcher");
96
    like($matcher_id, qr/^\d+$/, "matcher ID is valid");
97
    my $matcher = C4::Matcher->fetch($matcher_id);
98
    ok(defined($matcher), "got back a matcher");
99
    ok($matcher_id == $matcher->{'id'}, "got back the correct matcher");
100
    C4::Matcher->delete($matcher_id);
101
    my $matcher2 = C4::Matcher->fetch($matcher_id);
102
    ok(not(defined($matcher2)), "matcher removed");
103
104
    delete $self->{'matcher_id'};
105
}
106
107
=head2 UTILITY METHODS
108
109
=cut
110
111
sub add_import_batch {
112
    my $self       = shift;
113
    my $test_batch = shift
114
      || {
115
        overlay_action => 'create_new',
116
        import_status  => 'staging',
117
        batch_type     => 'batch',
118
        file_name      => 'foo',
119
        comments       => 'inserted during automated testing',
120
      };
121
    my $batch_id = AddImportBatch( $test_batch );
122
    return $batch_id;
123
}
124
125
126
1;
(-)a/t/db_dependent/lib/KohaTest/ImportBatch/AddItemsToImportBiblio.pm (-29 lines)
Lines 1-29 Link Here
1
package KohaTest::ImportBatch::getImportBatch;
2
use base qw( KohaTest::ImportBatch );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ImportBatch;
10
use C4::Matcher;
11
use C4::Biblio;
12
13
14
sub something : Test( 2 ) {
15
    my $self = shift;
16
17
    my $batch_id = $self->add_import_batch();
18
    ok( $batch_id, 'we have a batch_id' );
19
20
    my $import_record_id = 0;
21
22
    my $marc_record = MARC::Record->new();
23
    
24
    my @import_item_ids = C4::ImportBatch::AddItemsToImportBiblio( $batch_id, $import_record_id, $marc_record );
25
    is( scalar( @import_item_ids ), 0, 'none inserted' );
26
27
}
28
29
1;
(-)a/t/db_dependent/lib/KohaTest/ImportBatch/BatchStageCommitRevert.pm (-252 lines)
Lines 1-252 Link Here
1
package KohaTest::ImportBatch::BatchStageCommitRevert;
2
use base qw( KohaTest::ImportBatch );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ImportBatch;
10
use C4::Matcher;
11
use C4::Biblio;
12
13
# define test records for various batches
14
sub startup_60_make_test_records : Test( startup ) {
15
    my $self = shift;
16
    $self->{'batches'} = {
17
        'batch1' => { 
18
                        marc => _make_marc_batch([
19
                            ['isbn001', 'title 1', ['batch-item-1'] ],
20
                            ['isbn002', 'title 2', [] ],
21
                            ['isbn003', 'title 3', ['batch-item-2','batch-item-3'] ],
22
                            ['isbn004', 'title 4', [ 'batch-item-4' ] ],
23
                            ['isbn005', 'title 5', [ 'batch-item-5', 'batch-item-6', 'batch-item-7' ] ],
24
                        ]),
25
                        args => {
26
                            parse_items => 1,
27
                            overlay_action => 'create_new',
28
                            nomatch_action => 'create_new',
29
                            item_action => 'always_add',
30
                        },
31
                        results => {
32
                            num_bibs  => 5,
33
                            num_items => 7,
34
                            num_invalid => 0,
35
                            num_matches => 0,
36
                            num_added => 5,
37
                            num_updated => 0,
38
                            num_items_added => 7,
39
                            num_items_errored => 0,
40
                            num_ignored => 0,
41
                        },
42
                    },
43
        'batch2' => {
44
                        marc => _make_marc_batch([
45
                            ['isbn001', 'overlay title 1', ['batch-item-8'] ],
46
                            ['isbn002', 'overlay title 2', ['batch-item-9'] ],
47
                            ['isbn006', 'title 6', ['batch-item-10'] ],
48
                        ]),
49
                        args => {
50
                            parse_items => 1,
51
                            overlay_action => 'replace',
52
                            nomatch_action => 'create_new',
53
                            item_action => 'always_add',
54
                        },
55
                        results => {
56
                            num_bibs  => 3,
57
                            num_items => 3,
58
                            num_invalid => 0,
59
                            num_matches => 2,
60
                            num_added => 1,
61
                            num_updated => 2,
62
                            num_items_added => 3,
63
                            num_items_errored => 0,
64
                            num_ignored => 0,
65
                        },
66
                    },
67
        'batch3' => {
68
                        marc => _make_marc_batch([ 
69
                            ['isbn007', 'title 7', ['batch-item-11'] ],
70
                            ['isbn006', 'overlay title 6', ['batch-item-12'] ],
71
                        ]),
72
                        args => {
73
                            parse_items => 1,
74
                            overlay_action => 'ignore',
75
                            nomatch_action => 'ignore',
76
                            item_action => 'always_add',
77
                        },
78
                        results => {
79
                            num_bibs  => 2,
80
                            num_items => 2,
81
                            num_invalid => 0,
82
                            num_matches => 1,
83
                            num_added => 0,
84
                            num_updated => 0,
85
                            num_items_added => 1,
86
                            num_items_errored => 0,
87
                            num_ignored => 2,
88
                        },
89
                    },
90
        'batch4' => {
91
                        marc => _make_marc_batch([ 
92
                            ['isbn008', 'title 8', ['batch-item-13'] ], # not loading this item
93
                        ]),
94
                        args => {
95
                            parse_items => 0,
96
                            overlay_action => undef,
97
                            nomatch_action => 'create_new',
98
                            item_action => 'ignore',
99
                        },
100
                        results => {
101
                            num_bibs  => 1,
102
                            num_items => 0,
103
                            num_invalid => 0,
104
                            num_matches => 0,
105
                            num_added => 1,
106
                            num_updated => 0,
107
                            num_items_added => 0,
108
                            num_items_errored => 0,
109
                            num_ignored => 0,
110
                        },
111
                    },
112
        'batch5' => {
113
                        marc => _make_marc_batch([ 
114
                            ['isbn009', 'title 9', ['batch-item-1'] ], # trigger dup barcode error
115
                            'junkjunkjunkjunk', # trigger invalid bib
116
                        ]),
117
                        args => {
118
                            parse_items => 1,
119
                            overlay_action => undef,
120
                            nomatch_action => undef,
121
                            item_action => undef,
122
                        },
123
                        results => {
124
                            num_bibs  => 1,
125
                            num_items => 1,
126
                            num_invalid => 1,
127
                            num_matches => 0,
128
                            num_added => 1,
129
                            num_updated => 0,
130
                            num_items_added => 0,
131
                            num_items_errored => 1,
132
                            num_ignored => 0,
133
                        },
134
                    },
135
        'batch6' => {
136
                        marc => _make_marc_batch([ 
137
                            ['isbn001', 'match title 1', ['batch-item-14', 'batch-item-15'] ],
138
                            ['isbn010', 'title 10', ['batch-item-16', 'batch-item-17'] ],
139
                        ]),
140
                        args => {
141
                            parse_items => 1,
142
                            overlay_action => 'ignore',
143
                            nomatch_action => 'create_new',
144
                            item_action => 'always_add',
145
                        },
146
                        results => {
147
                            num_bibs  => 2,
148
                            num_items => 4,
149
                            num_invalid => 0,
150
                            num_matches => 1,
151
                            num_added => 1,
152
                            num_updated => 0,
153
                            num_items_added => 4,
154
                            num_items_errored => 0,
155
                            num_ignored => 1,
156
                        },
157
                    },
158
    };
159
    
160
}
161
162
sub _make_marc_batch {
163
    my $defs = shift;
164
    my @marc = ();
165
    foreach my $rec (@$defs) {
166
        if (ref($rec) eq 'ARRAY') {
167
            my $isbn = $rec->[0];
168
            my $title = $rec->[1];
169
            my $items = $rec->[2];
170
            my $bib = MARC::Record->new();
171
            $bib->leader('     nam a22     7a 4500');
172
            $bib->append_fields(MARC::Field->new('020', ' ', ' ', a => $isbn),
173
                                MARC::Field->new('245', ' ', ' ', a => $title));
174
            foreach my $barcode (@$items) {
175
                my ($itemtag, $toss, $barcodesf, $branchsf);
176
                ($itemtag, $toss)   = GetMarcFromKohaField('items.itemnumber', '');
177
                ($toss, $barcodesf) = GetMarcFromKohaField('items.barcode', '');
178
                ($toss, $branchsf)  = GetMarcFromKohaField('items.homebranch', '');
179
                $bib->append_fields(MARC::Field->new($itemtag, ' ', ' ', $barcodesf => $barcode, $branchsf => 'CPL')); 
180
                        # FIXME: define branch in KohaTest
181
            }
182
            push @marc, $bib->as_usmarc();
183
        } else {
184
            push @marc, $rec;
185
        }
186
    }
187
    return join('', @marc);
188
}
189
190
sub stage_commit_batches : Test( 75 ) {
191
    my $self = shift;
192
193
    my $matcher = C4::Matcher->fetch($self->{'matcher_id'});
194
    ok(ref($matcher) eq 'C4::Matcher', "retrieved matcher");
195
196
    for my $batch_key (sort keys %{ $self->{'batches'} }) {
197
        my $batch = $self->{'batches'}->{$batch_key};
198
        my $args = $batch->{'args'};
199
        my $results = $batch->{'results'};
200
        my ($batch_id, $num_bibs, $num_items, @invalid) =
201
            BatchStageMarcRecords('MARC21', $batch->{marc}, "$batch_key.mrc", "$batch_key comments", 
202
                                  '', $args->{'parse_items'}, 0);
203
        like($batch_id, qr/^\d+$/, "staged $batch_key");
204
        cmp_ok($num_bibs, "==", $results->{'num_bibs'}, "$batch_key: correct number of bibs");
205
        cmp_ok($num_items, "==", $results->{'num_items'}, "$batch_key: correct number of items");
206
        cmp_ok(scalar(@invalid), "==", $results->{'num_invalid'}, "$batch_key: correct number of invalid bibs");
207
208
        my $num_matches = BatchFindBibDuplicates($batch_id, $matcher, 10);
209
        cmp_ok($num_matches, "==", $results->{'num_matches'}, "$batch_key: correct number of bib matches");
210
211
        if (defined $args->{'overlay_action'}) {
212
            if ($args->{'overlay_action'} eq 'create_new') {
213
                cmp_ok(GetImportBatchOverlayAction($batch_id), "eq", 'create_new', "$batch_key: verify default overlay action");
214
            } else {
215
                SetImportBatchOverlayAction($batch_id, $args->{'overlay_action'});
216
                cmp_ok(GetImportBatchOverlayAction($batch_id), "eq", $args->{'overlay_action'}, 
217
                                                   "$batch_key: changed overlay action");
218
            }
219
        }
220
        if (defined $args->{'nomatch_action'}) {
221
            if ($args->{'nomatch_action'} eq 'create_new') {
222
                cmp_ok(GetImportBatchNoMatchAction($batch_id), "eq", 'create_new', "$batch_key: verify default nomatch action");
223
            } else {
224
                SetImportBatchNoMatchAction($batch_id, $args->{'nomatch_action'});
225
                cmp_ok(GetImportBatchNoMatchAction($batch_id), "eq", $args->{'nomatch_action'}, 
226
                                                   "$batch_key: changed nomatch action");
227
            }
228
        }
229
        if (defined $args->{'item_action'}) {
230
            if ($args->{'item_action'} eq 'create_new') {
231
                cmp_ok(GetImportBatchItemAction($batch_id), "eq", 'always_add', "$batch_key: verify default item action");
232
            } else {
233
                SetImportBatchItemAction($batch_id, $args->{'item_action'});
234
                cmp_ok(GetImportBatchItemAction($batch_id), "eq", $args->{'item_action'}, 
235
                                                   "$batch_key: changed item action");
236
            }
237
        }
238
239
        my ($num_added, $num_updated, $num_items_added, 
240
            $num_items_errored, $num_ignored) = BatchCommitBibRecords($batch_id,'');
241
        cmp_ok($num_added,         "==", $results->{'num_added'},         "$batch_key: added correct number of bibs");
242
        cmp_ok($num_updated,       "==", $results->{'num_updated'},       "$batch_key: updated correct number of bibs");
243
        cmp_ok($num_items_added,   "==", $results->{'num_items_added'},   "$batch_key: added correct number of items");
244
        cmp_ok($num_items_errored, "==", $results->{'num_items_errored'}, "$batch_key: correct number of item add errors");
245
        cmp_ok($num_ignored,       "==", $results->{'num_ignored'},       "$batch_key: ignored correct number of bibs");
246
247
        $self->reindex_marc();
248
    }
249
     
250
}
251
252
1;
(-)a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm (-39 lines)
Lines 1-39 Link Here
1
package KohaTest::ImportBatch::getImportBatch;
2
use base qw( KohaTest::ImportBatch );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ImportBatch;
10
use C4::Matcher;
11
use C4::Biblio;
12
13
14
=head3 add_one_and_find_it
15
16
=cut
17
18
sub add_one_and_find_it : Test( 7 ) {
19
    my $self = shift;
20
21
    my $batch = {
22
        overlay_action => 'create_new',
23
        import_status  => 'staging',
24
        batch_type     => 'batch',
25
        file_name      => 'foo',
26
        comments       => 'inserted during automated testing',
27
    };
28
    my $batch_id = AddImportBatch($batch);
29
    ok( $batch_id, "successfully inserted batch: $batch_id" );
30
31
    my $retrieved = GetImportBatch( $batch_id );
32
33
    foreach my $key ( keys %$batch ) {
34
        is( $retrieved->{$key}, $batch->{$key}, "both objects agree on $key" );
35
    }
36
    is( $retrieved->{'import_batch_id'}, $batch_id, 'batch_id' );
37
}
38
39
1;
(-)a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportRecordMarc.pm (-51 lines)
Lines 1-51 Link Here
1
package KohaTest::ImportBatch::GetImportRecordMarc;
2
use base qw( KohaTest::ImportBatch );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ImportBatch;
10
use C4::Matcher;
11
use C4::Biblio;
12
13
14
=head3 record_does_not_exist
15
16
=cut
17
18
sub record_does_not_exist : Test( 1 ) {
19
    my $self = shift;
20
21
    my $id = '999999999999';
22
    my $marc = GetImportRecordMarc( $id );
23
    ok( ! defined( $marc ), 'this marc is undefined' );
24
25
}
26
27
sub record_does_exist : Test( 4 ) {
28
    my $self = shift;
29
30
    # we need an import_batch, so let GetZ3950BatchId create one:
31
    my $new_batch_id = GetZ3950BatchId('foo');
32
    ok( $new_batch_id, "got a new batch ID: $new_batch_id" );
33
34
    my $sth = C4::Context->dbh->prepare(
35
        "INSERT INTO import_records (import_batch_id, marc, marcxml)
36
                                    VALUES (?, ?, ?)"
37
    );
38
    my $execute = $sth->execute(
39
        $new_batch_id,    # batch_id
40
        'marc',           # marc
41
        'marcxml',        # marcxml
42
    );
43
    ok( $execute, 'succesfully executed' );
44
    my $import_record_id = C4::Context->dbh->{'mysql_insertid'};
45
    ok( $import_record_id, 'we got an import_record_id' );
46
47
    my $marc = GetImportRecordMarc($import_record_id);
48
    ok( defined($marc), 'this marc is defined' );
49
}
50
51
1;
(-)a/t/db_dependent/lib/KohaTest/ImportBatch/GetZ3950BatchId.pm (-42 lines)
Lines 1-42 Link Here
1
package KohaTest::ImportBatch::GetZ3950BatchId;
2
use base qw( KohaTest::ImportBatch );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ImportBatch;
10
use C4::Matcher;
11
use C4::Biblio;
12
13
14
=head3 batch_does_not_exist
15
16
=cut
17
18
sub batch_does_not_exist : Test( 5 ) {
19
    my $self = shift;
20
21
    my $file_name = 'testing batch';
22
23
    # lets make sure it doesn't exist first
24
    my $sth = C4::Context->dbh->prepare('SELECT import_batch_id FROM import_batches
25
                                         WHERE  batch_type = ?
26
                                         AND    file_name = ?');
27
    ok( $sth->execute( 'z3950', $file_name, ), 'execute' );
28
    my $rowref = $sth->fetchrow_arrayref();
29
    ok( !defined( $rowref ), 'this batch does not exist' );
30
31
    # now let GetZ3950BatchId create one
32
    my $new_batch_id = GetZ3950BatchId( $file_name );
33
    ok( $new_batch_id, "got a new batch ID: $new_batch_id" );
34
35
    # now search for the one that was just created
36
    my $second_batch_id = GetZ3950BatchId( $file_name );
37
    ok( $second_batch_id, "got a second batch ID: $second_batch_id" );
38
    is( $second_batch_id, $new_batch_id, 'we got the same batch both times.' );
39
}
40
41
42
1;
(-)a/t/db_dependent/lib/KohaTest/Installer.pm (-41 lines)
Lines 1-41 Link Here
1
package KohaTest::Installer;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
use C4::Languages;
9
use C4::Installer;
10
11
sub SKIP_CLASS : Expensive { }
12
13
sub testing_class { 'C4::Installer' };
14
15
sub methods : Test( 1 ) {
16
    my $self = shift;
17
    my @methods = qw(
18
                       new 
19
                       marcflavour_list 
20
                       marc_framework_sql_list 
21
                       sample_data_sql_list 
22
                       sql_file_list 
23
                       load_db_schema 
24
                       load_sql_in_order 
25
                       set_marcflavour_syspref 
26
                       set_version_syspref 
27
                       load_sql 
28
    );
29
    can_ok( $self->testing_class, @methods );
30
}
31
32
# ensure that we have a fresh, empty database
33
# after running through the installer tests
34
sub shutdown_50_init_db : Tests( shutdown )  {
35
    my $self = shift;
36
37
    KohaTest::clear_test_database();
38
    KohaTest::create_test_database();
39
}
40
41
1;
(-)a/t/db_dependent/lib/KohaTest/Installer/SqlScripts.pm (-83 lines)
Lines 1-83 Link Here
1
package KohaTest::Installer::SqlScripts;
2
use base qw( KohaTest::Installer );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
use C4::Languages;
9
use C4::Installer;
10
11
sub startup_50_get_installer : Test( startup => 1 ) {
12
    my $self = shift;
13
    my $installer = C4::Installer->new();
14
    is(ref($installer), "C4::Installer", "created installer");
15
    $self->{installer} = $installer;
16
}
17
18
sub installer_all_sample_data : Tests {
19
    my $self = shift;
20
21
    skip "did not create installer" unless ref($self->{installer}) eq 'C4::Installer';
22
23
    my $all_languages = getAllLanguages();
24
    # find the available directory names
25
    my $dir=C4::Context->config('intranetdir')."/installer/data/" . 
26
            (C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql") . "/";
27
    opendir (MYDIR,$dir);
28
    my @languages = grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);    
29
    closedir MYDIR;
30
    
31
    cmp_ok(scalar(@languages), '>', 0, "at least one framework language defined");
32
    
33
    foreach my $lang_code (@languages) {
34
        SKIP: {
35
            my $marc_flavours = $self->{installer}->marcflavour_list($lang_code);
36
            ok(defined($marc_flavours), "at least one MARC flavour for $lang_code");
37
            skip "no MARC flavours for $lang_code" unless defined($marc_flavours);
38
39
            foreach my $flavour (@$marc_flavours) {
40
                SKIP: {
41
                    $self->clear_test_database();
42
                    my $schema_error = $self->{installer}->load_db_schema();
43
                    is($schema_error, "", "no errors during schema load");
44
                    skip "error during schema load" if $schema_error ne "";
45
        
46
                    my $list = $self->{installer}->sql_file_list($lang_code, $flavour, { optional => 1, mandatory => 1 });
47
                    my $sql_count = scalar(@$list);
48
                    cmp_ok($sql_count, '>', 0, "at least one SQL init file for $lang_code, $flavour");
49
                    skip "no SQL init files defined for $lang_code, $flavour" unless $sql_count > 0;
50
51
                    my ($fwk_language, $installed_list) = $self->{installer}->load_sql_in_order($all_languages, @$list);
52
53
                    # extract list of files
54
                    my $level;
55
                    my @file_list = map { 
56
                                            map { $_->{level} = $level; $_ } @{ $level = $_->{level}; $_->{fwklist} } 
57
                                        } @$installed_list; 
58
                    my $num_processed = scalar(@file_list);
59
                    cmp_ok($num_processed, '==', $sql_count, "processed all sql scripts for $lang_code, $flavour");
60
61
                    my %sql_to_load = map { my $file = $_; 
62
                                            my @file = split qr(\/|\\), $file; 
63
                                            join("\t", $file[-2], $file[-1]) => 1 
64
                                           } @$list;
65
                    foreach my $sql (@file_list) {
66
                        ok(exists($sql_to_load{ "$sql->{level}\t$sql->{fwkname}" }), 
67
                            "SQL script $sql->{level}/$sql->{fwkname} is on list");
68
                        delete $sql_to_load{ "$sql->{level}\t$sql->{fwkname}" };
69
                        is($sql->{error}, "", "no errors when loading $sql->{fwkname}");
70
                    }
71
                    ok(not(%sql_to_load), "no SQL scripts for $lang_code, $flavour left unloaded");
72
                }
73
            }
74
        }
75
    }
76
}
77
78
sub shutdown_50_clear_installer : Tests( shutdown ) {
79
    my $self = shift;
80
    delete $self->{installer};
81
}
82
83
1;
(-)a/t/db_dependent/lib/KohaTest/Installer/get_file_path_from_name.pm (-36 lines)
Lines 1-36 Link Here
1
package KohaTest::Installer::get_file_path_from_name;
2
use base qw( KohaTest::Installer );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
use C4::Languages;
9
use C4::Installer;
10
11
sub startup_50_get_installer : Test( startup => 1 ) {
12
    my $self = shift;
13
    my $installer = C4::Installer->new();
14
    is(ref($installer), "C4::Installer", "created installer");
15
    $self->{installer} = $installer;
16
}
17
18
sub search_for_known_scripts : Tests( 2 ) {
19
    my $self = shift;
20
21
    skip "did not create installer" unless ref($self->{installer}) eq 'C4::Installer';
22
23
    foreach my $script ( 'installer/data/mysql/en/mandatory/message_transport_types.sql',
24
                         'installer/data/mysql/en/optional/sample_notices_message_attributes.sql', ) {
25
26
        ok( $self->{'installer'}->get_file_path_from_name( $script ), "found $script" );
27
    }
28
    
29
}
30
31
sub shutdown_50_clear_installer : Tests( shutdown ) {
32
    my $self = shift;
33
    delete $self->{installer};
34
}
35
36
1;
(-)a/t/db_dependent/lib/KohaTest/ItemCirculationAlertPreference.pm (-27 lines)
Lines 1-27 Link Here
1
package KohaTest::ItemCirculationAlertPreference;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ItemCirculationAlertPreference;
10
sub testing_class { 'C4::ItemCirculationAlertPreference' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( 
16
                    new
17
                    create
18
                    delete
19
                    is_enabled_for
20
                    find
21
                    grid
22
                );
23
    
24
    can_ok( $self->testing_class, @methods );    
25
}
26
27
1;
(-)a/t/db_dependent/lib/KohaTest/ItemType.pm (-23 lines)
Lines 1-23 Link Here
1
package KohaTest::ItemType;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::ItemType;
10
sub testing_class { 'C4::ItemType' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( 
16
                    new
17
                    all
18
                );
19
    
20
    can_ok( $self->testing_class, @methods );    
21
}
22
23
1;
(-)a/t/db_dependent/lib/KohaTest/Items.pm (-61 lines)
Lines 1-61 Link Here
1
package KohaTest::Items;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Items;
10
sub testing_class { 'C4::Items' }
11
12
sub methods : Test( 1 ) {
13
    my $self    = shift;
14
    my @methods = qw(
15
16
      GetItem
17
      AddItemFromMarc
18
      AddItem
19
      AddItemBatchFromMarc
20
      ModItemFromMarc
21
      ModItem
22
      ModItemTransfer
23
      ModDateLastSeen
24
      DelItem
25
      CheckItemPreSave
26
      GetItemStatus
27
      GetItemLocation
28
      GetLostItems
29
      GetItemsForInventory
30
      GetItemsCount
31
      GetItemInfosOf
32
      GetItemsByBiblioitemnumber
33
      GetItemsInfo
34
      get_itemnumbers_of
35
      GetItemnumberFromBarcode
36
      get_item_authorised_values
37
      get_authorised_value_images
38
      GetMarcItem
39
      _set_derived_columns_for_add
40
      _set_derived_columns_for_mod
41
      _do_column_fixes_for_mod
42
      _get_single_item_column
43
      _calc_items_cn_sort
44
      _set_defaults_for_add
45
      _koha_new_item
46
      _koha_modify_item
47
      _koha_delete_item
48
      _marc_from_item_hash
49
      _add_item_field_to_biblio
50
      _replace_item_field_in_biblio
51
      _repack_item_errors
52
      _get_unlinked_item_subfields
53
      _get_unlinked_subfields_xml
54
      _parse_unlinked_item_subfields_from_xml
55
      PrepareItemrecordDisplay
56
    );
57
58
    can_ok( $self->testing_class, @methods );
59
}
60
61
1;
(-)a/t/db_dependent/lib/KohaTest/Items/ColumnFixes.pm (-77 lines)
Lines 1-77 Link Here
1
package KohaTest::Items::ColumnFixes;
2
use base qw( KohaTest::Items );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Items;
10
11
=head2 STARTUP METHODS
12
13
These get run once, before the main test methods in this module
14
15
=cut
16
17
=head2 TEST METHODS
18
19
standard test methods
20
21
=head3 not_defined
22
23
24
=cut
25
26
sub not_defined : Test( 4 ) {
27
28
    my $item_mod_fixes_1 = {
29
        notforloan => undef,
30
        damaged    => undef,
31
        wthdrawn   => undef,
32
        itemlost   => undef,
33
    };
34
35
    C4::Items::_do_column_fixes_for_mod($item_mod_fixes_1);
36
    is( $item_mod_fixes_1->{'notforloan'}, 0, 'null notforloan fixed during mod' );
37
    is( $item_mod_fixes_1->{'damaged'},    0, 'null damaged fixed during mod' );
38
    is( $item_mod_fixes_1->{'wthdrawn'},   0, 'null wthdrawn fixed during mod' );
39
    is( $item_mod_fixes_1->{'itemlost'},   0, 'null itemlost fixed during mod' );
40
41
}
42
43
sub empty : Test( 4 ) {
44
45
    my $item_mod_fixes_2 = {
46
        notforloan => '',
47
        damaged    => '',
48
        wthdrawn   => '',
49
        itemlost   => '',
50
    };
51
52
    C4::Items::_do_column_fixes_for_mod($item_mod_fixes_2);
53
    is( $item_mod_fixes_2->{'notforloan'}, 0, 'empty notforloan fixed during mod' );
54
    is( $item_mod_fixes_2->{'damaged'},    0, 'empty damaged fixed during mod' );
55
    is( $item_mod_fixes_2->{'wthdrawn'},   0, 'empty wthdrawn fixed during mod' );
56
    is( $item_mod_fixes_2->{'itemlost'},   0, 'empty itemlost fixed during mod' );
57
58
}
59
60
sub not_clobbered : Test( 4 ) {
61
62
    my $item_mod_fixes_3 = {
63
        notforloan => 1,
64
        damaged    => 2,
65
        wthdrawn   => 3,
66
        itemlost   => 4,
67
    };
68
69
    C4::Items::_do_column_fixes_for_mod($item_mod_fixes_3);
70
    is( $item_mod_fixes_3->{'notforloan'}, 1, 'do not clobber notforloan during mod' );
71
    is( $item_mod_fixes_3->{'damaged'},    2, 'do not clobber damaged during mod' );
72
    is( $item_mod_fixes_3->{'wthdrawn'},   3, 'do not clobber wthdrawn during mod' );
73
    is( $item_mod_fixes_3->{'itemlost'},   4, 'do not clobber itemlost during mod' );
74
75
}
76
77
1;
(-)a/t/db_dependent/lib/KohaTest/Items/GetItemsForInventory.pm (-123 lines)
Lines 1-123 Link Here
1
package KohaTest::Items::GetItemsForInventory;
2
use base qw( KohaTest::Items );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Items;
10
11
=head2 STARTUP METHODS
12
13
These get run once, before the main test methods in this module
14
15
=cut
16
17
=head2 startup_90_add_item_get_callnumber
18
19
=cut
20
21
sub startup_90_add_item_get_callnumber : Test( startup => 13 ) {
22
    my $self = shift;
23
24
    $self->add_biblios( add_items => 1 );
25
26
    ok( $self->{'items'}, 'An item has been aded' )
27
      or diag( Data::Dumper->Dump( [ $self->{'items'} ], ['items'] ) );
28
29
    my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $self->{'items'}[0]{'biblionumber'} );
30
    ok( $biblioitems[0]->{'biblioitemnumber'}, '...and it has a biblioitemnumber' )
31
      or diag( Data::Dumper->Dump( [ \@biblioitems ], ['biblioitems'] ) );
32
33
    my $items_info = GetItemsByBiblioitemnumber( $biblioitems[0]->{'biblioitemnumber'} );
34
    isa_ok( $items_info, 'ARRAY', '...and we can search with that biblioitemnumber' )
35
      or diag( Data::Dumper->Dump( [$items_info], ['items_info'] ) );
36
    cmp_ok( scalar @$items_info, '>', 0, '...and we can find at least one item with that biblioitemnumber' );
37
38
    my $item_info = $items_info->[0];
39
    ok( $item_info->{'itemcallnumber'}, '...and the item we found has a call number: ' . $item_info->{'itemcallnumber'} )
40
      or diag( Data::Dumper->Dump( [$item_info], ['item_info'] ) );
41
42
    $self->{'callnumber'} = $item_info->{'itemcallnumber'};
43
}
44
45
46
=head2 TEST METHODS
47
48
standard test methods
49
50
=head3 missing_parameters
51
52
the minlocation and maxlocation parameters are required. If they are
53
not provided, this method should somehow complain, such as returning
54
undef or emitina warning or something.
55
56
=cut
57
58
sub missing_parameters : Test( 1 ) {
59
    my $self = shift;
60
    local $TODO = 'GetItemsForInventory should fail when missing required parameters';
61
62
    my $items = C4::Items::GetItemsForInventory();
63
    ok( ! defined $items, 'GetItemsForInventory fails when parameters are missing' )
64
      or diag( Data::Dumper->Dump( [ $items ], [ 'items' ] ) );
65
}
66
67
=head3 basic_usage
68
69
70
=cut
71
72
sub basic_usage : Test( 4 ) {
73
    my $self = shift;
74
75
    ok( $self->{'callnumber'}, 'we have a call number to search for: ' . $self->{'callnumber'} );
76
    my $items = C4::Items::GetItemsForInventory( $self->{'callnumber'}, $self->{'callnumber'} );
77
    isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' );
78
    is( scalar @$items, 1, '...and we found only one item' );
79
    my $our_item = $items->[0];
80
    is( $our_item->{'itemnumber'},     $self->{'items'}[0]{'itemnumber'},                 '...and the item we found has the right itemnumber' );
81
82
    # diag( Data::Dumper->Dump( [$items], ['items'] ) );
83
}
84
85
=head3 date_last_seen
86
87
88
=cut
89
90
sub date_last_seen : Test( 6 ) {
91
    my $self = shift;
92
93
    ok( $self->{'callnumber'}, 'we have a call number to search for: ' . $self->{'callnumber'} );
94
95
    my $items = C4::Items::GetItemsForInventory(
96
        $self->{'callnumber'},    # minlocation
97
        $self->{'callnumber'},    # maxlocation
98
        undef,                    # location
99
        undef,                    # itemtype
100
        C4::Dates->new( $self->tomorrow(), 'iso' )->output,    # datelastseen
101
    );
102
103
    isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' );
104
    is( scalar @$items, 1, '...and we found only one item' );
105
    my $our_item = $items->[0];
106
    is( $our_item->{'itemnumber'}, $self->{'items'}[0]{'itemnumber'}, '...and the item we found has the right itemnumber' );
107
108
    # give a datelastseen of yesterday, and we should not get our item.
109
    $items = C4::Items::GetItemsForInventory(
110
        $self->{'callnumber'},    # minlocation
111
        $self->{'callnumber'},    # maxlocation
112
        undef,                    # location
113
        undef,                    # itemtype
114
        C4::Dates->new( $self->yesterday(), 'iso' )->output,    # datelastseen
115
    );
116
117
    isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' );
118
    is( scalar @$items, 0, '...and we found no items' );
119
120
}
121
122
123
1;
(-)a/t/db_dependent/lib/KohaTest/Items/ModItemsFromMarc.pm (-91 lines)
Lines 1-91 Link Here
1
package KohaTest::Items::ModItemsFromMarc;
2
use base qw( KohaTest::Items );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Context;
10
use C4::Biblio;
11
use C4::Items;
12
13
=head2 STARTUP METHODS
14
15
These get run once, before the main test methods in this module
16
17
=cut
18
19
=head2 startup_90_add_item_get_callnumber
20
21
=cut
22
23
sub startup_90_add_item_get_callnumber : Test( startup => 13 ) {
24
    my $self = shift;
25
26
    $self->add_biblios( count => 1, add_items => 1 );
27
28
    ok( $self->{'items'}, 'An item has been aded' )
29
      or diag( Data::Dumper->Dump( [ $self->{'items'} ], ['items'] ) );
30
31
    my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $self->{'items'}[0]{'biblionumber'} );
32
    ok( $biblioitems[0]->{'biblioitemnumber'}, '...and it has a biblioitemnumber' )
33
      or diag( Data::Dumper->Dump( [ \@biblioitems ], ['biblioitems'] ) );
34
35
    my $items_info = GetItemsByBiblioitemnumber( $biblioitems[0]->{'biblioitemnumber'} );
36
    isa_ok( $items_info, 'ARRAY', '...and we can search with that biblioitemnumber' )
37
      or diag( Data::Dumper->Dump( [$items_info], ['items_info'] ) );
38
    cmp_ok( scalar @$items_info, '>', 0, '...and we can find at least one item with that biblioitemnumber' );
39
40
    my $item_info = $items_info->[0];
41
    ok( $item_info->{'itemcallnumber'}, '...and the item we found has a call number: ' . $item_info->{'itemcallnumber'} )
42
      or diag( Data::Dumper->Dump( [$item_info], ['item_info'] ) );
43
44
    $self->{itemnumber} = $item_info->{itemnumber};
45
}
46
47
48
=head2 TEST METHODS
49
50
standard test methods
51
52
=head3 bug2466
53
54
Regression test for bug 2466 (when clearing an item field
55
via the cataloging or serials item editor, corresponding
56
column is not cleared).
57
58
=cut
59
60
sub bug2466 : Test( 8 ) {
61
    my $self = shift;
62
63
    my $item = C4::Items::GetItem($self->{itemnumber});
64
    isa_ok($item, 'HASH', "item $self->{itemnumber} exists");
65
   
66
    my $item_marc = C4::Items::GetMarcItem($item->{biblionumber}, $self->{itemnumber});
67
    isa_ok($item_marc, 'MARC::Record', "retrieved item MARC");
68
69
    cmp_ok($item->{itemcallnumber}, 'ne', '', "item call number is not blank");
70
71
    my ($callnum_tag, $callnum_subfield) = C4::Biblio::GetMarcFromKohaField('items.itemcallnumber', '');
72
    cmp_ok($callnum_tag, '>', 0, "found tag for itemcallnumber");
73
74
    my $item_field = $item_marc->field($callnum_tag);
75
    ok(defined($item_field), "retrieved MARC field for item");
76
77
    $item_field->delete_subfield(code => $callnum_subfield);
78
79
    my $dbh = C4::Context->dbh;
80
    my $item_from_marc = C4::Biblio::TransformMarcToKoha($dbh, $item_marc, '', 'items');
81
    ok(not(exists($item_from_marc->{itemcallnumber})), "itemcallnumber subfield removed");
82
83
    C4::Items::ModItemFromMarc($item_marc, $item->{biblionumber}, $self->{itemnumber});
84
85
    my $modified_item = C4::Items::GetItem($self->{itemnumber});
86
    isa_ok($modified_item, 'HASH', "retrieved modified item");
87
88
    ok(not(defined($modified_item->{itemcallnumber})), "itemcallnumber is now undef");
89
}
90
91
1;
(-)a/t/db_dependent/lib/KohaTest/Items/SetDefaults.pm (-86 lines)
Lines 1-86 Link Here
1
package KohaTest::Items::SetDefaults;
2
use base qw( KohaTest::Items );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Items;
10
11
=head2 STARTUP METHODS
12
13
These get run once, before the main test methods in this module
14
15
=cut
16
17
=head2 TEST METHODS
18
19
standard test methods
20
21
=head3 
22
23
24
=cut
25
26
sub add_some_items : Test( 3 ) {
27
28
    my $item_to_add_1 = { itemnotes => 'newitem', };
29
30
    C4::Items::_set_defaults_for_add($item_to_add_1);
31
    ok( exists $item_to_add_1->{'dateaccessioned'}, 'dateaccessioned added to new item' );
32
    like( $item_to_add_1->{'dateaccessioned'}, qr/^\d\d\d\d-\d\d-\d\d$/, 'new dateaccessioned is dddd-dd-dd' );
33
    is( $item_to_add_1->{'itemnotes'}, 'newitem', 'itemnotes not clobbered' );
34
35
}
36
37
sub undefined : Test( 4 ) {
38
    my $item_add_fixes_1 = {
39
        notforloan => undef,
40
        damaged    => undef,
41
        wthdrawn   => undef,
42
        itemlost   => undef,
43
    };
44
45
    C4::Items::_set_defaults_for_add($item_add_fixes_1);
46
    is( $item_add_fixes_1->{'notforloan'}, 0, 'null notforloan fixed during add' );
47
    is( $item_add_fixes_1->{'damaged'},    0, 'null damaged fixed during add' );
48
    is( $item_add_fixes_1->{'wthdrawn'},   0, 'null wthdrawn fixed during add' );
49
    is( $item_add_fixes_1->{'itemlost'},   0, 'null itemlost fixed during add' );
50
}
51
52
sub empty_gets_fixed : Test( 4 ) {
53
54
    my $item_add_fixes_2 = {
55
        notforloan => '',
56
        damaged    => '',
57
        wthdrawn   => '',
58
        itemlost   => '',
59
    };
60
61
    C4::Items::_set_defaults_for_add($item_add_fixes_2);
62
    is( $item_add_fixes_2->{'notforloan'}, 0, 'empty notforloan fixed during add' );
63
    is( $item_add_fixes_2->{'damaged'},    0, 'empty damaged fixed during add' );
64
    is( $item_add_fixes_2->{'wthdrawn'},   0, 'empty wthdrawn fixed during add' );
65
    is( $item_add_fixes_2->{'itemlost'},   0, 'empty itemlost fixed during add' );
66
67
}
68
69
sub do_not_clobber : Test( 4 ) {
70
71
    my $item_add_fixes_3 = {
72
        notforloan => 1,
73
        damaged    => 2,
74
        wthdrawn   => 3,
75
        itemlost   => 4,
76
    };
77
78
    C4::Items::_set_defaults_for_add($item_add_fixes_3);
79
    is( $item_add_fixes_3->{'notforloan'}, 1, 'do not clobber notforloan during mod' );
80
    is( $item_add_fixes_3->{'damaged'},    2, 'do not clobber damaged during mod' );
81
    is( $item_add_fixes_3->{'wthdrawn'},   3, 'do not clobber wthdrawn during mod' );
82
    is( $item_add_fixes_3->{'itemlost'},   4, 'do not clobber itemlost during mod' );
83
84
}
85
86
1;
(-)a/t/db_dependent/lib/KohaTest/Koha.pm (-49 lines)
Lines 1-49 Link Here
1
package KohaTest::Koha;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Koha;
10
sub testing_class { 'C4::Koha' }
11
12
sub methods : Test( 1 ) {
13
    my $self    = shift;
14
    my @methods = qw( slashifyDate
15
      DisplayISBN
16
      subfield_is_koha_internal_p
17
      GetItemTypes
18
      get_itemtypeinfos_of
19
      GetCcodes
20
      getauthtypes
21
      getauthtype
22
      getframeworks
23
      getframeworkinfo
24
      getitemtypeinfo
25
      getitemtypeimagedir
26
      getitemtypeimagesrc
27
      getitemtypeimagelocation
28
      _getImagesFromDirectory
29
      _getSubdirectoryNames
30
      getImageSets
31
      GetPrinters
32
      GetPrinter
33
      getnbpages
34
      getallthemes
35
      getFacets
36
      get_infos_of
37
      get_notforloan_label_of
38
      displayServers
39
      GetAuthValCode
40
      GetAuthorisedValues
41
      GetAuthorisedValueCategories
42
      GetKohaAuthorisedValues
43
      display_marc_indicators
44
    );
45
46
    can_ok( $self->testing_class, @methods );
47
}
48
49
1;
(-)a/t/db_dependent/lib/KohaTest/Koha/displayServers.pm (-192 lines)
Lines 1-192 Link Here
1
package KohaTest::Koha::displayServers;
2
use base qw( KohaTest::Koha );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Koha;
10
11
=head2 basic_usage
12
13
call displayServers with no parameters and investigate the things that
14
it returns. This depends on there being at least one server defined,
15
as do some other tests in this module.
16
17
=cut
18
19
sub basic_usage : Test( 12 ) {
20
    my $self = shift;
21
22
    my $servers = C4::Koha::displayServers();
23
    isa_ok( $servers, 'ARRAY' );
24
    my $firstserver = $servers->[0];
25
    isa_ok( $firstserver, 'HASH' );
26
27
    my @keys = qw( opensearch icon value name checked zed label id encoding );
28
    is( scalar keys %$firstserver, scalar @keys, 'the hash has the right number of keys' );
29
    foreach my $key ( @keys ) {
30
        ok( exists $firstserver->{$key}, "There is a $key key" );
31
    }
32
33
    # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) );
34
}
35
36
=head2 position_does_not_exist
37
38
call displayServers with a position that does not exist and make sure
39
that we get none back.
40
41
=cut
42
43
sub position_does_not_exist : Test( 2 ) {
44
    my $self = shift;
45
46
    my $servers = C4::Koha::displayServers( 'this does not exist' );
47
    isa_ok( $servers, 'ARRAY' );
48
    is( scalar @$servers, 0, 'received no servers' );
49
50
    # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) );
51
}
52
53
=head2 position_does_exist
54
55
call displayServers with a position that does exist and make sure that
56
we get at least one back.
57
58
=cut
59
60
sub position_does_exist : Test( 3 ) {
61
    my $self = shift;
62
63
    my $position = $self->_get_a_position();
64
    ok( $position, 'We have a position that exists' );
65
    
66
    my $servers = C4::Koha::displayServers( $position );
67
    isa_ok( $servers, 'ARRAY' );
68
    ok( scalar @$servers, 'received at least one server' );
69
70
    # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) );
71
}
72
73
=head2 type_does_not_exist
74
75
call displayServers with a type that does not exist and make sure
76
that we get none back.
77
78
=cut
79
80
sub type_does_not_exist : Test( 2 ) {
81
    my $self = shift;
82
83
    my $servers = C4::Koha::displayServers( undef, 'this does not exist' );
84
    isa_ok( $servers, 'ARRAY' );
85
    is( scalar @$servers, 0, 'received no servers' );
86
87
    # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) );
88
}
89
90
=head2 type_does_exist
91
92
call displayServers with a type that does exist and make sure
93
that we get at least one back.
94
95
=cut
96
97
sub type_does_exist : Test( 3 ) {
98
    my $self = shift;
99
100
    my $type = $self->_get_a_type();
101
    ok( $type, 'We have a type that exists' );
102
    
103
    my $servers = C4::Koha::displayServers( undef, $type );
104
    isa_ok( $servers, 'ARRAY' );
105
    ok( scalar @$servers, 'received at least one server' );
106
107
    # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) );
108
}
109
110
=head2 position_and_type
111
112
call displayServers with a variety of both positions and types and
113
verify that we get either something or nothing back.
114
115
116
=cut
117
118
sub position_and_type : Test( 8 ) {
119
    my $self = shift;
120
121
    my ( $position, $type ) = $self->_get_a_position_and_type();
122
    ok( $position, 'We have a type that exists' );
123
    ok( $type, 'We have a type that exists' );
124
    
125
    my $servers = C4::Koha::displayServers( $position, 'type does not exist' );
126
    isa_ok( $servers, 'ARRAY' );
127
    is( scalar @$servers, 0, 'received no servers' );
128
129
    $servers = C4::Koha::displayServers( 'position does not exist', $type );
130
    isa_ok( $servers, 'ARRAY' );
131
    is( scalar @$servers, 0, 'received no servers' );
132
133
    $servers = C4::Koha::displayServers( $position, $type );
134
    isa_ok( $servers, 'ARRAY' );
135
    ok( scalar @$servers, 'received at least one server' );
136
137
    # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) );
138
}
139
140
=head1 INTERNAL METHODS
141
142
these are not test methods, but they help me write them.
143
144
=head2 _get_a_position
145
146
returns a position value for which at least one server exists
147
148
=cut
149
150
sub _get_a_position {
151
    my $self = shift;
152
153
    my ( $position, $type ) = $self->_get_a_position_and_type();
154
    return $position;
155
156
}
157
158
=head2 _get_a_type
159
160
returns a type value for which at least one server exists
161
162
=cut
163
164
sub _get_a_type {
165
    my $self = shift;
166
167
    my ( $position, $type ) = $self->_get_a_position_and_type();
168
    return $type;
169
170
}
171
172
=head2 _get_a_position_and_type
173
174
returns a position and type for a server
175
176
=cut
177
178
sub _get_a_position_and_type {
179
    my $self = shift;
180
181
    my $dbh    = C4::Context->dbh;
182
    my $sql = 'SELECT position, type FROM z3950servers';
183
    my $sth = $dbh->prepare($sql) or return;
184
    $sth->execute or return;
185
186
    my @row = $sth->fetchrow_array;
187
    return ( $row[0], $row[1] );
188
189
}
190
191
  
192
1;
(-)a/t/db_dependent/lib/KohaTest/Koha/get_itemtypeinfos_of.pm (-59 lines)
Lines 1-59 Link Here
1
package KohaTest::Koha::get_itemtypeinfos_of;
2
use base qw( KohaTest::Koha );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Koha;
10
11
=head2 get_one
12
13
calls get_itemtypeinfos_of on one item type and checks that it gets
14
back something sane.
15
16
=cut
17
18
sub get_one : Test( 8 ) {
19
    my $self = shift;
20
21
    my $itemtype_info = C4::Koha::get_itemtypeinfos_of( 'BK' );
22
    ok( $itemtype_info, 'we got back something from get_itemtypeinfos_of' );
23
    isa_ok( $itemtype_info, 'HASH', '...and it' );
24
    ok( exists $itemtype_info->{'BK'}, '...and it has a BK key' )
25
      or diag( Data::Dumper->Dump( [ $itemtype_info ], [ 'itemtype_info' ] ) );
26
    is( scalar keys %$itemtype_info, 1, '...and it has 1 key' );
27
    foreach my $key ( qw( imageurl itemtype notforloan description ) ) {
28
        ok( exists $itemtype_info->{'BK'}{$key}, "...and the BK info has a $key key" );
29
    }
30
    
31
}
32
33
=head2 get_two
34
35
calls get_itemtypeinfos_of on a list of item types and verifies the
36
results.
37
38
=cut
39
40
sub get_two : Test( 13 ) {
41
    my $self = shift;
42
43
    my @itemtypes = qw( BK MU );
44
    my $itemtype_info = C4::Koha::get_itemtypeinfos_of( @itemtypes );
45
    ok( $itemtype_info, 'we got back something from get_itemtypeinfos_of' );
46
    isa_ok( $itemtype_info, 'HASH', '...and it' );
47
    is( scalar keys %$itemtype_info, scalar @itemtypes, '...and it has ' . scalar @itemtypes . ' keys' );
48
    foreach my $it ( @itemtypes ) {
49
        ok( exists $itemtype_info->{$it}, "...and it has a $it key" )
50
          or diag( Data::Dumper->Dump( [ $itemtype_info ], [ 'itemtype_info' ] ) );
51
        foreach my $key ( qw( imageurl itemtype notforloan description ) ) {
52
            ok( exists $itemtype_info->{$it}{$key}, "...and the $it info has a $key key" );
53
        }
54
    }
55
    
56
}
57
58
  
59
1;
(-)a/t/db_dependent/lib/KohaTest/Koha/getitemtypeimagedir.pm (-27 lines)
Lines 1-27 Link Here
1
package KohaTest::Koha::getitemtypeimagedir;
2
use base qw( KohaTest::Koha );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Koha;
10
11
sub check_default : Test( 5 ) {
12
    my $self = shift;
13
14
    my $opac_directory     = C4::Koha::getitemtypeimagedir('opac');
15
    my $default_directory  = C4::Koha::getitemtypeimagedir('opac');
16
    my $intranet_directory = C4::Koha::getitemtypeimagedir('intranet');
17
18
    ok( $opac_directory,     'the opac directory is defined' );
19
    ok( $default_directory,  'the default directory is defined' );
20
    ok( $intranet_directory, 'the intranet directory is defined' );
21
22
    is( $opac_directory, $default_directory, 'the opac directory is returned as the default' );
23
    isnt( $intranet_directory, $default_directory, 'the intranet directory is not the same as the default' );
24
25
}
26
27
1;
(-)a/t/db_dependent/lib/KohaTest/Letters.pm (-27 lines)
Lines 1-27 Link Here
1
package KohaTest::Letters;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
sub testing_class { 'C4::Letters' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( addalert
16
                      delalert
17
                      getalert
18
                      findrelatedto
19
                      SendAlerts
20
                      GetPreparedLetter
21
                );
22
    
23
    can_ok( $self->testing_class, @methods );    
24
}
25
26
1;
27
(-)a/t/db_dependent/lib/KohaTest/Letters/GetLetter.pm (-32 lines)
Lines 1-32 Link Here
1
package KohaTest::Letters::GetLetter;
2
use base qw( KohaTest::Letters );
3
4
use strict;
5
use warnings;
6
7
use C4::Letters;
8
use Test::More;
9
10
sub GetLetter : Test( 6 ) {
11
    my $self = shift;
12
13
    my $letter = getletter( 'circulation', 'ODUE', '' );
14
15
    isa_ok( $letter, 'HASH' )
16
      or diag( Data::Dumper->Dump( [ $letter ], [ 'letter' ] ) );
17
18
    is( $letter->{'code'},   'ODUE',        'code' );
19
    is( $letter->{'module'}, 'circulation', 'module' );
20
    ok( exists $letter->{'content'}, 'content' );
21
    ok( exists $letter->{'name'}, 'name' );
22
    ok( exists $letter->{'title'}, 'title' );
23
24
}
25
26
1;
27
28
29
30
31
32
(-)a/t/db_dependent/lib/KohaTest/Letters/GetLetters.pm (-30 lines)
Lines 1-30 Link Here
1
package KohaTest::Letters::GetLetters;
2
use base qw( KohaTest::Letters );
3
4
use strict;
5
use warnings;
6
7
use C4::Letters;
8
use Test::More;
9
10
sub GetDefaultLetters : Test( 2 ) {
11
    my $self = shift;
12
13
    my $letters = GetLetters();
14
15
    # the default install includes several entries in the letter table.
16
    isa_ok( $letters, 'HASH' )
17
      or diag( Data::Dumper->Dump( [ $letters ], [ 'letters' ] ) );
18
19
  ok( scalar keys( %$letters ) > 0, 'we got some letters' );
20
21
22
}
23
24
1;
25
26
27
28
29
30
(-)a/t/db_dependent/lib/KohaTest/Log.pm (-25 lines)
Lines 1-25 Link Here
1
package KohaTest::Log;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Log;
10
sub testing_class { 'C4::Log' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( logaction 
16
                       GetLogStatus 
17
                       displaylog 
18
                       GetLogs 
19
                );
20
    
21
    can_ok( $self->testing_class, @methods );    
22
}
23
24
1;
25
(-)a/t/db_dependent/lib/KohaTest/Members.pm (-63 lines)
Lines 1-63 Link Here
1
package KohaTest::Members;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
sub testing_class { 'C4::Members' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( Search
16
                      GetMemberDetails 
17
                      patronflags 
18
                      GetMember 
19
                      GetMemberIssuesAndFines 
20
                      ModMember 
21
                      AddMember 
22
                      Check_Userid 
23
                      changepassword 
24
                      fixup_cardnumber
25
                      GetGuarantees 
26
                      UpdateGuarantees 
27
                      GetPendingIssues 
28
                      GetAllIssues 
29
                      GetMemberAccountRecords 
30
                      GetMemberAccountBalance
31
                      GetBorNotifyAcctRecord 
32
                      checkuniquemember 
33
                      checkcardnumber 
34
                      getzipnamecity 
35
                      getidcity 
36
                      GetExpiryDate 
37
                      checkuserpassword 
38
                      GetborCatFromCatType 
39
                      GetBorrowercategory 
40
                      ethnicitycategories 
41
                      fixEthnicity 
42
                      GetAge
43
                      get_institutions 
44
                      add_member_orgs 
45
                      MoveMemberToDeleted 
46
                      DelMember 
47
                      ExtendMemberSubscriptionTo 
48
                      GetTitles 
49
                      GetPatronImage 
50
                      PutPatronImage 
51
                      RmPatronImage 
52
                      GetBorrowersToExpunge
53
                      GetBorrowersWhoHaveNeverBorrowed 
54
                      GetBorrowersWithIssuesHistoryOlderThan 
55
                      GetBorrowersNamesAndLatestIssue 
56
                      IssueSlip
57
                );
58
    
59
    can_ok( $self->testing_class, @methods );    
60
}
61
62
1;
63
(-)a/t/db_dependent/lib/KohaTest/Members/AttributeTypes.pm (-119 lines)
Lines 1-119 Link Here
1
package KohaTest::Members::AttributeTypes;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members::AttributeTypes;
10
sub testing_class { 'C4::Members::AttributeTypes' };
11
12
sub methods : Test( 1 ) {
13
    my $self = shift;
14
    my @methods = qw( 
15
                    new
16
                    fetch
17
                    GetAttributeTypes
18
                    code
19
                    description
20
                    repeatable
21
                    unique_id
22
                    opac_display
23
                    password_allowed
24
                    staff_searchable
25
                    authorised_value_category
26
                    store
27
                    delete
28
                );
29
    
30
    can_ok( $self->testing_class, @methods );    
31
}
32
33
sub startup_50_create_types : Test( startup => 28 ) {
34
    my $self = shift;
35
36
    my $type1 = C4::Members::AttributeTypes->new('CAMPUSID', 'institution ID');
37
    isa_ok($type1,  'C4::Members::AttributeTypes');
38
    is($type1->code(), 'CAMPUSID', "set code in constructor");
39
    is($type1->description(), 'institution ID', "set description in constructor");
40
    ok(!$type1->repeatable(), "repeatable defaults to false");
41
    ok(!$type1->unique_id(), "unique_id defaults to false");
42
    ok(!$type1->opac_display(), "opac_display defaults to false");
43
    ok(!$type1->password_allowed(), "password_allowed defaults to false");
44
    ok(!$type1->staff_searchable(), "staff_searchable defaults to false");
45
    is($type1->authorised_value_category(), '', "authorised_value_category defaults to ''");
46
47
    $type1->repeatable('foobar');
48
    ok($type1->repeatable(), "repeatable now true");
49
    cmp_ok($type1->repeatable(), '==', 1, "repeatable not set to 'foobar'");
50
    $type1->repeatable(0);
51
    ok(!$type1->repeatable(), "repeatable now false");
52
    
53
    $type1->unique_id('foobar');
54
    ok($type1->unique_id(), "unique_id now true");
55
    cmp_ok($type1->unique_id(), '==', 1, "unique_id not set to 'foobar'");
56
    $type1->unique_id(0);
57
    ok(!$type1->unique_id(), "unique_id now false");
58
    
59
    $type1->opac_display('foobar');
60
    ok($type1->opac_display(), "opac_display now true");
61
    cmp_ok($type1->opac_display(), '==', 1, "opac_display not set to 'foobar'");
62
    $type1->opac_display(0);
63
    ok(!$type1->opac_display(), "opac_display now false");
64
    
65
    $type1->password_allowed('foobar');
66
    ok($type1->password_allowed(), "password_allowed now true");
67
    cmp_ok($type1->password_allowed(), '==', 1, "password_allowed not set to 'foobar'");
68
    $type1->password_allowed(0);
69
    ok(!$type1->password_allowed(), "password_allowed now false");
70
    
71
    $type1->staff_searchable('foobar');
72
    ok($type1->staff_searchable(), "staff_searchable now true");
73
    cmp_ok($type1->staff_searchable(), '==', 1, "staff_searchable not set to 'foobar'");
74
    $type1->staff_searchable(0);
75
    ok(!$type1->staff_searchable(), "staff_searchable now false");
76
77
    $type1->code('INSTID');
78
    is($type1->code(), 'CAMPUSID', 'code() allows retrieving but not setting');    
79
    $type1->description('student ID');
80
    is($type1->description(), 'student ID', 'set description');    
81
    $type1->authorised_value_category('CAT');
82
    is($type1->authorised_value_category(), 'CAT', 'set authorised_value_category');    
83
    
84
    $type1->repeatable(1);
85
    $type1->staff_searchable(1);
86
    $type1->store();
87
    is($type1->num_patrons(), 0, 'no patrons using the new attribute type yet');
88
89
    my $type2 = C4::Members::AttributeTypes->new('ABC', 'ABC ID');
90
    $type2->store();
91
}
92
93
sub shutdown_50_list_and_remove_types : Test( shutdown => 11 ) {
94
    my $self = shift;
95
96
    my @list = C4::Members::AttributeTypes::GetAttributeTypes();    
97
    is_deeply(\@list, [ { code => 'ABC', description => 'ABC ID' },
98
                        { code => 'CAMPUSID', description => 'student ID' } ], "retrieved list of types");
99
100
    my $type1 = C4::Members::AttributeTypes->fetch($list[1]->{code}); 
101
    isa_ok($type1, 'C4::Members::AttributeTypes');
102
    is($type1->code(), 'CAMPUSID', 'fetched code');    
103
    is($type1->description(), 'student ID', 'fetched description');    
104
    is($type1->authorised_value_category(), 'CAT', 'fetched authorised_value_category');    
105
    ok($type1->repeatable(), "fetched repeatable");
106
    ok(!$type1->unique_id(), "fetched unique_id");
107
    ok(!$type1->opac_display(), "fetched opac_display");
108
    ok(!$type1->password_allowed(), "fetched password_allowed");
109
    ok($type1->staff_searchable(), "fetched staff_searchable");
110
111
    $type1->delete();
112
    C4::Members::AttributeTypes->delete('ABC');
113
114
    my @newlist = C4::Members::AttributeTypes::GetAttributeTypes();    
115
    is(scalar(@newlist), 0, "no types left after deletion");   
116
    
117
}
118
119
1;
(-)a/t/db_dependent/lib/KohaTest/Members/DebarMember.pm (-44 lines)
Lines 1-44 Link Here
1
package KohaTest::Members::DebarMember;
2
use base qw( KohaTest::Members );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
sub testing_class { 'C4::Members' };
11
12
13
sub simple_usage : Test( 6 ) {
14
    my $self = shift;
15
16
    ok( $self->{'memberid'}, 'we have a valid memberid to test with' );
17
18
    my $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
19
    ok(     exists $details->{'flags'},                  'member details has a "flags" attribute');
20
    isa_ok( $details->{'flags'},                 'HASH', 'the "flags" attribute is a hashref');
21
    ok(     ! $details->{'flags'}->{'DBARRED'},          'this member is NOT debarred' );
22
23
    # Now, let's debar this member and see what happens
24
    my $success = C4::Members::DebarMember( $self->{'memberid'}, '2099-12-31' );
25
26
    ok( $success, 'we were able to debar the member' );
27
    
28
    $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
29
    ok( $details->{'flags'}->{'DBARRED'},         'this member is debarred now' )
30
      or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) );
31
}
32
33
sub incorrect_usage : Test( 2 ) {
34
    my $self = shift;
35
36
    my $result = C4::Members::DebarMember();
37
    ok( ! defined $result, 'DebarMember returns undef when passed no parameters' );
38
39
    $result = C4::Members::DebarMember( 'this is not a borrowernumber' );
40
    ok( ! defined $result, 'DebarMember returns undef when not passed a numeric argument' );
41
42
}
43
44
1;
(-)a/t/db_dependent/lib/KohaTest/Members/GetMember.pm (-197 lines)
Lines 1-197 Link Here
1
package KohaTest::Members::GetMember;
2
use base qw( KohaTest::Members );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
11
sub testing_class { 'C4::Members' }
12
13
=head2 STARTUP METHODS
14
15
These get run once, before the main test methods in this module
16
17
=head3 startup_create_borrower
18
19
Creates a new borrower to use for these tests.  Class variables that are
20
used to search by are stored for easy access by the methods.
21
22
=cut
23
24
sub startup_create_borrower : Test( startup => 1 ) {
25
    my $self = shift;
26
27
    my $memberinfo = {
28
        surname      => 'surname'   . $self->random_string(),
29
        firstname    => 'firstname' . $self->random_string(),
30
        address      => 'address'   . $self->random_string(),
31
        city         => 'city'      . $self->random_string(),
32
        cardnumber   => 'card'      . $self->random_string(),
33
        branchcode   => 'U1BCG',
34
        categorycode => 'D',    # B  => Board
35
        dateexpiry   => '2020-01-01',
36
        password     => 'testpassword',
37
        userid       => 'testuser',
38
        dateofbirth  => $self->random_date(),
39
    };
40
41
    my $borrowernumber = AddMember( %$memberinfo );
42
    ok( $borrowernumber, "created member: $borrowernumber" );
43
    $self->{get_new_borrowernumber} = $borrowernumber;
44
    $self->{get_new_cardnumber}     = $memberinfo->{cardnumber};
45
    $self->{get_new_firstname}      = $memberinfo->{firstname};
46
    $self->{get_new_userid}         = $memberinfo->{userid};
47
48
    return;
49
}
50
51
=head2 TESTING METHODS
52
53
Standard test methods
54
55
=head3 borrowernumber_get
56
57
Validates that GetMember can search by borrowernumber
58
59
=cut
60
61
sub borrowernumber_get : Test( 6 ) {
62
    my $self = shift;
63
64
    ok( $self->{get_new_borrowernumber},
65
        "we have a valid memberid $self->{get_new_borrowernumber} to test with" );
66
67
    #search by borrowernumber
68
    my $results =
69
      C4::Members::GetMember( borrowernumber=>$self->{get_new_borrowernumber});
70
    ok( $results, 'we successfully called GetMember searching by borrowernumber' );
71
72
    ok( exists $results->{borrowernumber},
73
        'member details has a "borrowernumber" attribute' );
74
    is( $results->{borrowernumber},
75
        $self->{get_new_borrowernumber},
76
        '...and it matches the created borrowernumber'
77
    );
78
79
    ok( exists $results->{'category_type'}, "categories in the join returned values" );
80
    ok( $results->{description}, "...and description is valid: $results->{description}" );
81
}
82
83
=head3 cardnumber_get
84
85
Validates that GetMember can search by cardnumber
86
87
=cut
88
89
sub cardnumber_get : Test( 6 ) {
90
    my $self = shift;
91
92
    ok( $self->{get_new_cardnumber},
93
        "we have a valid cardnumber $self->{get_new_cardnumber} to test with" );
94
95
    #search by cardnumber
96
    my $results = C4::Members::GetMember( 'cardnumber'=>$self->{get_new_cardnumber} );
97
    ok( $results, 'we successfully called GetMember searching by cardnumber' );
98
99
    ok( exists $results->{cardnumber}, 'member details has a "cardnumber" attribute' );
100
    is( $results->{cardnumber},
101
        $self->{get_new_cardnumber},
102
        '..and it matches the created cardnumber'
103
    );
104
105
    ok( exists $results->{'category_type'}, "categories in the join returned values" );
106
    ok( $results->{description}, "...and description is valid: $results->{description}" );
107
}
108
109
=head3 firstname_get
110
111
Validates that GetMember can search by firstname.
112
Note that only the first result is used.
113
114
=cut
115
116
sub firstname_get : Test( 6 ) {
117
    my $self = shift;
118
119
    ok( $self->{get_new_firstname},
120
        "we have a valid firstname $self->{get_new_firstname} to test with" );
121
122
    ##search by firstname
123
    my $results = C4::Members::GetMember( 'firstname'=>$self->{get_new_firstname} );
124
    ok( $results, 'we successfully called GetMember searching by firstname' );
125
126
    ok( exists $results->{firstname}, 'member details has a "firstname" attribute' );
127
    is( $results->{'firstname'},
128
        $self->{get_new_firstname},
129
        '..and it matches the created firstname'
130
    );
131
132
    ok( exists $results->{'category_type'}, "categories in the join returned values" );
133
    ok( $results->{description}, "...and description is valid: $results->{description}" );
134
}
135
136
=head3 userid_get
137
138
Validates that GetMember can search by userid.
139
140
=cut
141
142
sub userid_get : Test( 6 ) {
143
    my $self = shift;
144
145
    ok( $self->{get_new_userid},
146
        "we have a valid userid $self->{get_new_userid} to test with" );
147
148
    #search by userid
149
    my $results = C4::Members::GetMember( 'userid'=>$self->{get_new_userid} );
150
    ok( $results, 'we successfully called GetMember searching by userid' );
151
152
    ok( exists $results->{'userid'}, 'member details has a "userid" attribute' );
153
    is( $results->{userid},
154
        $self->{get_new_userid},
155
        '..and it matches the created userid'
156
    );
157
158
    ok( exists $results->{'category_type'}, "categories in the join returned values" );
159
    ok( $results->{description}, "...and description is valid: $results->{description}" );
160
}
161
162
=head3 missing_params
163
164
Validates that GetMember returns undef when no parameters are passed to it
165
166
=cut
167
168
sub missing_params : Test( 1 ) {
169
    my $self = shift;
170
171
    my $results = C4::Members::GetMember();
172
173
    ok( !defined $results, 'returned undef when no parameters passed' );
174
175
}
176
177
=head2 SHUTDOWN METHODS
178
179
These get run once, after the main test methods in this module
180
181
=head3 shutdown_remove_borrower
182
183
Remove the new borrower information that was created in the startup method
184
185
=cut
186
187
sub shutdown_remove_borrower : Test( shutdown => 0 ) {
188
    my $self = shift;
189
190
    delete $self->{get_new_borrowernumber};
191
    delete $self->{get_new_cardnumber};
192
    delete $self->{get_new_firstname};
193
    delete $self->{get_new_userid};
194
195
}
196
197
1;
(-)a/t/db_dependent/lib/KohaTest/Members/GetMemberDetails.pm (-150 lines)
Lines 1-150 Link Here
1
package KohaTest::Members::GetMemberDetails;
2
use base qw( KohaTest::Members );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
11
sub testing_class { 'C4::Members' }
12
13
=head3 STARTUP METHODS
14
15
These are run once, before the main test methods in this module.
16
17
=head2 startup_create_detailed_borrower
18
19
Creates a new borrower to be used by the testing methods.  Also
20
populates the class hash with values to be compared from the database
21
retrieval.
22
23
=cut
24
25
sub startup_create_detailed_borrower : Test( startup => 2 ) {
26
    my $self = shift;
27
    my ( $description, $type, $amount, $user );
28
29
    my $memberinfo = {
30
        surname      => 'surname' . $self->random_string(),
31
        firstname    => 'firstname' . $self->random_string(),
32
        address      => 'address' . $self->random_string(),
33
        city         => 'city' . $self->random_string(),
34
        cardnumber   => 'card' . $self->random_string(),
35
        branchcode   => 'CPL',
36
        categorycode => 'B',
37
        dateexpiry   => '2020-01-01',
38
        password     => 'testpassword',
39
        userid       => 'testuser',
40
        flags        => '0',
41
        dateofbirth  => $self->random_date(),
42
    };
43
44
    my $borrowernumber = AddMember( %$memberinfo );
45
    ok( $borrowernumber, "created member: $borrowernumber" );
46
    $self->{detail_borrowernumber} = $borrowernumber;
47
    $self->{detail_cardnumber}     = $memberinfo->{cardnumber};
48
49
    #values for adding a record to accounts
50
    $description = 'Test account';
51
    $type        = 'M';
52
    $amount      = 5.00;
53
    $user        = '';
54
55
    my $acct_added =
56
      C4::Accounts::manualinvoice( $borrowernumber, undef, $description, $type, $amount,
57
        $user );
58
59
    ok( $acct_added == 0, 'added account for borrower' );
60
61
    $self->{amountoutstanding} = $amount;
62
63
    return;
64
}
65
66
=head2 TESTING METHODS
67
68
=head3 borrower_detail_get
69
70
Tests the functionality of the GetMemberDetails method in C4::Members.
71
Validates the join on categories table works as well as the extra fields
72
the method gets from outside of either the borrowers and categories table like
73
amountoutstanding and user flags.
74
75
=cut
76
77
sub borrower_detail_get : Test( 8 ) {
78
    my $self = shift;
79
80
    ok( $self->{detail_borrowernumber},
81
        'we have a valid detailed borrower to test with' );
82
83
    my $details = C4::Members::GetMemberDetails( $self->{detail_borrowernumber} );
84
    ok( $details, 'we successfully called GetMemberDetails' );
85
    ok( exists $details->{categorycode},
86
        'member details has a "categorycode" attribute' );
87
    ok( $details->{categorycode}, '...and it is set to something' );
88
89
    ok( exists $details->{category_type}, "categories in the join returned values" );
90
91
    ok( $details->{category_type}, '...and category_type is valid' );
92
93
    ok( $details->{amountoutstanding}, 'an amountoutstanding exists' );
94
    is( $details->{amountoutstanding},
95
        $self->{amountoutstanding},
96
        '...and matches inserted account record'
97
    );
98
99
}
100
101
=head3 cardnumber_detail_get
102
103
This method tests the capability of GetMemberDetails to search on cardnumber.  There doesn't seem to be any
104
current calls to GetMemberDetail using cardnumber though, so this test may not be necessary.
105
106
=cut
107
108
sub cardnumber_detail_get : Test( 8 ) {
109
    my $self = shift;
110
111
    ok( $self->{detail_cardnumber},
112
        "we have a valid detailed borrower to test with $self->{detail_cardnumber}" );
113
114
    my $details = C4::Members::GetMemberDetails( undef, $self->{detail_cardnumber} );
115
    ok( $details, 'we successfully called GetMemberDetails' );
116
    ok( exists $details->{categorycode},
117
        "member details has a 'categorycode' attribute $details->{categorycode}" );
118
    ok( $details->{categorycode}, '...and it is set to something' );
119
120
    ok( exists $details->{category_type}, "categories in the join returned values" );
121
122
    ok( $details->{category_type}, '...and category_type is valid' );
123
124
#FIXME These 2 methods will fail as borrowernumber is not set in GetMemberDetails when cardnumber is used instead.
125
#ok( $details->{amountoutstanding}, 'an amountoutstanding exists' );
126
#is( $details->{amountoutstanding}, $self->{amountoutstanding}, '...and matches inserted account record' );
127
}
128
129
=head2 SHUTDOWN METHDOS
130
131
These get run once, after the main test methods in this module.
132
133
=head3 shutdown_remove_new_borrower
134
135
Removes references in the Class to the new borrower created
136
in the startup methods.
137
138
=cut
139
140
sub shutdown_remove_new_borrower : Test( shutdown => 0 ) {
141
    my $self = shift;
142
143
    delete $self->{detail_borrowernumber};
144
    delete $self->{detail_cardnumber};
145
    delete $self->{amountoutstanding};
146
147
    return;
148
}
149
150
1;
(-)a/t/db_dependent/lib/KohaTest/Members/ModMember.pm (-103 lines)
Lines 1-103 Link Here
1
package KohaTest::Members::ModMember;
2
use base qw( KohaTest::Members );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
sub testing_class { 'C4::Members' };
11
12
13
sub a_simple_usage : Test( 7 ) {
14
    my $self = shift;
15
16
    ok( $self->{'memberid'}, 'we have a valid memberid to test with' );
17
18
    my $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
19
    ok( exists $details->{'dateofbirth'}, 'member details has a "dateofbirth" attribute');
20
    ok( $details->{'dateofbirth'},        '...and it is set to something' );
21
22
    my $new_date_of_birth = $self->random_date();
23
    like( $new_date_of_birth, qr(^\d\d\d\d-\d\d-\d\d$), 'The new date of birth is a yyyy-mm-dd' );
24
25
    my $success = C4::Members::ModMember(
26
        borrowernumber => $self->{'memberid'},
27
        dateofbirth    => $new_date_of_birth
28
    );
29
30
    ok( $success, 'we successfully called ModMember' );
31
32
    $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
33
    ok( exists $details->{'dateofbirth'},              'member details still has a "dateofbirth" attribute');
34
    is( $details->{'dateofbirth'}, $new_date_of_birth, '...and it is set to the new_date_of_birth' );
35
36
}
37
38
sub incorrect_usage : Test( 1 ) {
39
    my $self = shift;
40
41
    local $TODO = 'ModMember does not fail gracefully yet';
42
    
43
    my $result = C4::Members::ModMember();
44
    ok( ! defined $result, 'ModMember returns false when passed no parameters' );
45
46
}
47
48
=head2 preserve_dates
49
50
In bug 2284, it was determined that a Member's dateofbirth could be
51
erased by a call to ModMember if no date_of_birth was passed in. Three
52
date fields (dateofbirth, dateexpiry ,and dateenrolled) are treated
53
differently than other fields by ModMember. This test method calls
54
ModMember with none of the date fields set to ensure that they are not
55
overwritten.
56
57
=cut
58
59
60
sub preserve_dates : Test( 18 ) {
61
    my $self = shift;
62
63
    ok( $self->{'memberid'}, 'we have a valid memberid to test with' );
64
65
    my %date_fields = (
66
        dateofbirth  => $self->random_date(),
67
        dateexpiry   => $self->random_date(),
68
        dateenrolled => $self->random_date(),
69
    );
70
71
    # stage our member with valid dates in all of the date fields
72
    my $success = C4::Members::ModMember(
73
        borrowernumber => $self->{'memberid'},
74
        %date_fields,
75
    );
76
    ok( $success, 'succefully set the date fields.' );
77
    
78
    # make sure that we successfully set the date fields. They're not undef.
79
    my $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
80
    foreach my $date_field ( keys %date_fields ) {
81
        ok( exists $details->{$date_field},                     qq(member details has a "$date_field" attribute) );
82
        ok( $details->{$date_field},                            '...and it is set to something true' );
83
        is( $details->{$date_field}, $date_fields{$date_field}, '...and it is set to what we set it' );
84
    }
85
86
    # call ModMember to update the firstname. Notice that we're not
87
    # updating any date fields.
88
    $success = C4::Members::ModMember(
89
        borrowernumber => $self->{'memberid'},
90
        firstname      => $self->random_string,
91
    );
92
    ok( $success, 'we successfully called ModMember' );
93
94
    # make sure that none of the date fields have been molested by our call to ModMember.
95
    $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
96
    foreach my $date_field ( keys %date_fields ) {
97
        ok( exists $details->{$date_field}, qq(member details still has a "$date_field" attribute) );
98
        is( $details->{$date_field}, $date_fields{$date_field}, '...and it is set to the expected value' );
99
    }
100
101
}
102
103
1;
(-)a/t/db_dependent/lib/KohaTest/Message.pm (-52 lines)
Lines 1-52 Link Here
1
package KohaTest::Message;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Message;
10
sub testing_class { 'C4::Message' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( 
16
                    new
17
                    find
18
                    find_last_message
19
                    enqueue
20
                    update
21
                    metadata
22
                    render_metadata
23
                    append
24
                );
25
    
26
    can_ok( $self->testing_class, @methods );    
27
}
28
29
sub test_metadata : Test( 1 ) {
30
    my $self = shift;
31
    my $message = C4::Message->new;
32
    $message->metadata({
33
        header => "Header",
34
        body   => [],
35
        footer => "Footer",
36
    });
37
    like($message->{metadata}, qr{^---}, "The metadata attribute should be serialized as YAML.");
38
}
39
40
sub test_append : Test( 1 ) {
41
    my $self = shift;
42
    my $message = C4::Message->new;
43
    $message->metadata({
44
        header => "Header",
45
        body   => [],
46
        footer => "Footer",
47
    });
48
    $message->append("foo");
49
    is($message->metadata->{body}->[0], "foo", "Appending a string should add an element to metadata.body.");
50
}
51
52
1;
(-)a/t/db_dependent/lib/KohaTest/NewsChannels.pm (-28 lines)
Lines 1-28 Link Here
1
package KohaTest::NewsChannels;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::NewsChannels;
10
sub testing_class { 'C4::NewsChannels' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw(
16
                      add_opac_new 
17
                      upd_opac_new 
18
                      del_opac_new 
19
                      get_opac_new 
20
                      get_opac_news 
21
                      GetNewsToDisplay 
22
                );
23
    
24
    can_ok( $self->testing_class, @methods );    
25
}
26
27
1;
28
(-)a/t/db_dependent/lib/KohaTest/Overdues.pm (-39 lines)
Lines 1-39 Link Here
1
package KohaTest::Overdues;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Overdues;
10
sub testing_class { 'C4::Overdues' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( Getoverdues 
16
                       checkoverdues 
17
                       CalcFine 
18
                       GetSpecialHolidays 
19
                       GetRepeatableHolidays
20
                       GetWdayFromItemnumber
21
                       GetIssuesIteminfo
22
                       UpdateFine 
23
                       BorType 
24
                       GetFine 
25
                       NumberNotifyId
26
                       AmountNotify
27
                       GetItems 
28
                       CheckBorrowerDebarred
29
                       CheckItemNotify 
30
                       GetOverduesForBranch 
31
                       AddNotifyLine 
32
                       RemoveNotifyLine 
33
                );
34
    
35
    can_ok( $self->testing_class, @methods );    
36
}
37
38
1;
39
(-)a/t/db_dependent/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm (-59 lines)
Lines 1-59 Link Here
1
package KohaTest::Overdues::GetBranchcodesWithOverdueRules;
2
use base qw( KohaTest::Overdues );
3
4
use strict;
5
use warnings;
6
7
use C4::Overdues;
8
use Test::More;
9
10
sub my_branch_has_no_rules : Tests( 2 ) {
11
    my $self = shift;
12
13
    ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" );
14
15
    my @branches = C4::Overdues::GetBranchcodesWithOverdueRules;
16
    my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches;
17
    is( scalar @found_branches, 0, '...and it is not in the list of branches')
18
    
19
}
20
21
sub my_branch_has_overdue_rules : Tests( 3 ) {
22
    my $self = shift;
23
24
    ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" );
25
26
    my $dbh = C4::Context->dbh();
27
    my $sql = <<'END_SQL';
28
INSERT INTO overduerules
29
(branchcode,    categorycode,
30
delay1,        letter1,       debarred1,
31
delay2,        letter2,       debarred2,
32
delay3,        letter3,       debarred3)
33
VALUES
34
( ?, ?,
35
?, ?, ?,
36
?, ?, ?,
37
?, ?, ?)
38
END_SQL
39
40
    my $sth = $dbh->prepare($sql);
41
    my $success = $sth->execute( $self->{'branchcode'}, $self->random_string(2),
42
                                 1, $self->random_string(), 0,
43
                                 5, $self->random_string(), 0,
44
                                 9, $self->random_string(), 1, );
45
    ok( $success, '...and we have successfully given it an overdue rule' );
46
47
    my @branches = C4::Overdues::GetBranchcodesWithOverdueRules;
48
    my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches;
49
    is( scalar @found_branches, 1, '...and it IS in the list of branches.')
50
    
51
}
52
53
1;
54
55
56
57
58
59
(-)a/t/db_dependent/lib/KohaTest/Overdues/GetOverdues.pm (-126 lines)
Lines 1-126 Link Here
1
package KohaTest::Overdues::GetOverdues;
2
use base qw( KohaTest::Overdues );
3
4
use strict;
5
use warnings;
6
7
use C4::Overdues;
8
use Test::More;
9
10
=head3 create_overdue_item
11
12
=cut
13
14
sub startup_60_create_overdue_item : Test( startup => 17 ) {
15
    my $self = shift;
16
    
17
    $self->add_biblios( add_items => 1 );
18
    
19
    my $biblionumber = $self->{'biblios'}[0];
20
    ok( $biblionumber, 'biblionumber' );
21
    my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $biblionumber );
22
    ok( scalar @biblioitems > 0, 'there is at least one biblioitem' );
23
    my $biblioitemnumber = $biblioitems[0]->{'biblioitemnumber'};
24
    ok( $biblioitemnumber, 'got a biblioitemnumber' );
25
26
    my $items = C4::Items::GetItemsByBiblioitemnumber( $biblioitemnumber);
27
                           
28
    my $item = $items->[0];
29
    ok( $item->{'itemnumber'}, 'item number' );
30
    $self->{'overdueitemnumber'} = $item->{'itemnumber'};
31
    
32
    # let's use the database to do date math for us.
33
    # This is a US date, but that's how C4::Dates likes it, apparently.
34
    my $dbh = C4::Context->dbh();
35
    my $date_list = $dbh->selectcol_arrayref( q( select DATE_FORMAT( FROM_DAYS( TO_DAYS( NOW() ) - 6 ), '%m/%d/%Y' ) ) );
36
    my $six_days_ago = shift( @$date_list );
37
    
38
    my $duedate = C4::Dates->new( $six_days_ago );
39
    # diag( Data::Dumper->Dump( [ $duedate ], [ 'duedate' ] ) );
40
    
41
    ok( $item->{'barcode'}, 'barcode' )
42
      or diag( Data::Dumper->Dump( [ $item ], [ 'item' ] ) );
43
    # my $item_from_barcode = C4::Items::GetItem( undef, $item->{'barcode'} );
44
    # diag( Data::Dumper->Dump( [ $item_from_barcode ], [ 'item_from_barcode' ] ) );
45
46
    ok( $self->{'memberid'}, 'memberid' );
47
    my $borrower = C4::Members::GetMember( borrowernumber=>$self->{'memberid'} );
48
    ok( $borrower->{'borrowernumber'}, 'borrowernumber' );
49
    
50
    my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $item->{'barcode'}, $duedate, 0 );
51
    # diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) );
52
    is( keys %$issuingimpossible, 0, 'issuing is not impossible' );
53
    is( keys %$needsconfirmation, 0, 'issuing needs no confirmation' );
54
55
    C4::Circulation::AddIssue( $borrower, $item->{'barcode'}, $duedate );
56
}
57
58
sub basic_usage : Test( 2 ) {
59
    my $self = shift;
60
61
    my $overdues = C4::Overdues::Getoverdues();
62
    isa_ok( $overdues, 'ARRAY' );
63
    is( scalar @$overdues, 1, 'found our one overdue book' );
64
}
65
66
sub limit_minimum_and_maximum : Test( 2 ) {
67
    my $self = shift;
68
69
    my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 100 } );
70
    isa_ok( $overdues, 'ARRAY' );
71
    is( scalar @$overdues, 1, 'found our one overdue book' );
72
}
73
74
sub limit_and_do_not_find_it : Test( 2 ) {
75
    my $self = shift;
76
77
    my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 2 } );
78
    isa_ok( $overdues, 'ARRAY' );
79
    is( scalar @$overdues, 0, 'there are no overdue books in that range.' );
80
}
81
82
=pod
83
84
sub run_overduenotices_script : Test( 1 ) {
85
    my $self = shift;
86
87
    # make sure member wants alerts
88
    C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'},
89
                                                     { code  => 'PREDEmail',
90
                                                       value => '1' } );
91
    
92
    # we're screwing with C4::Circulation::GetUpcomingIssues by passing in a negative number.
93
    C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'},
94
                                                     { code  => 'PREDDAYS',
95
                                                       value => '-6' } );
96
    
97
    
98
    my $before_count = $self->count_message_queue();
99
100
    my $output = qx( ../misc/cronjobs/advance_notices.pl -c );
101
    
102
    my $after_count = $self->count_message_queue();
103
    is( $after_count, $before_count + 1, 'there is one more message in the queue than there used to be.' )
104
      or diag $output;
105
    
106
}
107
108
109
=cut
110
111
sub count_message_queue {
112
    my $self = shift;
113
114
    my $dbh = C4::Context->dbh();
115
    my $statement = q( select count(0) from message_queue where status = 'pending' );
116
    my $countlist = $dbh->selectcol_arrayref( $statement );
117
    return $countlist->[0];
118
}
119
120
1;
121
122
123
124
125
126
(-)a/t/db_dependent/lib/KohaTest/Print.pm (-21 lines)
Lines 1-21 Link Here
1
package KohaTest::Print;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Print;
10
sub testing_class { 'C4::Print' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( NetworkPrint );
16
    
17
    can_ok( $self->testing_class, @methods );    
18
}
19
20
1;
21
(-)a/t/db_dependent/lib/KohaTest/Reserves.pm (-43 lines)
Lines 1-43 Link Here
1
package KohaTest::Reserves;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Reserves;
10
sub testing_class { 'C4::Reserves' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw(  AddReserve 
16
                       GetReservesFromBiblionumber 
17
                       GetReservesFromItemnumber 
18
                       GetReservesFromBorrowernumber 
19
                       GetReserveCount 
20
                       GetOtherReserves 
21
                       GetReserveFee 
22
                       GetReservesToBranch 
23
                       GetReservesForBranch 
24
                       CheckReserves 
25
                       CancelReserve 
26
                       ModReserve 
27
                       ModReserveFill 
28
                       ModReserveStatus 
29
                       ModReserveAffect 
30
                       ModReserveCancelAll 
31
                       ModReserveMinusPriority 
32
                       MoveReserve
33
                       GetReserveInfo 
34
                       _FixPriority 
35
                       _Findgroupreserve 
36
                       ReserveSlip
37
                );
38
    
39
    can_ok( $self->testing_class, @methods );    
40
}
41
42
1;
43
(-)a/t/db_dependent/lib/KohaTest/SMS.pm (-23 lines)
Lines 1-23 Link Here
1
package KohaTest::SMS;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::SMS;
10
sub testing_class { 'C4::SMS' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( send_sms
16
                      driver
17
                );
18
    
19
    can_ok( $self->testing_class, @methods );    
20
}
21
22
1;
23
(-)a/t/db_dependent/lib/KohaTest/SMS/send_sms.pm (-25 lines)
Lines 1-25 Link Here
1
package KohaTest::SMS::send_sms;
2
use base qw( KohaTest::SMS );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::SMS;
10
sub testing_class { 'C4::SMS' };
11
12
13
sub send_a_message : Test( 1 ) {
14
    my $self = shift;
15
16
    my $success = C4::SMS->send_sms( { destination => '+1 212-555-1111',
17
                                       message     => 'This is the message',
18
                                       driver      => 'Test' } );
19
20
    ok( $success, "send_sms returned a true: $success" );
21
    
22
}
23
24
25
1;
(-)a/t/db_dependent/lib/KohaTest/Scripts.pm (-18 lines)
Lines 1-18 Link Here
1
package KohaTest::Scripts;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Search;
10
sub testing_class { return; };
11
12
# Since this is an abstract base class, this prevents these tests from
13
# being run directly unless we're testing a subclass. It just makes
14
# things faster.
15
__PACKAGE__->SKIP_CLASS( 1 );
16
17
18
1;
(-)a/t/db_dependent/lib/KohaTest/Scripts/longoverdue.pm (-97 lines)
Lines 1-97 Link Here
1
package KohaTest::Scripts::longoverdue;
2
use base qw( KohaTest::Scripts );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
use Time::localtime;
9
10
11
=head2 STARTUP METHODS
12
13
These get run once, before the main test methods in this module
14
15
=head3 create_overdue_item
16
17
=cut
18
19
sub create_overdue_item : Test( startup => 12 ) {
20
    my $self = shift;
21
    
22
    $self->add_biblios( add_items => 1 );
23
    
24
    my $biblionumber = $self->{'biblios'}[0];
25
    ok( $biblionumber, 'biblionumber' );
26
    my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $biblionumber );
27
    ok( scalar @biblioitems > 0, 'there is at least one biblioitem' );
28
    my $biblioitemnumber = $biblioitems[0]->{'biblioitemnumber'};
29
    ok( $biblioitemnumber, 'got a biblioitemnumber' );
30
31
    my $items = C4::Items::GetItemsByBiblioitemnumber( $biblioitemnumber);
32
                           
33
    my $itemnumber = $items->[0]->{'itemnumber'};
34
    ok( $items->[0]->{'itemnumber'}, 'item number' );
35
36
    $self->{'overdueitemnumber'} = $itemnumber;
37
    
38
}
39
40
sub set_overdue_item_lost : Test( 13 ) {
41
    my $self = shift;
42
43
    my $item = C4::Items::GetItem( $self->{'overdueitemnumber'} );
44
    is( $item->{'itemnumber'}, $self->{'overdueitemnumber'}, 'itemnumber' );
45
46
    ok( exists $item->{'itemlost'}, 'itemlost exists' );
47
    ok( ! $item->{'itemlost'}, 'item is not lost' );
48
49
    # This is a US date, but that's how C4::Dates likes it, apparently.
50
    my $duedatestring = sprintf( '%02d/%02d/%04d',
51
                                 localtime->mon() + 1,
52
                                 localtime->mday(),
53
                                 localtime->year() + 1900 - 1, # it was due a year ago.
54
                            );
55
    my $duedate = C4::Dates->new( $duedatestring );
56
    # diag( Data::Dumper->Dump( [ $duedate ], [ 'duedate' ] ) );
57
    
58
    ok( $item->{'barcode'}, 'barcode' )
59
      or diag( Data::Dumper->Dump( [ $item ], [ 'item' ] ) );
60
    # my $item_from_barcode = C4::Items::GetItem( undef, $item->{'barcode'} );
61
    # diag( Data::Dumper->Dump( [ $item_from_barcode ], [ 'item_from_barcode' ] ) );
62
63
    my $borrower = C4::Members::GetMember( borrowernumber => $self->{'memberid'} );
64
    ok( $borrower->{'borrowernumber'}, 'borrowernumber' );
65
    
66
    my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $item->{'barcode'}, $duedate, 0 );
67
    # diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) );
68
    is( keys %$issuingimpossible, 0, 'issuing is not impossible' );
69
    is( keys %$needsconfirmation, 0, 'issuing needs no confirmation' );
70
71
    my $issue_due_date = C4::Circulation::AddIssue( $borrower, $item->{'barcode'}, $duedate );
72
    ok( $issue_due_date, 'due date' );
73
    is( $issue_due_date, $duedate, 'AddIssue returned the same date we passed to it' );
74
    
75
    # I have to make this in a different format since that's how the database holds it.
76
    my $duedateyyyymmdd = sprintf( '%04d-%02d-%02d',
77
                                   localtime->year() + 1900 - 1, # it was due a year ago.
78
                                   localtime->mon() + 1,
79
                                   localtime->mday(),
80
                              );
81
82
    my $issued_item = C4::Items::GetItem( $self->{'overdueitemnumber'} );
83
    is( $issued_item->{'onloan'}, $duedateyyyymmdd, "the item is checked out and due $duedatestring" );
84
    is( $issued_item->{'itemlost'}, 0, 'the item is not lost' );
85
    # diag( Data::Dumper->Dump( [ $issued_item ], [ 'issued_item' ] ) );
86
87
    qx( ../misc/cronjobs/longoverdue.pl --lost 90=2 --confirm );
88
89
    my $lost_item = C4::Items::GetItem( $self->{'overdueitemnumber'} );
90
    is( $lost_item->{'onloan'}, $duedateyyyymmdd, "the item is checked out and due $duedatestring" );
91
    is( $lost_item->{'itemlost'}, 2, 'the item is lost' );
92
    # diag( Data::Dumper->Dump( [ $lost_item ], [ 'lost_item' ] ) );
93
94
}
95
96
97
1;
(-)a/t/db_dependent/lib/KohaTest/Search.pm (-31 lines)
Lines 1-31 Link Here
1
package KohaTest::Search;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Search;
10
sub testing_class { 'C4::Search' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw(
16
                      FindDuplicate
17
                      SimpleSearch
18
                      getRecords
19
                      pazGetRecords
20
                      _remove_stopwords
21
                      _detect_truncation
22
                      _build_stemmed_operand
23
                      _build_weighted_query
24
                      buildQuery
25
                      searchResults
26
                );
27
    
28
    can_ok( $self->testing_class, @methods );    
29
}
30
31
1;
(-)a/t/db_dependent/lib/KohaTest/Search/SimpleSearch.pm (-140 lines)
Lines 1-140 Link Here
1
package KohaTest::Search::SimpleSearch;
2
use base qw( KohaTest::Search );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Search;
10
use C4::Biblio;
11
12
=head2 STARTUP METHODS
13
14
These get run once, before the main test methods in this module
15
16
=head3 insert_test_data
17
18
=cut
19
20
sub insert_test_data : Test( startup => 71 ) {
21
    my $self = shift;
22
    
23
    # get original 'Finn Test' count
24
    my $query = 'Finn Test';
25
    my ( $error, $results ) = SimpleSearch( $query );
26
    $self->{'orig_finn_test_hits'} = scalar(@$results);
27
28
    # I'm going to add a bunch of biblios so that I can search for them.
29
    $self->add_biblios( count     => 10,
30
                        add_items => 1 );
31
32
}
33
34
=head2 STARTUP METHODS
35
36
standard test methods
37
38
=head3 basic_test
39
40
basic usage.
41
42
=cut
43
44
sub basic_test : Test( 2 ) {
45
    my $self = shift;
46
47
    my $query = 'test';
48
49
    my ( $error, $results ) = SimpleSearch( $query );
50
    ok( ! defined $error, 'no error found during search' );
51
    like( $results->[0], qr/$query/i, 'the result seems to match the query' )
52
      or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
53
    
54
}
55
56
=head3 basic_test_with_server
57
58
Test the usage where we specify no limits, but we do specify a server.
59
60
=cut
61
62
sub basic_test_with_server : Test( 2 ) {
63
    my $self = shift;
64
65
    my $query = 'test';
66
67
    my ( $error, $results ) = SimpleSearch( $query, undef, undef, [ 'biblioserver' ] );
68
    ok( ! defined $error, 'no error found during search' );
69
    like( $results->[0], qr/$query/i, 'the result seems to match the query' )
70
      or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
71
    
72
}
73
74
75
=head3 basic_test_no_results
76
77
Make sure we get back an empty listref when there are no results.
78
79
=cut
80
81
sub basic_test_no_results : Test( 3 ) {
82
    my $self = shift;
83
84
    my $query = 'This string is almost guaranteed to not match anything.';
85
86
    my ( $error, $results ) = SimpleSearch( $query );
87
    ok( ! defined $error, 'no error found during search' );
88
    isa_ok( $results, 'ARRAY' );
89
    is( scalar( @$results ), 0, 'an empty list was returned.' )
90
      or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
91
}
92
93
=head3 limits
94
95
check that the SimpleTest method limits the number of results returned.
96
97
=cut
98
99
sub limits : Test( 8 ) {
100
    my $self = shift;
101
102
    my $query = 'Finn Test';
103
104
    {
105
        my ( $error, $results ) = SimpleSearch( $query );
106
        ok( ! defined $error, 'no error found during search' );
107
        my $expected_hits = 10 + $self->{'orig_finn_test_hits'};
108
        is( scalar @$results, $expected_hits, "found all $expected_hits results." )
109
          or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
110
    }
111
    
112
    my $offset = 4;
113
    {
114
        my ( $error, $results ) = SimpleSearch( $query, $offset );
115
        ok( ! defined $error, 'no error found during search' );
116
        my $expected_hits = 6 + $self->{'orig_finn_test_hits'};
117
        is( scalar @$results, $expected_hits, "found $expected_hits results." )
118
          or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
119
    }
120
121
    my $max_results = 2;
122
    {
123
        my ( $error, $results ) = SimpleSearch( $query, $offset, $max_results );
124
        ok( ! defined $error, 'no error found during search' );
125
        is( scalar @$results, $max_results, "found $max_results results." )
126
          or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
127
    }
128
    
129
    {
130
        my ( $error, $results ) = SimpleSearch( $query, 0, $max_results );
131
        ok( ! defined $error, 'no error found during search' );
132
        is( scalar @$results, $max_results, "found $max_results results." )
133
          or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
134
    }
135
    
136
       
137
}
138
139
140
1;
(-)a/t/db_dependent/lib/KohaTest/Serials.pm (-65 lines)
Lines 1-65 Link Here
1
package KohaTest::Serials;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Serials;
10
sub testing_class { 'C4::Serials' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( GetSuppliersWithLateIssues
16
                      GetLateIssues
17
                      GetSubscriptionHistoryFromSubscriptionId
18
                      GetSerialStatusFromSerialId
19
                      GetSerialInformation
20
                      AddItem2Serial
21
                      UpdateClaimdateIssues
22
                      GetSubscription
23
                      GetFullSubscription
24
                      PrepareSerialsData
25
                      GetSubscriptionsFromBiblionumber
26
                      GetFullSubscriptionsFromBiblionumber
27
                      GetSubscriptions
28
                      GetSerials
29
                      GetSerials2
30
                      GetLatestSerials
31
                      GetNextSeq
32
                      GetSeq
33
                      GetExpirationDate
34
                      CountSubscriptionFromBiblionumber
35
                      ModSubscriptionHistory
36
                      ModSerialStatus
37
                      ModSubscription
38
                      NewSubscription
39
                      ReNewSubscription
40
                      NewIssue
41
                      ItemizeSerials
42
                      HasSubscriptionExpired
43
                      DelSubscription
44
                      DelIssue
45
                      GetLateOrMissingIssues
46
                      removeMissingIssue
47
                      updateClaim
48
                      getsupplierbyserialid
49
                      check_routing
50
                      addroutingmember
51
                      reorder_members
52
                      delroutingmember
53
                      getroutinglist
54
                      countissuesfrom
55
                      abouttoexpire
56
                      in_array
57
                      GetNextDate
58
                      itemdata
59
                );
60
    
61
    can_ok( $self->testing_class, @methods );    
62
}
63
64
1;
65
(-)a/t/db_dependent/lib/KohaTest/Suggestions.pm (-31 lines)
Lines 1-30 Link Here
1
package KohaTest::Suggestions;
2
use base qw( KohaTest );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Suggestions;
10
sub testing_class { 'C4::Suggestions' };
11
12
13
sub methods : Test( 1 ) {
14
    my $self = shift;
15
    my @methods = qw( SearchSuggestion
16
                      GetSuggestion
17
                      GetSuggestionFromBiblionumber
18
                      GetSuggestionByStatus
19
                      CountSuggestion
20
                      NewSuggestion
21
                      ModStatus
22
                      ConnectSuggestionAndBiblio
23
                      DelSuggestion
24
                );
25
    
26
    can_ok( $self->testing_class, @methods );    
27
}
28
29
1;
30
31
- 

Return to bug 10539