t/lib/KohaTest.pm

   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::Bookfund;
  14 use C4::Bookseller;
  15 use C4::Context;
  16 use C4::Items;
  17 use C4::Members;
  18 use C4::Search;
  19 use File::Temp qw/ tempdir /;
  20
  21 # Since this is an abstract base class, this prevents these tests from
  22 # being run directly unless we're testing a subclass. It just makes
  23 # things faster.
  24 __PACKAGE__->SKIP_CLASS( 1 );
  25
  26
  27 =head2 startup methods
  28
  29 these are run once, at the beginning of the whole test suite
  30
  31 =cut
  32
  33 sub startup_15_truncate_tables : Test( startup => 1 ) {
  34     my $self = shift;
  35
  36 #     my @truncate_tables = qw( accountlines
  37 #                               accountoffsets
  38 #                               action_logs
  39 #                               alert
  40 #                               aqbasket
  41 #                               aqbookfund
  42 #                               aqbooksellers
  43 #                               aqbudget
  44 #                               aqorderbreakdown
  45 #                               aqorderdelivery
  46 #                               aqorders
  47 #                               auth_header
  48 #                               auth_subfield_structure
  49 #                               auth_tag_structure
  50 #                               auth_types
  51 #                               authorised_values
  52 #                               biblio
  53 #                               biblio_framework
  54 #                               biblioitems
  55 #                               borrowers
  56 #                               branchcategories
  57 #                               branches
  58 #                               branchrelations
  59 #                               branchtransfers
  60 #                               browser
  61 #                               categories
  62 #                               cities
  63 #                               class_sort_rules
  64 #                               class_sources
  65 #                               currency
  66 #                               deletedbiblio
  67 #                               deletedbiblioitems
  68 #                               deletedborrowers
  69 #                               deleteditems
  70 #                               ethnicity
  71 #                               import_batches
  72 #                               import_biblios
  73 #                               import_items
  74 #                               import_record_matches
  75 #                               import_records
  76 #                               issues
  77 #                               issuingrules
  78 #                               items
  79 #                               itemtypes
  80 #                               labels
  81 #                               labels_conf
  82 #                               labels_profile
  83 #                               labels_templates
  84 #                               language_descriptions
  85 #                               language_rfc4646_to_iso639
  86 #                               language_script_bidi
  87 #                               language_script_mapping
  88 #                               language_subtag_registry
  89 #                               letter
  90 #                               marc_matchers
  91 #                               marc_subfield_structure
  92 #                               marc_tag_structure
  93 #                               matchchecks
  94 #                               matcher_matchpoints
  95 #                               matchpoint_component_norms
  96 #                               matchpoint_components
  97 #                               matchpoints
  98 #                               notifys
  99 #                               nozebra
 100 #                               old_issues
 101 #                               old_reserves
 102 #                               opac_news
 103 #                               overduerules
 104 #                               patroncards
 105 #                               patronimage
 106 #                               printers
 107 #                               printers_profile
 108 #                               repeatable_holidays
 109 #                               reports_dictionary
 110 #                               reserveconstraints
 111 #                               reserves
 112 #                               reviews
 113 #                               roadtype
 114 #                               saved_reports
 115 #                               saved_sql
 116 #                               serial
 117 #                               serialitems
 118 #                               services_throttle
 119 #                               sessions
 120 #                               special_holidays
 121 #                               statistics
 122 #                               stopwords
 123 #                               subscription
 124 #                               subscriptionhistory
 125 #                               subscriptionroutinglist
 126 #                               suggestions
 127 #                               systempreferences
 128 #                               tags
 129 #                               userflags
 130 #                               virtualshelfcontents
 131 #                               virtualshelves
 132 #                               z3950servers
 133 #                               zebraqueue
 134 #                         );
 135
 136     my @truncate_tables = qw( accountlines
 137                               accountoffsets
 138                               alert
 139                               aqbasket
 140                               aqbooksellers
 141                               aqorderbreakdown
 142                               aqorderdelivery
 143                               aqorders
 144                               auth_header
 145                               branchcategories
 146                               branchrelations
 147                               branchtransfers
 148                               browser
 149                               cities
 150                               deletedbiblio
 151                               deletedbiblioitems
 152                               deletedborrowers
 153                               deleteditems
 154                               ethnicity
 155                               issues
 156                               issuingrules
 157                               labels
 158                               labels_profile
 159                               matchchecks
 160                               notifys
 161                               nozebra
 162                               old_issues
 163                               old_reserves
 164                               overduerules
 165                               patroncards
 166                               patronimage
 167                               printers
 168                               printers_profile
 169                               reports_dictionary
 170                               reserveconstraints
 171                               reserves
 172                               reviews
 173                               roadtype
 174                               saved_reports
 175                               saved_sql
 176                               serial
 177                               serialitems
 178                               services_throttle
 179                               special_holidays
 180                               statistics
 181                               subscription
 182                               subscriptionhistory
 183                               subscriptionroutinglist
 184                               suggestions
 185                               tags
 186                               virtualshelfcontents
 187                         );
 188
 189     my $failed_to_truncate = 0;
 190     foreach my $table ( @truncate_tables ) {
 191         my $dbh = C4::Context->dbh();
 192         $dbh->do( "truncate $table" )
 193           or $failed_to_truncate = 1;
 194     }
 195     is( $failed_to_truncate, 0, 'truncated tables' );
 196 }
 197
 198 =head2 startup_20_add_bookseller
 199
 200 we need a bookseller for many of the tests, so let's insert one. Feel
 201 free to use this one, or insert your own.
 202
 203 =cut
 204
 205 sub startup_20_add_bookseller : Test(startup => 1) {
 206     my $self = shift;
 207
 208     my $booksellerinfo = { name => 'bookseller ' . $self->random_string(),
 209                       };
 210
 211     my $id = AddBookseller( $booksellerinfo );
 212     ok( $id, "created bookseller: $id" );
 213     $self->{'booksellerid'} = $id;
 214
 215     return;
 216 }
 217
 218 =head2 startup_22_add_bookfund
 219
 220 we need a bookfund for many of the tests. This currently uses one that
 221 is in the skeleton database.  free to use this one, or insert your
 222 own.
 223
 224 =cut
 225
 226 sub startup_22_add_bookfund : Test(startup => 2) {
 227     my $self = shift;
 228
 229     my $bookfundid = 'GEN';
 230     my $bookfund = GetBookFund( $bookfundid, undef );
 231     # diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund  ) ) );
 232     is( $bookfund->{'bookfundid'},   $bookfundid,      "found bookfund: '$bookfundid'" );
 233     is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" );
 234
 235     $self->{'bookfundid'} = $bookfundid;
 236     return;
 237 }
 238
 239 =head2 startup_24_add_member
 240
 241 Add a patron/member for the tests to use
 242
 243 =cut
 244
 245 sub startup_24_add_member : Test(startup => 1) {
 246     my $self = shift;
 247
 248     my $memberinfo = { surname      => 'surname '  . $self->random_string(),
 249                        firstname    => 'firstname' . $self->random_string(),
 250                        address      => 'address'   . $self->random_string(),
 251                        city         => 'city'      . $self->random_string(),
 252                        cardnumber   => 'card'      . $self->random_string(),
 253                        branchcode   => 'CPL', # CPL => Centerville
 254                        categorycode => 'PT',  # PT  => PaTron
 255                        dateexpiry   => '2010-01-01',
 256                        password     => 'testpassword',
 257                   };
 258
 259     my $borrowernumber = AddMember( %$memberinfo );
 260     ok( $borrowernumber, "created member: $borrowernumber" );
 261     $self->{'memberid'} = $borrowernumber;
 262
 263     return;
 264 }
 265
 266 =head2 startup_30_login
 267
 268 =cut
 269
 270 sub startup_30_login : Test( startup => 2 ) {
 271     my $self = shift;
 272
 273     $self->{'sessionid'} = '12345678'; # does this value matter?
 274     my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} );
 275     ok( $borrower_details->{'cardnumber'}, 'cardnumber' );
 276
 277     # make a cookie and force it into $cgi.
 278     # This would be a lot easier with Test::MockObject::Extends.
 279     my $cgi = CGI->new( { userid   => $borrower_details->{'cardnumber'},
 280                           password => 'testpassword' } );
 281     my $setcookie = $cgi->cookie( -name  => 'CGISESSID',
 282                                   -value => $self->{'sessionid'} );
 283     $cgi->{'.cookies'} = { CGISESSID => $setcookie };
 284     is( $cgi->cookie('CGISESSID'), $self->{'sessionid'}, 'the CGISESSID cookie is set' );
 285     # diag( Data::Dumper->Dump( [ $cgi->cookie('CGISESSID') ], [ qw( cookie ) ] ) );
 286
 287     # C4::Auth::checkauth sometimes emits a warning about unable to append to sessionlog. That's OK.
 288     my ( $userid, $cookie, $sessionID ) = C4::Auth::checkauth( $cgi, 'noauth', {}, 'intranet' );
 289     # diag( Data::Dumper->Dump( [ $userid, $cookie, $sessionID ], [ qw( userid cookie sessionID ) ] ) );
 290
 291     # my $session = C4::Auth::get_session( $sessionID );
 292     # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) );
 293
 294
 295 }
 296
 297 =head2 setup methods
 298
 299 setup methods are run before every test method
 300
 301 =cut
 302
 303 =head2 teardown methods
 304
 305 teardown methods are many time, once at the end of each test method.
 306
 307 =cut
 308
 309 =head2 shutdown methods
 310
 311 shutdown methods are run once, at the end of the test suite
 312
 313 =cut
 314
 315 =head2 utility methods
 316
 317 These are not test methods, but they're handy
 318
 319 =cut
 320
 321 =head3 random_string
 322
 323 Nice for generating names and such. It's not actually random, more
 324 like arbitrary.
 325
 326 =cut
 327
 328 sub random_string {
 329     my $self = shift;
 330
 331     my $wordsize = 6;  # how many letters in your string?
 332
 333     # leave out these characters: "oOlL10". They're too confusing.
 334     my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 );
 335
 336     my $randomstring;
 337     foreach ( 0..$wordsize ) {
 338         $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ];
 339     }
 340     return $randomstring;
 341
 342 }
 343
 344 =head3 add_biblios
 345
 346   $self->add_biblios( count     => 10,
 347                       add_items => 1, );
 348
 349   named parameters:
 350      count: number of biblios to add
 351      add_items: should you add items for each one?
 352
 353   returns:
 354     I don't know yet.
 355
 356   side effects:
 357     adds the biblionumbers to the $self->{'biblios'} listref
 358
 359   Notes:
 360     Should I allow you to pass in biblio information, like title?
 361     Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace.
 362     This runs 10 tests, plus 4 for each "count", plus 3 more for each item added.
 363
 364 =cut
 365
 366 sub add_biblios {
 367     my $self = shift;
 368     my %param = @_;
 369
 370     $param{'count'}     = 1 unless defined( $param{'count'} );
 371     $param{'add_items'} = 0 unless defined( $param{'add_items'} );
 372
 373     foreach my $counter ( 1..$param{'count'} ) {
 374         my $marcrecord  = MARC::Record->new();
 375         isa_ok( $marcrecord, 'MARC::Record' );
 376         my $appendedfieldscount = $marcrecord->append_fields( MARC::Field->new( '100', '1', '0',
 377                                                                                 a => 'Twain, Mark',
 378                                                                                 d => "1835-1910." ),
 379                                                               MARC::Field->new( '245', '1', '4',
 380                                                                                 a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ),
 381                                                                                 c => "Mark Twain ; illustrated by E.W. Kemble." ),
 382                                                               MARC::Field->new( '952', '0', '0',
 383                                                                                 p => '12345678' . $self->random_string() ),   # barcode
 384                                                               MARC::Field->new( '952', '0', '0',
 385                                                                                 a => 'CPL',
 386                                                                                 b => 'CPL' ),
 387                                                          );
 388
 389         diag $MARC::Record::ERROR if ( $MARC::Record::ERROR );
 390         is( $appendedfieldscount, 4, 'added 4 fields' );
 391
 392         my $frameworkcode = ''; # XXX I'd like to put something reasonable here.
 393         my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode );
 394         ok( $biblionumber, "the biblionumber is $biblionumber" );
 395         ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" );
 396         if ( $param{'add_items'} ) {
 397             # my @iteminfo = AddItem( {}, $biblionumber );
 398             my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber );
 399             is( $iteminfo[0], $biblionumber,     "biblionumber is $biblionumber" );
 400             is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" );
 401             ok( $iteminfo[2], "itemnumber is $iteminfo[2]" );
 402         }
 403         push @{$self->{'biblios'}}, $biblionumber;
 404     }
 405
 406     my $query = 'Finn Test';
 407
 408     # XXX we're going to repeatedly try to fetch the marc records that
 409     # we inserted above. It may take a while before they all show
 410     # up. why?
 411     my $tries = 30;
 412     DELAY: foreach my $trial ( 1..$tries ) {
 413         diag "waiting for zebra indexing. Trial: $trial of $tries";
 414         my ( $error, $results ) = SimpleSearch( $query );
 415         if ( $param{'count'} <= scalar( @$results ) ) {
 416             ok( $tries, "found all $param{'count'} titles after $trial tries" );
 417             last DELAY;
 418         }
 419         sleep( 3 );
 420     } continue {
 421         if ( $trial == $tries ) {
 422             fail( "we never found all $param{'count'} titles even after $tries tries." );
 423         }
 424     }
 425
 426
 427 }
 428
 429 =head3 reindex_marc
 430
 431 Do a fast reindexing of all of the bib and authority
 432 records and mark all zebraqueue entries done.
 433
 434 Useful for test routines that need to do a
 435 lot of indexing without having to wait for
 436 zebraqueue.
 437
 438 In NoZebra model, this only marks zebraqueue
 439 done - the records should already be indexed.
 440
 441 =cut
 442
 443 sub reindex_marc {
 444     my $self = shift;
 445
 446     # mark zebraqueue done regardless of the indexing mode
 447     my $dbh = C4::Context->dbh();
 448     $dbh->do("UPDATE zebraqueue SET done = 1 WHERE done = 0");
 449
 450     return if C4::Context->preference('NoZebra');
 451
 452     my $directory = tempdir(CLEANUP => 1);
 453     foreach my $record_type qw(biblio authority) {
 454         mkdir "$directory/$record_type";
 455         my $sth = $dbh->prepare($record_type eq "biblio" ? "SELECT marc FROM biblioitems" : "SELECT marc FROM auth_header");
 456         $sth->execute();
 457         open OUT, ">:utf8", "$directory/$record_type/records";
 458         while (my ($blob) = $sth->fetchrow_array) {
 459             print OUT $blob;
 460         }
 461         close OUT;
 462         my $zebra_server = "${record_type}server";
 463         my $zebra_config  = C4::Context->zebraconfig($zebra_server)->{'config'};
 464         my $zebra_db_dir  = C4::Context->zebraconfig($zebra_server)->{'directory'};
 465         my $zebra_db = $record_type eq 'biblio' ? 'biblios' : 'authorities';
 466         system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 init > /dev/null 2>\&1";
 467         system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 update $directory/${record_type} > /dev/null 2>\&1";
 468         system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 commit > /dev/null 2>\&1";
 469     }
 470
 471 }
 472
 473 1;