From: Chris Cormack Date: Tue, 18 Jan 2011 03:18:37 +0000 (+1300) Subject: Bug 5327 shifting database dependent modules and scripts to t/db_dependent X-Git-Tag: html_template_pro~475^2~1 X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=commitdiff_plain;h=eff21765f9784e09905042dd7080cbef099306d9;p=koha-ffzg.git Bug 5327 shifting database dependent modules and scripts to t/db_dependent --- diff --git a/t/database_dependent.pl b/t/database_dependent.pl deleted file mode 100644 index 1b52be7933..0000000000 --- a/t/database_dependent.pl +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/perl - -use warnings; -use strict; - -=head2 - - - -=cut - -use C4::Context; -use Data::Dumper; -use Test::More; - -use Test::Class::Load qw ( . ); # run from the t directory - -KohaTest::clear_test_database(); -KohaTest::create_test_database(); - -KohaTest::start_zebrasrv(); -KohaTest::start_zebraqueue_daemon(); - -if ($ENV{'TEST_CLASS'}) { - # assume only one test class is specified; - # should extend to allow multiples, but that will - # mean changing how test classes are loaded. - eval "KohaTest::$ENV{'TEST_CLASS'}->runtests"; -} else { - Test::Class->runtests; -} - -KohaTest::stop_zebraqueue_daemon(); -KohaTest::stop_zebrasrv(); - diff --git a/t/db_dependent/database_dependent.pl b/t/db_dependent/database_dependent.pl new file mode 100644 index 0000000000..de05224bba --- /dev/null +++ b/t/db_dependent/database_dependent.pl @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +=head2 + + + +=cut + +use C4::Context; +use Data::Dumper; +use Test::More; + +use Test::Class::Load qw ( . ); # run from the t/db_dependent directory + +KohaTest::clear_test_database(); +KohaTest::create_test_database(); + +KohaTest::start_zebrasrv(); +KohaTest::start_zebraqueue_daemon(); + +if ($ENV{'TEST_CLASS'}) { + # assume only one test class is specified; + # should extend to allow multiples, but that will + # mean changing how test classes are loaded. + eval "KohaTest::$ENV{'TEST_CLASS'}->runtests"; +} else { + Test::Class->runtests; +} + +KohaTest::stop_zebraqueue_daemon(); +KohaTest::stop_zebrasrv(); + diff --git a/t/db_dependent/lib/KohaTest.pm b/t/db_dependent/lib/KohaTest.pm new file mode 100644 index 0000000000..323b55a67b --- /dev/null +++ b/t/db_dependent/lib/KohaTest.pm @@ -0,0 +1,844 @@ +package KohaTest; +use base qw(Test::Class); + +use Test::More; +use Data::Dumper; + +eval "use Test::Class"; +plan skip_all => "Test::Class required for performing database tests" if $@; +# Or, maybe I should just die there. + +use C4::Auth; +use C4::Biblio; +use C4::Bookseller; +use C4::Context; +use C4::Items; +use C4::Members; +use C4::Search; +use C4::Installer; +use C4::Languages; +use File::Temp qw/ tempdir /; +use CGI; +use Time::localtime; + +# Since this is an abstract base class, this prevents these tests from +# being run directly unless we're testing a subclass. It just makes +# things faster. +__PACKAGE__->SKIP_CLASS( 1 ); + +INIT { + if ($ENV{SINGLE_TEST}) { + # if we're running the tests in one + # or more test files specified via + # + # make test-single TEST_FILES=lib/KohaTest/Foo.pm + # + # use this INIT trick taken from the POD for + # Test::Class::Load. + start_zebrasrv(); + Test::Class->runtests; + stop_zebrasrv(); + } +} + +use Attribute::Handlers; + +=head2 Expensive test method attribute + +If a test method is decorated with an Expensive +attribute, it is skipped unless the RUN_EXPENSIVE_TESTS +environment variable is defined. + +To declare an entire test class and its subclasses expensive, +define a SKIP_CLASS with the Expensive attribute: + + sub SKIP_CLASS : Expensive { } + +=cut + +sub Expensive : ATTR(CODE) { + my ($package, $symbol, $sub, $attr, $data, $phase) = @_; + my $name = *{$symbol}{NAME}; + if ($name eq 'SKIP_CLASS') { + if ($ENV{'RUN_EXPENSIVE_TESTS'}) { + *{$symbol} = sub { 0; } + } else { + *{$symbol} = sub { "Skipping expensive test classes $package (and subclasses)"; } + } + } else { + unless ($ENV{'RUN_EXPENSIVE_TESTS'}) { + # a test method that runs no tests and just returns a scalar is viewed by Test::Class as a skip + *{$symbol} = sub { "Skipping expensive test $package\:\:$name"; } + } + } +} + +=head2 startup methods + +these are run once, at the beginning of the whole test suite + +=cut + +sub startup_15_truncate_tables : Test( startup => 1 ) { + my $self = shift; + +# my @truncate_tables = qw( accountlines +# accountoffsets +# action_logs +# alert +# aqbasket +# aqbookfund +# aqbooksellers +# aqbudget +# aqorderdelivery +# aqorders +# auth_header +# auth_subfield_structure +# auth_tag_structure +# auth_types +# authorised_values +# biblio +# biblio_framework +# biblioitems +# borrowers +# branchcategories +# branches +# branchrelations +# branchtransfers +# browser +# categories +# cities +# class_sort_rules +# class_sources +# currency +# deletedbiblio +# deletedbiblioitems +# deletedborrowers +# deleteditems +# ethnicity +# import_batches +# import_biblios +# import_items +# import_record_matches +# import_records +# issues +# issuingrules +# items +# itemtypes +# labels +# labels_conf +# labels_profile +# labels_templates +# language_descriptions +# language_rfc4646_to_iso639 +# language_script_bidi +# language_script_mapping +# language_subtag_registry +# letter +# marc_matchers +# marc_subfield_structure +# marc_tag_structure +# matchchecks +# matcher_matchpoints +# matchpoint_component_norms +# matchpoint_components +# matchpoints +# notifys +# nozebra +# old_issues +# old_reserves +# opac_news +# overduerules +# patroncards +# patronimage +# printers +# printers_profile +# repeatable_holidays +# reports_dictionary +# reserveconstraints +# reserves +# reviews +# roadtype +# saved_reports +# saved_sql +# serial +# serialitems +# services_throttle +# sessions +# special_holidays +# statistics +# stopwords +# subscription +# subscriptionhistory +# subscriptionroutinglist +# suggestions +# systempreferences +# tags +# userflags +# virtualshelfcontents +# virtualshelves +# z3950servers +# zebraqueue +# ); + + my @truncate_tables = qw( accountlines + accountoffsets + alert + aqbasket + aqbooksellers + aqorderdelivery + aqorders + auth_header + branchcategories + branchrelations + branchtransfers + browser + cities + deletedbiblio + deletedbiblioitems + deletedborrowers + deleteditems + ethnicity + issues + issuingrules + labels + labels_profile + matchchecks + notifys + nozebra + old_issues + old_reserves + overduerules + patroncards + patronimage + printers + printers_profile + reports_dictionary + reserveconstraints + reserves + reviews + roadtype + saved_reports + saved_sql + serial + serialitems + services_throttle + special_holidays + statistics + subscription + subscriptionhistory + subscriptionroutinglist + suggestions + tags + virtualshelfcontents + ); + + my $failed_to_truncate = 0; + foreach my $table ( @truncate_tables ) { + my $dbh = C4::Context->dbh(); + $dbh->do( "truncate $table" ) + or $failed_to_truncate = 1; + } + is( $failed_to_truncate, 0, 'truncated tables' ); +} + +=head2 startup_20_add_bookseller + +we need a bookseller for many of the tests, so let's insert one. Feel +free to use this one, or insert your own. + +=cut + +sub startup_20_add_bookseller : Test(startup => 1) { + my $self = shift; + + my $booksellerinfo = { name => 'bookseller ' . $self->random_string(), + }; + + my $id = AddBookseller( $booksellerinfo ); + ok( $id, "created bookseller: $id" ); + $self->{'booksellerid'} = $id; + + return; +} + +=head2 startup_22_add_bookfund + +we need a bookfund for many of the tests. This currently uses one that +is in the skeleton database. free to use this one, or insert your +own. + +=cut + +sub startup_22_add_bookfund : Test(startup => 2) { + my $self = shift; + + my $bookfundid = 'GEN'; + my $bookfund = GetBookFund( $bookfundid, undef ); + # diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund ) ) ); + is( $bookfund->{'bookfundid'}, $bookfundid, "found bookfund: '$bookfundid'" ); + is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" ); + + $self->{'bookfundid'} = $bookfundid; + return; +} + +=head2 startup_24_add_branch + +=cut + +sub startup_24_add_branch : Test(startup => 1) { + my $self = shift; + + my $branch_info = { + add => 1, + branchcode => $self->random_string(3), + branchname => $self->random_string(), + branchaddress1 => $self->random_string(), + branchaddress2 => $self->random_string(), + branchaddress3 => $self->random_string(), + branchphone => $self->random_phone(), + branchfax => $self->random_phone(), + brancemail => $self->random_email(), + branchip => $self->random_ip(), + branchprinter => $self->random_string(), + }; + C4::Branch::ModBranch($branch_info); + $self->{'branchcode'} = $branch_info->{'branchcode'}; + ok( $self->{'branchcode'}, "created branch: $self->{'branchcode'}" ); + +} + +=head2 startup_24_add_member + +Add a patron/member for the tests to use + +=cut + +sub startup_24_add_member : Test(startup => 1) { + my $self = shift; + + my $memberinfo = { surname => 'surname ' . $self->random_string(), + firstname => 'firstname' . $self->random_string(), + address => 'address' . $self->random_string(), + city => 'city' . $self->random_string(), + cardnumber => 'card' . $self->random_string(), + branchcode => 'CPL', # CPL => Centerville + categorycode => 'PT', # PT => PaTron + dateexpiry => '2010-01-01', + password => 'testpassword', + dateofbirth => $self->random_date(), + }; + + my $borrowernumber = AddMember( %$memberinfo ); + ok( $borrowernumber, "created member: $borrowernumber" ); + $self->{'memberid'} = $borrowernumber; + + return; +} + +=head2 startup_30_login + +=cut + +sub startup_30_login : Test( startup => 2 ) { + my $self = shift; + + $self->{'sessionid'} = '12345678'; # does this value matter? + my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} ); + ok( $borrower_details->{'cardnumber'}, 'cardnumber' ); + + # make a cookie and force it into $cgi. + # This would be a lot easier with Test::MockObject::Extends. + my $cgi = CGI->new( { userid => $borrower_details->{'cardnumber'}, + password => 'testpassword' } ); + my $setcookie = $cgi->cookie( -name => 'CGISESSID', + -value => $self->{'sessionid'} ); + $cgi->{'.cookies'} = { CGISESSID => $setcookie }; + is( $cgi->cookie('CGISESSID'), $self->{'sessionid'}, 'the CGISESSID cookie is set' ); + # diag( Data::Dumper->Dump( [ $cgi->cookie('CGISESSID') ], [ qw( cookie ) ] ) ); + + # C4::Auth::checkauth sometimes emits a warning about unable to append to sessionlog. That's OK. + my ( $userid, $cookie, $sessionID ) = C4::Auth::checkauth( $cgi, 'noauth', {}, 'intranet' ); + # diag( Data::Dumper->Dump( [ $userid, $cookie, $sessionID ], [ qw( userid cookie sessionID ) ] ) ); + + # my $session = C4::Auth::get_session( $sessionID ); + # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) ); + + +} + +=head2 setup methods + +setup methods are run before every test method + +=cut + +=head2 teardown methods + +teardown methods are many time, once at the end of each test method. + +=cut + +=head2 shutdown methods + +shutdown methods are run once, at the end of the test suite + +=cut + +=head2 utility methods + +These are not test methods, but they're handy + +=cut + +=head3 random_string + +Nice for generating names and such. It's not actually random, more +like arbitrary. + +=cut + +sub random_string { + my $self = shift; + + my $wordsize = shift || 6; # how many letters in your string? + + # leave out these characters: "oOlL10". They're too confusing. + my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 ); + + my $randomstring; + foreach ( 0..$wordsize ) { + $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ]; + } + return $randomstring; + +} + +=head3 random_phone + +generates a random phone number. Currently, it's not actually random. It's an unusable US phone number + +=cut + +sub random_phone { + my $self = shift; + + return '212-555-5555'; + +} + +=head3 random_email + +generates a random email address. They're all in the unusable +'example.com' domain that is designed for this purpose. + +=cut + +sub random_email { + my $self = shift; + + return $self->random_string() . '@example.com'; + +} + +=head3 random_ip + +returns an IP address suitable for testing purposes. + +=cut + +sub random_ip { + my $self = shift; + + return '127.0.0.2'; + +} + +=head3 random_date + +returns a somewhat random date in the iso (yyyy-mm-dd) format. + +=cut + +sub random_date { + my $self = shift; + + my $year = 1800 + int( rand(300) ); # 1800 - 2199 + my $month = 1 + int( rand(12) ); # 1 - 12 + my $day = 1 + int( rand(28) ); # 1 - 28 + # stop at the 28th to keep us from generating February 31st and such. + + return sprintf( '%04d-%02d-%02d', $year, $month, $day ); + +} + +=head3 tomorrow + +returns tomorrow's date as YYYY-MM-DD. + +=cut + +sub tomorrow { + my $self = shift; + + return $self->days_from_now( 1 ); + +} + +=head3 yesterday + +returns yesterday's date as YYYY-MM-DD. + +=cut + +sub yesterday { + my $self = shift; + + return $self->days_from_now( -1 ); +} + + +=head3 days_from_now + +returns an arbitrary date based on today in YYYY-MM-DD format. + +=cut + +sub days_from_now { + my $self = shift; + my $days = shift or return; + + my $seconds = time + $days * 60*60*24; + my $yyyymmdd = sprintf( '%04d-%02d-%02d', + localtime( $seconds )->year() + 1900, + localtime( $seconds )->mon() + 1, + localtime( $seconds )->mday() ); + return $yyyymmdd; +} + +=head3 add_biblios + + $self->add_biblios( count => 10, + add_items => 1, ); + + named parameters: + count: number of biblios to add + add_items: should you add items for each one? + + returns: + I don't know yet. + + side effects: + adds the biblionumbers to the $self->{'biblios'} listref + + Notes: + Should I allow you to pass in biblio information, like title? + Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace. + This runs 10 tests, plus 4 for each "count", plus 3 more for each item added. + +=cut + +sub add_biblios { + my $self = shift; + my %param = @_; + + $param{'count'} = 1 unless defined( $param{'count'} ); + $param{'add_items'} = 0 unless defined( $param{'add_items'} ); + + foreach my $counter ( 1..$param{'count'} ) { + my $marcrecord = MARC::Record->new(); + isa_ok( $marcrecord, 'MARC::Record' ); + my @marc_fields = ( MARC::Field->new( '100', '1', '0', + a => 'Twain, Mark', + d => "1835-1910." ), + MARC::Field->new( '245', '1', '4', + a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ), + c => "Mark Twain ; illustrated by E.W. Kemble." ), + MARC::Field->new( '952', '0', '0', + p => '12345678' . $self->random_string() ), # barcode + MARC::Field->new( '952', '0', '0', + o => $self->random_string() ), # callnumber + MARC::Field->new( '952', '0', '0', + a => 'CPL', + b => 'CPL' ), + ); + + my $appendedfieldscount = $marcrecord->append_fields( @marc_fields ); + + diag $MARC::Record::ERROR if ( $MARC::Record::ERROR ); + is( $appendedfieldscount, scalar @marc_fields, 'added correct number of MARC fields' ); + + my $frameworkcode = ''; # XXX I'd like to put something reasonable here. + my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode ); + ok( $biblionumber, "the biblionumber is $biblionumber" ); + ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" ); + if ( $param{'add_items'} ) { + # my @iteminfo = AddItem( {}, $biblionumber ); + my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber ); + is( $iteminfo[0], $biblionumber, "biblionumber is $biblionumber" ); + is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" ); + ok( $iteminfo[2], "itemnumber is $iteminfo[2]" ); + push @{ $self->{'items'} }, + { biblionumber => $iteminfo[0], + biblioitemnumber => $iteminfo[1], + itemnumber => $iteminfo[2], + }; + } + push @{$self->{'biblios'}}, $biblionumber; + } + + $self->reindex_marc(); + my $query = 'Finn Test'; + my ( $error, $results ) = SimpleSearch( $query ); + if ( $param{'count'} <= scalar( @$results ) ) { + pass( "found all $param{'count'} titles" ); + } else { + fail( "we never found all $param{'count'} titles" ); + } + +} + +=head3 reindex_marc + +Do a fast reindexing of all of the bib and authority +records and mark all zebraqueue entries done. + +Useful for test routines that need to do a +lot of indexing without having to wait for +zebraqueue. + +In NoZebra model, this only marks zebraqueue +done - the records should already be indexed. + +=cut + +sub reindex_marc { + my $self = shift; + + # mark zebraqueue done regardless of the indexing mode + my $dbh = C4::Context->dbh(); + $dbh->do("UPDATE zebraqueue SET done = 1 WHERE done = 0"); + + return if C4::Context->preference('NoZebra'); + + my $directory = tempdir(CLEANUP => 1); + foreach my $record_type qw(biblio authority) { + mkdir "$directory/$record_type"; + my $sth = $dbh->prepare($record_type eq "biblio" ? "SELECT marc FROM biblioitems" : "SELECT marc FROM auth_header"); + $sth->execute(); + open OUT, ">:utf8", "$directory/$record_type/records"; + while (my ($blob) = $sth->fetchrow_array) { + print OUT $blob; + } + close OUT; + my $zebra_server = "${record_type}server"; + my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'}; + my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'}; + my $zebra_db = $record_type eq 'biblio' ? 'biblios' : 'authorities'; + system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 init > /dev/null 2>\&1"; + system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 update $directory/${record_type} > /dev/null 2>\&1"; + system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 commit > /dev/null 2>\&1"; + } + +} + + +=head3 clear_test_database + + removes all tables from test database so that install starts with a clean slate + +=cut + +sub clear_test_database { + + diag "removing tables from test database"; + + my $dbh = C4::Context->dbh; + my $schema = C4::Context->config("database"); + + my @tables = get_all_tables($dbh, $schema); + foreach my $table (@tables) { + drop_all_foreign_keys($dbh, $table); + } + + foreach my $table (@tables) { + drop_table($dbh, $table); + } +} + +sub get_all_tables { + my ($dbh, $schema) = @_; + my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?"); + my @tables = (); + $sth->execute($schema); + while (my ($table) = $sth->fetchrow_array) { + push @tables, $table; + } + $sth->finish; + return @tables; +} + +sub drop_all_foreign_keys { + my ($dbh, $table) = @_; + # get the table description + my $sth = $dbh->prepare("SHOW CREATE TABLE $table"); + $sth->execute; + my $vsc_structure = $sth->fetchrow; + # split on CONSTRAINT keyword + my @fks = split /CONSTRAINT /,$vsc_structure; + # parse each entry + foreach (@fks) { + # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop + $_ = /(.*) FOREIGN KEY.*/; + my $id = $1; + if ($id) { + # we have found 1 foreign, drop it + $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id"); + if ( $dbh->err ) { + diag "unable to DROP FOREIGN KEY '$id' on TABLE '$table' due to: " . $dbh->errstr(); + } + undef $id; + } + } +} + +sub drop_table { + my ($dbh, $table) = @_; + $dbh->do("DROP TABLE $table"); + if ( $dbh->err ) { + diag "unable to drop table: '$table' due to: " . $dbh->errstr(); + } +} + +=head3 create_test_database + + sets up the test database. + +=cut + +sub create_test_database { + + diag 'creating testing database...'; + my $installer = C4::Installer->new() or die 'unable to create new installer'; + # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] ); + my $all_languages = getAllLanguages(); + my $error = $installer->load_db_schema(); + die "unable to load_db_schema: $error" if ( $error ); + my $list = $installer->sql_file_list('en', 'marc21', { optional => 1, + mandatory => 1 } ); + my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list); + $installer->set_version_syspref(); + $installer->set_marcflavour_syspref('MARC21'); + $installer->set_indexing_engine(0); + diag 'database created.' +} + + +=head3 start_zebrasrv + + This method deletes and reinitializes the zebra database directory, + and then spans off a zebra server. + +=cut + +sub start_zebrasrv { + + stop_zebrasrv(); + diag 'cleaning zebrasrv...'; + + foreach my $zebra_server ( qw( biblioserver authorityserver ) ) { + my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'}; + my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'}; + foreach my $zebra_db_name ( qw( biblios authorities ) ) { + my $command = "zebraidx -c $zebra_config -d $zebra_db_name init"; + my $return = system( $command . ' > /dev/null 2>&1' ); + if ( $return != 0 ) { + diag( "command '$command' died with value: " . $? >> 8 ); + } + + $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name"; + diag $command; + $return = system( $command . ' > /dev/null 2>&1' ); + if ( $return != 0 ) { + diag( "command '$command' died with value: " . $? >> 8 ); + } + } + } + + diag 'starting zebrasrv...'; + + my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' ); + my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s', + $ENV{'KOHA_CONF'}, + File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ), + $pidfile, + ); + diag $command; + my $output = qx( $command ); + if ( $output ) { + diag $output; + } + if ( -e $pidfile, 'pidfile exists' ) { + diag 'zebrasrv started.'; + } else { + die 'unable to start zebrasrv'; + } + return $output; +} + +=head3 stop_zebrasrv + + using the PID file for the zebra server, send it a TERM signal with + "kill". We can't tell if the process actually dies or not. + +=cut + +sub stop_zebrasrv { + + my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' ); + if ( -e $pidfile ) { + open( my $pidh, '<', $pidfile ) + or return; + if ( defined $pidh ) { + my ( $pid ) = <$pidh> or return; + close $pidh; + my $killed = kill 15, $pid; # 15 is TERM + if ( $killed != 1 ) { + warn "unable to kill zebrasrv with pid: $pid"; + } + } + } +} + + +=head3 start_zebraqueue_daemon + + kick off a zebraqueue_daemon.pl process. + +=cut + +sub start_zebraqueue_daemon { + + my $command = q(run/bin/koha-zebraqueue-ctl.sh start); + diag $command; + my $started = system( $command ); + diag "started: $started"; + +} + +=head3 stop_zebraqueue_daemon + + +=cut + +sub stop_zebraqueue_daemon { + + my $command = q(run/bin/koha-zebraqueue-ctl.sh stop); + diag $command; + my $started = system( $command ); + diag "started: $started"; + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Accounts.pm b/t/db_dependent/lib/KohaTest/Accounts.pm new file mode 100644 index 0000000000..703d478196 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Accounts.pm @@ -0,0 +1,30 @@ +package KohaTest::Accounts; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Accounts; +sub testing_class { 'C4::Accounts' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( recordpayment + makepayment + getnextacctno + returnlost + manualinvoice + fixcredit + refund + getcharges + getcredits + getrefunds + ); # removed fixaccounts (unused by codebase) + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Acquisition.pm b/t/db_dependent/lib/KohaTest/Acquisition.pm new file mode 100644 index 0000000000..eca0b16c10 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Acquisition.pm @@ -0,0 +1,147 @@ +package KohaTest::Acquisition; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Acquisition; +use C4::Context; +use C4::Members; +use Time::localtime; + +sub testing_class { 'C4::Acquisition' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( GetBasket + NewBasket + CloseBasket + GetPendingOrders + GetOrders + GetOrderNumber + GetOrder + NewOrder + ModOrder + ModOrderBiblioNumber + ModReceiveOrder + SearchOrder + DelOrder + GetParcel + GetParcels + GetLateOrders + GetHistory + GetRecentAcqui + ); + + can_ok( $self->testing_class, @methods ); +} + +=head3 create_new_basket + + creates a baseket by creating an order with no baseket number. + + named parameters: + authorizedby + invoice + date + + returns: baseket number, order number + + runs 4 tests + +=cut + +sub create_new_basket { + my $self = shift; + my %param = @_; + $param{'authorizedby'} = $self->{'memberid'} unless exists $param{'authorizedby'}; + $param{'invoice'} = 123 unless exists $param{'invoice'}; + + my $today = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900, + localtime->mon() + 1, + localtime->mday() ); + + # I actually think that this parameter is unused. + $param{'date'} = $today unless exists $param{'date'}; + + $self->add_biblios( add_items => 1 ); + ok( scalar @{$self->{'biblios'}} > 0, 'we have added at least one biblio' ); + + my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno, + $self->{'biblios'}[0], # $bibnum, + undef, # $title, + 1, # $quantity, + undef, # $listprice, + $self->{'booksellerid'}, # $booksellerid, + $param{'authorizedby'}, # $authorisedby, + undef, # $notes, + $self->{'bookfundid'}, # $bookfund, + undef, # $bibitemnum, + 1, # $rrp, + 1, # $ecost, + undef, # $gst, + undef, # $budget, + undef, # $cost, + undef, # $sub, + $param{'invoice'}, # $invoice, + undef, # $sort1, + undef, # $sort2, + undef, # $purchaseorder + ); + ok( $basketno, "my basket number is $basketno" ); + ok( $ordernumber, "my order number is $ordernumber" ); + + my $order = GetOrder( $ordernumber ); + is( $order->{'ordernumber'}, $ordernumber, 'got the right order' ) + or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) ); + + is( $order->{'budgetdate'}, $today, "the budget date is $today" ); + + # XXX should I stuff these in $self? + return ( $basketno, $ordernumber ); + +} + + +sub enable_independant_branches { + my $self = shift; + + my $member = GetMember( 'borrowernumber' =>$self->{'memberid'} ); + + C4::Context::set_userenv( 0, # usernum + $self->{'memberid'}, # userid + undef, # usercnum + undef, # userfirstname + undef, # usersurname + $member->{'branchcode'}, # userbranch + undef, # branchname + 0, # userflags + undef, # emailaddress + undef, # branchprinter + ); + + # set a preference. There's surely a method for this, but I can't find it. + my $retval = C4::Context->dbh->do( q(update systempreferences set value = '1' where variable = 'IndependantBranches') ); + ok( $retval, 'set the preference' ); + + ok( C4::Context->userenv, 'usernev' ); + isnt( C4::Context->userenv->{flags}, 1, 'flag != 1' ) + or diag( Data::Dumper->Dump( [ C4::Context->userenv ], [ 'userenv' ] ) ); + + is( C4::Context->userenv->{branch}, $member->{'branchcode'}, 'we have set the right branch in C4::Context: ' . $member->{'branchcode'} ); + +} + +sub disable_independant_branches { + my $self = shift; + + my $retval = C4::Context->dbh->do( q(update systempreferences set value = '0' where variable = 'IndependantBranches') ); + ok( $retval, 'set the preference back' ); + + +} +1; diff --git a/t/db_dependent/lib/KohaTest/Acquisition/GetHistory.pm b/t/db_dependent/lib/KohaTest/Acquisition/GetHistory.pm new file mode 100644 index 0000000000..8c7c475337 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Acquisition/GetHistory.pm @@ -0,0 +1,157 @@ +package KohaTest::Acquisition::GetHistory; +use base qw( KohaTest::Acquisition ); + +use strict; +use warnings; + +use Test::More; + +use C4::Acquisition; +use C4::Context; +use C4::Members; +use C4::Biblio; +use C4::Bookseller; + +=head3 no_history + + + +=cut + +sub no_history : Test( 4 ) { + my $self = shift; + + # my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on ) + + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory(); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 0, 'order_loop is empty' ); + is( $total_qty, 0, 'total_qty' ); + is( $total_price, 0, 'total_price' ); + is( $total_qtyreceived, 0, 'total_qtyreceived' ); + + +} + +=head3 one_order + +=cut + +sub one_order : Test( 50 ) { + my $self = shift; + + my ( $basketno, $ordernumber ) = $self->create_new_basket(); + ok( $basketno, "basketno is $basketno" ); + ok( $ordernumber, "ordernumber is $ordernumber" ); + + # No arguments fetches no history. + { + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory(); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 0, 'order_loop is empty' ); + is( $total_qty, 0, 'total_qty' ); + is( $total_price, 0, 'total_price' ); + is( $total_qtyreceived, 0, 'total_qtyreceived' ); + } + + my $bibliodata = GetBiblioData( $self->{'biblios'}[0] ); + ok( $bibliodata->{'title'}, 'the biblio has a title' ) + or diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) ); + + # searching by title should find it. + { + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $bibliodata->{'title'} ); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 1, 'order_loop searched by title' ); + is( $total_qty, 1, 'total_qty searched by title' ); + is( $total_price, 1, 'total_price searched by title' ); + is( $total_qtyreceived, 0, 'total_qtyreceived searched by title' ); + + # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) ); + } + + # searching by author + { + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, $bibliodata->{'author'} ); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 1, 'order_loop searched by author' ); + is( $total_qty, 1, 'total_qty searched by author' ); + is( $total_price, 1, 'total_price searched by author' ); + is( $total_qtyreceived, 0, 'total_qtyreceived searched by author' ); + } + + # searching by name + { + # diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) ); + + my $bookseller = GetBookSellerFromId( $self->{'booksellerid'} ); + ok( $bookseller->{'name'}, 'bookseller name' ) + or diag( Data::Dumper->Dump( [ $bookseller ], [ 'bookseller' ] ) ); + + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, $bookseller->{'name'} ); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 1, 'order_loop searched by name' ); + is( $total_qty, 1, 'total_qty searched by name' ); + is( $total_price, 1, 'total_price searched by name' ); + is( $total_qtyreceived, 0, 'total_qtyreceived searched by name' ); + } + + # searching by from_date + { + my $tomorrow = $self->tomorrow(); + # diag( "tomorrow is $tomorrow" ); + + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, undef, undef, $tomorrow ); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 1, 'order_loop searched by to_date' ); + is( $total_qty, 1, 'total_qty searched by to_date' ); + is( $total_price, 1, 'total_price searched by to_date' ); + is( $total_qtyreceived, 0, 'total_qtyreceived searched by to_date' ); + } + + # searching by from_date + { + my $yesterday = $self->yesterday(); + # diag( "yesterday was $yesterday" ); + + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, undef, $yesterday ); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 1, 'order_loop searched by from_date' ); + is( $total_qty, 1, 'total_qty searched by from_date' ); + is( $total_price, 1, 'total_price searched by from_date' ); + is( $total_qtyreceived, 0, 'total_qtyreceived searched by from_date' ); + } + + # set up some things necessary to make GetHistory use the IndependantBranches + $self->enable_independant_branches(); + + # just search by title here, we need to search by something. + { + my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $bibliodata->{'title'} ); + # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); + + is( scalar @$order_loop, 1, 'order_loop searched by title' ); + is( $total_qty, 1, 'total_qty searched by title' ); + is( $total_price, 1, 'total_price searched by title' ); + is( $total_qtyreceived, 0, 'total_qtyreceived searched by title' ); + + # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) ); + } + + # reset that. + $self->disable_independant_branches(); + + + + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Acquisition/GetLateOrders.pm b/t/db_dependent/lib/KohaTest/Acquisition/GetLateOrders.pm new file mode 100644 index 0000000000..a2f95ea380 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Acquisition/GetLateOrders.pm @@ -0,0 +1,106 @@ +package KohaTest::Acquisition::GetLateOrders; +use base qw( KohaTest::Acquisition ); + +use strict; +use warnings; + +use Test::More; + +use C4::Acquisition; +use C4::Context; +use C4::Members; + +=head3 no_orders + +=cut + +sub no_orders : Test( 1 ) { + my $self = shift; + + my @orders = GetLateOrders( 1 ); + is( scalar @orders, 0, 'There are no orders, so we found 0.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + +} + +=head3 one_order + +=cut + +sub one_order : Test( 29 ) { + my $self = shift; + + my ( $basketid, $ordernumber ) = $self->create_new_basket(); + ok( $basketid, 'a new basket was created' ); + ok( $ordernumber, 'the basket has an order in it.' ); + # we need this basket to be closed. + CloseBasket( $basketid ); + + my @orders = GetLateOrders( 0 ); + + { + my @orders = GetLateOrders( 0 ); + is( scalar @orders, 1, 'An order closed today is 0 days late.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + { + my @orders = GetLateOrders( 1 ); + is( scalar @orders, 0, 'An order closed today is not 1 day late.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + { + my @orders = GetLateOrders( -1 ); + is( scalar @orders, 1, 'an order closed today is -1 day late.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + + # provide some vendor information + { + my @orders = GetLateOrders( 0, $self->{'booksellerid'} ); + is( scalar @orders, 1, 'We found this late order with the right supplierid.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + { + my @orders = GetLateOrders( 0, $self->{'booksellerid'} + 1 ); + is( scalar @orders, 0, 'We found no late orders with the wrong supplierid.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + + # provide some branch information + my $member = GetMember( borrowernumber=>$self->{'memberid'} ); + # diag( Data::Dumper->Dump( [ $member ], [ 'member' ] ) ); + { + my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} ); + is( scalar @orders, 1, 'We found this late order with the right branchcode.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + { + my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' ); + is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + + # set up some things necessary to make GetLateOrders use the IndependantBranches + $self->enable_independant_branches(); + + { + my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} ); + is( scalar @orders, 1, 'We found this late order with the right branchcode.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + { + my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' ); + is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' ) + or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); + } + + # reset that. + $self->disable_independant_branches(); + +} + + + + + +1; diff --git a/t/db_dependent/lib/KohaTest/Acquisition/GetParcel.pm b/t/db_dependent/lib/KohaTest/Acquisition/GetParcel.pm new file mode 100644 index 0000000000..c26e5f2cb4 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Acquisition/GetParcel.pm @@ -0,0 +1,65 @@ +package KohaTest::Acquisition::GetParcel; +use base qw( KohaTest::Acquisition ); + +use strict; +use warnings; + +use Test::More; +use Time::localtime; + +use C4::Acquisition; + +=head3 no_parcel + +at first, there should be no parcels for our bookseller. + +=cut + +sub no_parcel : Test( 1 ) { + my $self = shift; + + my @parcel = GetParcel( $self->{'booksellerid'}, undef, undef ); + is( scalar @parcel, 0, 'our new bookseller has no parcels' ) + or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) ); +} + +=head3 one_parcel + +we create an order, mark it as received, and then see if we can find +it with GetParcel. + +=cut + +sub one_parcel : Test( 17 ) { + my $self = shift; + + my $invoice = 123; # XXX what should this be? + + my $today = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900, + localtime->mon() + 1, + localtime->mday() ); + my ( $basketno, $ordernumber ) = $self->create_new_basket(); + + ok( $basketno, "my basket number is $basketno" ); + ok( $ordernumber, "my order number is $ordernumber" ); + my $datereceived = ModReceiveOrder( $self->{'biblios'}[0], # biblionumber + $ordernumber, # $ordernumber, + undef, # $quantrec, + undef, # $user, + undef, # $cost, + $invoice, # $invoiceno, + undef, # $freight, + undef, # $rrp, + $self->{'bookfundid'}, # $bookfund, + $today, # $datereceived + ); + is( $datereceived, $today, "the parcel was received on $datereceived" ); + + my @parcel = GetParcel( $self->{'booksellerid'}, $invoice, $today ); + is( scalar @parcel, 1, 'we found one (1) parcel.' ) + or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Acquisition/GetParcels.pm b/t/db_dependent/lib/KohaTest/Acquisition/GetParcels.pm new file mode 100644 index 0000000000..fd3ad0fba8 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Acquisition/GetParcels.pm @@ -0,0 +1,289 @@ +package KohaTest::Acquisition::GetParcels; +use base qw( KohaTest::Acquisition ); + +use strict; +use warnings; + +use Test::More; +use Time::localtime; + +use C4::Acquisition; + +=head2 NOTE + +Please do not confuse this with the test suite for C4::Acquisition::GetParcel. + +=head3 no_parcels + +at first, there should be no parcels for our bookseller. + +=cut + +sub no_parcels : Test( 1 ) { + my $self = shift; + + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + # order + # code ( aqorders.booksellerinvoicenumber ) + # datefrom + # date to + ); + + is( scalar @parcels, 0, 'our new bookseller has no parcels' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); +} + +=head3 one_parcel + +we create an order, mark it as received, and then see if we can find +it with GetParcels. + +=cut + +sub one_parcel : Test( 19 ) { + my $self = shift; + + my $invoice = 123; # XXX what should this be? + my $today = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900, + localtime->mon() + 1, + localtime->mday() ); + + $self->create_order( authorizedby => 1, # XXX what should this be? + invoice => $invoice, + date => $today ); + + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + # order + # code ( aqorders.booksellerinvoicenumber ) + # datefrom + # date to + ); + is( scalar @parcels, 1, 'we found one (1) parcel.' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + + my $thisparcel = shift( @parcels ); + is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' ) + or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); + + is( $thisparcel->{'datereceived'}, $today, 'datereceived' ); + is( $thisparcel->{'biblio'}, 1, 'biblio' ); + is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' ); + + # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); + +} + +=head3 two_parcels + +we create another order, mark it as received, and then see if we can find +them all with GetParcels. + +=cut + +sub two_parcels : Test( 31 ) { + my $self = shift; + + my $invoice = 1234; # XXX what should this be? + my $today = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900, + localtime->mon() + 1, + localtime->mday() ); + $self->create_order( authorizedby => 1, # XXX what should this be? + invoice => $invoice, + date => $today ); + + { + # fetch them all and check that this one is last + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + # order + # code ( aqorders.booksellerinvoicenumber ) + # datefrom + # date to + ); + is( scalar @parcels, 2, 'we found two (2) parcels.' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + + my $thisparcel = pop( @parcels ); + is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' ) + or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); + + is( $thisparcel->{'datereceived'}, $today, 'datereceived' ); + is( $thisparcel->{'biblio'}, 1, 'biblio' ); + is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' ); + } + + { + # fetch just one, by using the exact code + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + undef, # order + $invoice, # code ( aqorders.booksellerinvoicenumber ) + undef, # datefrom + undef, # date to + ); + is( scalar @parcels, 1, 'we found one (1) parcels.' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + + my $thisparcel = pop( @parcels ); + is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' ) + or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); + + is( $thisparcel->{'datereceived'}, $today, 'datereceived' ); + is( $thisparcel->{'biblio'}, 1, 'biblio' ); + is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' ); + } + + { + # fetch them both by using code 123, which gets 123 and 1234 + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + undef, # order + '123', # code ( aqorders.booksellerinvoicenumber ) + undef, # datefrom + undef, # date to + ); + is( scalar @parcels, 2, 'we found 2 parcels.' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + + } + + { + # fetch them both, and try to order them + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + 'aqorders.booksellerinvoicenumber', # order + undef, # code ( aqorders.booksellerinvoicenumber ) + undef, # datefrom + undef, # date to + ); + is( scalar @parcels, 2, 'we found 2 parcels.' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + is( $parcels[0]->{'booksellerinvoicenumber'}, 123 ); + is( $parcels[1]->{'booksellerinvoicenumber'}, 1234 ); + + } + + { + # fetch them both, and try to order them, descending + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + 'aqorders.booksellerinvoicenumber desc', # order + undef, # code ( aqorders.booksellerinvoicenumber ) + undef, # datefrom + undef, # date to + ); + is( scalar @parcels, 2, 'we found 2 parcels.' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + is( $parcels[0]->{'booksellerinvoicenumber'}, 1234 ); + is( $parcels[1]->{'booksellerinvoicenumber'}, 123 ); + + } + + + + + # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); + +} + + +=head3 z_several_parcels_with_different_dates + +we create an order, mark it as received, and then see if we can find +it with GetParcels. + +=cut + +sub z_several_parcels_with_different_dates : Test( 44 ) { + my $self = shift; + + my $authorizedby = 1; # XXX what should this be? + + my @inputs = ( { invoice => 10, + date => sprintf( '%04d-%02d-%02d', + 1950, + localtime->mon() + 1, + 10 ), # I'm using the invoice number as the day. + }, + { invoice => 15, + date => sprintf( '%04d-%02d-%02d', + 1950, + localtime->mon() + 1, + 15 ), # I'm using the invoice number as the day. + }, + { invoice => 20, + date => sprintf( '%04d-%02d-%02d', + 1950, + localtime->mon() + 1, + 20 ), # I'm using the invoice number as the day. + }, + ); + + foreach my $input ( @inputs ) { + $self->create_order( authorizedby => $authorizedby, + invoice => $input->{'invoice'}, + date => $input->{'date'}, + ); + } + + my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + undef, # order + undef, # code ( aqorders.booksellerinvoicenumber ) + sprintf( '%04d-%02d-%02d', + 1950, + localtime->mon() + 1, + 10 ), # datefrom + sprintf( '%04d-%02d-%02d', + 1950, + localtime->mon() + 1, + 20 ), # dateto + ); + is( scalar @parcels, scalar @inputs, 'we found all of the parcels.' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + + @parcels = GetParcels( $self->{'booksellerid'}, # bookseller + undef, # order + undef, # code ( aqorders.booksellerinvoicenumber ) + sprintf( '%04d-%02d-%02d', + 1950, + localtime->mon() + 1, + 10 ), # datefrom + sprintf( '%04d-%02d-%02d', + 1950, + localtime->mon() + 1, + 16 ), # dateto + ); + is( scalar @parcels, scalar @inputs - 1, 'we found all of the parcels except one' ) + or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); + + + + # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); + +} + +sub create_order { + my $self = shift; + my %param = @_; + $param{'authorizedby'} = 1 unless exists $param{'authorizedby'}; + $param{'invoice'} = 1 unless exists $param{'invoice'}; + $param{'date'} = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900, + localtime->mon() + 1, + localtime->mday() ) unless exists $param{'date'}; + + my ( $basketno, $ordernumber ) = $self->create_new_basket( %param ); + + my $datereceived = ModReceiveOrder( $self->{'biblios'}[0], # biblionumber + $ordernumber, # $ordernumber, + undef, # $quantrec, + undef, # $user, + undef, # $cost, + $param{'invoice'}, # $invoiceno, + undef, # $freight, + undef, # $rrp, + $self->{'bookfundid'}, # $bookfund, + $param{'date'}, # $datereceived + ); + is( $datereceived, $param{'date'}, "the parcel was received on $datereceived" ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Acquisition/GetPendingOrders.pm b/t/db_dependent/lib/KohaTest/Acquisition/GetPendingOrders.pm new file mode 100644 index 0000000000..cf4bb1551a --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Acquisition/GetPendingOrders.pm @@ -0,0 +1,82 @@ +package KohaTest::Acquisition::GetPendingOrders; +use base qw( KohaTest::Acquisition ); + +use strict; +use warnings; + +use Test::More; + +use C4::Acquisition; + +=head3 no_orders + +at first, there should be no orders for our bookseller. + +=cut + +sub no_orders : Test( 1 ) { + my $self = shift; + + my $orders = GetPendingOrders( $self->{'booksellerid'} ); + is( scalar @$orders, 0, 'our new bookseller has no pending orders' ) + or diag( Data::Dumper->Dump( [ $orders ], [ 'orders' ] ) ); +} + +=head3 new_order + +we make an order, then see if it shows up in the pending orders + +=cut + +sub one_new_order : Test( 49 ) { + my $self = shift; + + my ( $basketno, $ordernumber ) = $self->create_new_basket(); + + ok( $basketno, "basketno is $basketno" ); + ok( $ordernumber, "ordernumber is $ordernumber" ); + + my $orders = GetPendingOrders( $self->{'booksellerid'} ); + is( scalar @$orders, 1, 'we successfully entered one order.' ); + + my @expectedfields = qw( basketno + biblioitemnumber + biblionumber + booksellerinvoicenumber + budgetdate + cancelledby + closedate + creationdate + currency + datecancellationprinted + datereceived + ecost + entrydate + firstname + freight + gst + listprice + notes + ordernumber + purchaseordernumber + quantity + quantityreceived + rrp + serialid + sort1 + sort2 + subscription + supplierreference + surname + timestamp + title + totalamount + unitprice ); + my $firstorder = $orders->[0]; + for my $field ( @expectedfields ) { + ok( exists( $firstorder->{ $field } ), "This order has a $field field" ); + } + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Acquisition/NewOrder.pm b/t/db_dependent/lib/KohaTest/Acquisition/NewOrder.pm new file mode 100644 index 0000000000..972cde2f5d --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Acquisition/NewOrder.pm @@ -0,0 +1,108 @@ +package KohaTest::Acquisition::NewOrder; +use base qw( KohaTest::Acquisition ); + +use strict; +use warnings; + +use Test::More; +use Time::localtime; + +use C4::Acquisition; + +=head3 new_order_no_budget + +If we make a new order and don't pass in a budget date, it defaults to +today. + +=cut + +sub new_order_no_budget : Test( 4 ) { + my $self = shift; + + my $authorizedby = 1; # XXX what should this be? + my $invoice = 123; # XXX what should this be? + my $today = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900, + localtime->mon() + 1, + localtime->mday() ); + my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno, + 1, # $bibnum, + undef, # $title, + undef, # $quantity, + undef, # $listprice, + $self->{'booksellerid'}, # $booksellerid, + $authorizedby, # $authorisedby, + undef, # $notes, + $self->{'bookfundid'}, # $bookfund, + undef, # $bibitemnum, + undef, # $rrp, + undef, # $ecost, + undef, # $gst, + undef, # $budget, + undef, # $cost, + undef, # $sub, + $invoice, # $invoice, + undef, # $sort1, + undef, # $sort2, + undef, # $purchaseorder, + undef, # $branchcode + ); + ok( $basketno, "my basket number is $basketno" ); + ok( $ordernumber, "my order number is $ordernumber" ); + + my $order = GetOrder( $ordernumber ); + is( $order->{'ordernumber'}, $ordernumber, 'got the right order' ) + or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) ); + + is( $order->{'budgetdate'}, $today, "the budget date is $today" ); +} + +=head3 new_order_set_budget + +Let's set the budget date of this new order. It actually pretty much +only pays attention to the current month and year. + +=cut + +sub new_order_set_budget : Test( 4 ) { + my $self = shift; + + my $authorizedby = 1; # XXX what should this be? + my $invoice = 123; # XXX what should this be? + my $today = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900, + localtime->mon() + 1, + localtime->mday() ); + my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno, + 1, # $bibnum, + undef, # $title, + undef, # $quantity, + undef, # $listprice, + $self->{'booksellerid'}, # $booksellerid, + $authorizedby, # $authorisedby, + undef, # $notes, + $self->{'bookfundid'}, # $bookfund, + undef, # $bibitemnum, + undef, # $rrp, + undef, # $ecost, + undef, # $gst, + 'does not matter, just not undef', # $budget, + undef, # $cost, + undef, # $sub, + $invoice, # $invoice, + undef, # $sort1, + undef, # $sort2, + undef, # $purchaseorder, + undef, # $branchcode + ); + ok( $basketno, "my basket number is $basketno" ); + ok( $ordernumber, "my order number is $ordernumber" ); + + my $order = GetOrder( $ordernumber ); + is( $order->{'ordernumber'}, $ordernumber, 'got the right order' ) + or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) ); + + like( $order->{'budgetdate'}, qr(^2\d\d\d-07-01$), "the budget date ($order->{'budgetdate'}) is a July 1st." ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/AuthoritiesMarc.pm b/t/db_dependent/lib/KohaTest/AuthoritiesMarc.pm new file mode 100644 index 0000000000..6114843ca4 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/AuthoritiesMarc.pm @@ -0,0 +1,41 @@ +package KohaTest::AuthoritiesMarc; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::AuthoritiesMarc; +sub testing_class { 'C4::AuthoritiesMarc' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( GetAuthMARCFromKohaField + SearchAuthorities + CountUsage + CountUsageChildren + GetAuthTypeCode + GetTagsLabels + AddAuthority + DelAuthority + ModAuthority + GetAuthorityXML + GetAuthority + GetAuthType + AUTHhtml2marc + FindDuplicateAuthority + BuildSummary + BuildUnimarcHierarchies + BuildUnimarcHierarchy + GetHeaderAuthority + AddAuthorityTrees + merge + get_auth_type_location + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Biblio.pm b/t/db_dependent/lib/KohaTest/Biblio.pm new file mode 100644 index 0000000000..3e6634cb48 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Biblio.pm @@ -0,0 +1,73 @@ +package KohaTest::Biblio; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Biblio; +sub testing_class { 'C4::Biblio' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + AddBiblio + ModBiblio + ModBiblioframework + DelBiblio + LinkBibHeadingsToAuthorities + GetBiblioData + GetBiblioItemData + GetBiblioItemByBiblioNumber + GetBiblioFromItemNumber + GetBiblio + GetBiblioItemInfosOf + GetMarcStructure + GetUsedMarcStructure + GetMarcFromKohaField + GetMarcBiblio + GetXmlBiblio + GetAuthorisedValueDesc + GetMarcNotes + GetMarcSubjects + GetMarcAuthors + GetMarcUrls + GetMarcSeries + GetFrameworkCode + GetPublisherNameFromIsbn + TransformKohaToMarc + TransformKohaToMarcOneField + TransformHtmlToXml + TransformHtmlToMarc + TransformMarcToKoha + _get_inverted_marc_field_map + _disambiguate + get_koha_field_from_marc + TransformMarcToKohaOneField + PrepareItemrecordDisplay + ModZebra + GetNoZebraIndexes + _DelBiblioNoZebra + _AddBiblioNoZebra + _find_value + _koha_marc_update_bib_ids + _koha_marc_update_biblioitem_cn_sort + _koha_add_biblio + _koha_modify_biblio + _koha_modify_biblioitem_nonmarc + _koha_add_biblioitem + _koha_delete_biblio + _koha_delete_biblioitems + ModBiblioMarc + z3950_extended_services + set_service_options + get_biblio_authorised_values + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Biblio/GetNoZebraIndexes.pm b/t/db_dependent/lib/KohaTest/Biblio/GetNoZebraIndexes.pm new file mode 100644 index 0000000000..11dffbefd2 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Biblio/GetNoZebraIndexes.pm @@ -0,0 +1,72 @@ +package KohaTest::Biblio::GetNoZebraIndexes; +use base qw( KohaTest::Biblio ); + +use strict; +use warnings; + +use Test::More; + +use C4::Biblio; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + + +=head2 TEST METHODS + +standard test methods + +=head3 + +=cut + +sub returns_expected_hashref : Test(2) { + my $self = shift; + + my %nzi = C4::Biblio::GetNoZebraIndexes(); + ok( scalar keys %nzi, 'got some keys from GetNoZebraIndexes' ); + + my %expected = ( + 'title' => '130a,210a,222a,240a,243a,245a,245b,246a,246b,247a,247b,250a,250b,440a,830a', + 'author' => '100a,100b,100c,100d,110a,111a,111b,111c,111d,245c,700a,710a,711a,800a,810a,811a', + 'isbn' => '020a', + 'issn' => '022a', + 'lccn' => '010a', + 'biblionumber' => '999c', + 'itemtype' => '942c', + 'publisher' => '260b', + 'date' => '260c', + 'note' => '500a,501a,504a,505a,508a,511a,518a,520a,521a,522a,524a,526a,530a,533a,538a,541a,546a,555a,556a,562a,563a,583a,585a,582a', + 'subject' => '600*,610*,611*,630*,650*,651*,653*,654*,655*,662*,690*', + 'dewey' => '082', + 'bc' => '952p', + 'callnum' => '952o', + 'an' => '6009,6109,6119', + 'homebranch' => '952a,952c' + ); + is_deeply( \%nzi, \%expected, 'GetNoZebraIndexes returns the expected hashref' ); +} + +=head2 HELPER METHODS + +These methods are used by other test methods, but +are not meant to be called directly. + +=cut + +=cut + + +=head2 SHUTDOWN METHODS + +These get run once, after the main test methods in this module + +=head3 + +=cut + + +1; diff --git a/t/db_dependent/lib/KohaTest/Biblio/ModBiblio.pm b/t/db_dependent/lib/KohaTest/Biblio/ModBiblio.pm new file mode 100644 index 0000000000..5b29ea8b61 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Biblio/ModBiblio.pm @@ -0,0 +1,154 @@ +package KohaTest::Biblio::ModBiblio; +use base qw( KohaTest::Biblio ); + +use strict; +use warnings; + +use Test::More; + +use C4::Biblio; +use C4::Items; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=head3 add_bib_to_modify + +=cut + +sub add_bib_to_modify : Test( startup => 3 ) { + my $self = shift; + + my $bib = MARC::Record->new(); + $bib->leader(' ngm a22 7a 4500'); + $bib->append_fields( + MARC::Field->new('100', ' ', ' ', a => 'Moffat, Steven'), + MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'), + ); + + my ($bibnum, $bibitemnum) = AddBiblio($bib, ''); + $self->{'bib_to_modify'} = $bibnum; + + # add an item + my ($item_bibnum, $item_bibitemnum, $itemnumber) = AddItem({ homebranch => 'CPL', holdingbranch => 'CPL' } , $bibnum); + + cmp_ok($item_bibnum, '==', $bibnum, "new item is linked to correct biblionumber"); + cmp_ok($item_bibitemnum, '==', $bibitemnum, "new item is linked to correct biblioitemnumber"); + + $self->reindex_marc(); + + my $marc = $self->fetch_bib($bibnum); + $self->sort_item_and_bibnumber_fields($marc); + $self->{'bib_to_modify_formatted'} = $marc->as_formatted(); # simple way to compare later +} + +=head2 TEST METHODS + +standard test methods + +=head3 bug_2297 + +Regression test for bug 2297 (saving a subscription duplicates MARC item fields) + +=cut + +sub bug_2297 : Test( 5 ) { + my $self = shift; + + my $bibnum = $self->{'bib_to_modify'}; + my $marc = $self->fetch_bib($bibnum); + $self->check_item_count($marc, 1); + + ModBiblio($marc, $bibnum, ''); # no change made to bib + + my $modified_marc = $self->fetch_bib($bibnum); + diag "checking item field count after null modification"; + $self->check_item_count($modified_marc, 1); + + $self->sort_item_and_bibnumber_fields($modified_marc); + is($modified_marc->as_formatted(), $self->{'bib_to_modify_formatted'}, "no change to bib after null modification"); +} + +=head2 HELPER METHODS + +These methods are used by other test methods, but +are not meant to be called directly. + +=cut + +=head3 fetch_bib + +=cut + +sub fetch_bib { # +1 to test count per call + my $self = shift; + my $bibnum = shift; + + my $marc = GetMarcBiblio($bibnum); + ok(defined($marc), "retrieved bib record $bibnum"); + + return $marc; +} + +=head3 check_item_count + +=cut + +sub check_item_count { # +1 to test count per call + my $self = shift; + my $marc = shift; + my $expected_items = shift; + + my ($itemtag, $itemsubfield) = GetMarcFromKohaField("items.itemnumber", ''); + my @item_fields = $marc->field($itemtag); + cmp_ok(scalar(@item_fields), "==", $expected_items, "exactly one item field"); +} + +=head3 sort_item_and_bibnumber_fields + +This method sorts the field containing the embedded item data +and the bibnumber - ModBiblio(), AddBiblio(), and ModItem() do +not guarantee that these fields will be sorted in tag order. + +=cut + +sub sort_item_and_bibnumber_fields { + my $self = shift; + my $marc = shift; + + my ($itemtag, $itemsubfield) = GetMarcFromKohaField("items.itemnumber", ''); + my ($bibnumtag, $bibnumsubfield) = GetMarcFromKohaField("biblio.biblionumber", ''); + + my @item_fields = (); + foreach my $field ($marc->field($itemtag)) { + push @item_fields, $field; + $marc->delete_field($field); + } + $marc->insert_fields_ordered(@item_fields) if scalar(@item_fields);; + + my @bibnum_fields = (); + foreach my $field ($marc->field($bibnumtag)) { + push @bibnum_fields, $field; + $marc->delete_field($field); + } + $marc->insert_fields_ordered(@bibnum_fields) if scalar(@bibnum_fields); + +} + +=head2 SHUTDOWN METHODS + +These get run once, after the main test methods in this module + +=head3 shutdown_clean_object + +=cut + +sub shutdown_clean_object : Test( shutdown => 0 ) { + my $self = shift; + + delete $self->{'bib_to_modify'}; + delete $self->{'bib_to_modify_formatted'}; +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Biblio/get_biblio_authorised_values.pm b/t/db_dependent/lib/KohaTest/Biblio/get_biblio_authorised_values.pm new file mode 100644 index 0000000000..aab03a0e55 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Biblio/get_biblio_authorised_values.pm @@ -0,0 +1,48 @@ +package KohaTest::Biblio::get_biblio_authorised_values; +use base qw( KohaTest::Biblio ); + +use strict; +use warnings; + +use Test::More; + +use C4::Biblio; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=head3 insert_test_data + +=cut + +sub insert_test_data : Test( startup => 71 ) { + my $self = shift; + + # I'm going to add a bunch of biblios so that I can search for them. + $self->add_biblios( count => 10, + add_items => 1 ); + + +} + +=head2 TEST METHODS + +standard test methods + +=head3 basic_test + +basic usage. + +=cut + +sub basic_test : Test( 1 ) { + my $self = shift; + + ok( $self->{'biblios'}[0], 'we have a biblionumber' ); + my $authorised_values = C4::Biblio::get_biblio_authorised_values( $self->{'biblios'}[0] ); + diag( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Branch.pm b/t/db_dependent/lib/KohaTest/Branch.pm new file mode 100644 index 0000000000..ce7ff603f5 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Branch.pm @@ -0,0 +1,36 @@ +package KohaTest::Branch; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Branch; +sub testing_class { 'C4::Branch' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( GetBranches + GetBranchName + ModBranch + GetBranchCategory + GetBranchCategories + GetCategoryTypes + GetBranch + GetBranchDetail + get_branchinfos_of + GetBranchesInCategory + GetBranchInfo + DelBranch + ModBranchCategoryInfo + DelBranchCategory + CheckBranchCategorycode + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Branch/GetBranches.pm b/t/db_dependent/lib/KohaTest/Branch/GetBranches.pm new file mode 100644 index 0000000000..1dc5d0fcc5 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Branch/GetBranches.pm @@ -0,0 +1,41 @@ +package KohaTest::Branch::GetBranches; +use base qw( KohaTest::Branch ); + +use strict; +use warnings; + +use Test::More; + +use C4::Branch; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head2 TEST METHODS + +standard test methods + +=head3 onlymine + + When you pass in something true to GetBranches, it limits the + response to only your branch. + +=cut + +sub onlymine : Test( 4 ) { + my $self = shift; + + # C4::Branch::GetBranches uses this variable, so make sure it exists. + ok( C4::Context->userenv->{'branch'}, 'we have a branch' ); + my $branches = C4::Branch::GetBranches( 'onlymine' ); + # diag( Data::Dumper->Dump( [ $branches ], [ 'branches' ] ) ); + is( scalar( keys %$branches ), 1, 'one key for our branch only' ); + ok( exists $branches->{ C4::Context->userenv->{'branch'} }, 'my branch was returned' ); + is( $branches->{ C4::Context->userenv->{'branch'} }->{'branchcode'}, C4::Context->userenv->{'branch'}, 'branchcode' ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Breeding.pm b/t/db_dependent/lib/KohaTest/Breeding.pm new file mode 100644 index 0000000000..d098ae5ffa --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Breeding.pm @@ -0,0 +1,23 @@ +package KohaTest::Breeding; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Breeding; +sub testing_class { 'C4::Breeding' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( ImportBreeding + BreedingSearch + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Calendar.pm b/t/db_dependent/lib/KohaTest/Calendar.pm new file mode 100644 index 0000000000..8b1cda74d0 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Calendar.pm @@ -0,0 +1,34 @@ +package KohaTest::Calendar; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Calendar; +sub testing_class { 'C4::Calendar' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( new + get_week_days_holidays + get_day_month_holidays + get_exception_holidays + get_single_holidays + insert_week_day_holiday + insert_day_month_holiday + insert_single_holiday + insert_exception_holiday + delete_holiday + isHoliday + addDate + daysBetween + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Calendar/New.pm b/t/db_dependent/lib/KohaTest/Calendar/New.pm new file mode 100644 index 0000000000..745366b434 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Calendar/New.pm @@ -0,0 +1,186 @@ +package KohaTest::Calendar::New; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Calendar; +sub testing_class { 'C4::Calendar' }; + + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head2 TEST METHODS + +standard test methods + +=head3 instantiation + + just test to see if I can instantiate an object + +=cut + +sub instantiation : Test( 14 ) { + my $self = shift; + + my $calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + + ok( exists $calendar->{'day_month_holidays'}, 'day_month_holidays' ); + ok( exists $calendar->{'single_holidays'}, 'single_holidays' ); + ok( exists $calendar->{'week_days_holidays'}, 'week_days_holidays' ); + ok( exists $calendar->{'exception_holidays'}, 'exception_holidays' ); + + # sample data has Sundays as a holiday + ok( exists $calendar->{'week_days_holidays'}->{'0'} ); + is( $calendar->{'week_days_holidays'}->{'0'}->{'title'}, '', 'Sunday title' ); + is( $calendar->{'week_days_holidays'}->{'0'}->{'description'}, 'Sundays', 'Sunday description' ); + + # sample data has Christmas as a holiday + ok( exists $calendar->{'day_month_holidays'}->{'12/25'} ); + is( $calendar->{'day_month_holidays'}->{'12/25'}->{'title'}, '', 'Christmas title' ); + is( $calendar->{'day_month_holidays'}->{'12/25'}->{'description'}, 'Christmas', 'Christmas description' ); + + # sample data has New Year's Day as a holiday + ok( exists $calendar->{'day_month_holidays'}->{'1/1'} ); + is( $calendar->{'day_month_holidays'}->{'1/1'}->{'title'}, '', 'New Year title' ); + is( $calendar->{'day_month_holidays'}->{'1/1'}->{'description'}, q(New Year's Day), 'New Year description' ); + +} + +sub week_day_holidays : Test( 8 ) { + my $self = shift; + + my $calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + + ok( exists $calendar->{'week_days_holidays'}, 'week_days_holidays' ); + + my %new_holiday = ( weekday => 1, + title => 'example week_day_holiday', + description => 'This is an example week_day_holiday used for testing' ); + my $new_calendar = $calendar->insert_week_day_holiday( %new_holiday ); + + # the calendar object returned from insert_week_day_holiday should be updated + isa_ok( $new_calendar, 'C4::Calendar' ); + is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'description'}, $new_holiday{'description'}, 'description' ); + + # new calendar objects should have the newly inserted holiday. + my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $refreshed_calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'description'}, $new_holiday{'description'}, 'description' ); + +} + + +sub day_month_holidays : Test( 8 ) { + my $self = shift; + + my $calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + + ok( exists $calendar->{'day_month_holidays'}, 'day_month_holidays' ); + + my %new_holiday = ( day => 4, + month => 5, + title => 'example day_month_holiday', + description => 'This is an example day_month_holiday used for testing' ); + my $new_calendar = $calendar->insert_day_month_holiday( %new_holiday ); + + # the calendar object returned from insert_week_day_holiday should be updated + isa_ok( $new_calendar, 'C4::Calendar' ); + my $mmdd = sprintf('%s/%s', $new_holiday{'month'}, $new_holiday{'day'} ) ; + is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'description'}, $new_holiday{'description'}, 'description' ); + + # new calendar objects should have the newly inserted holiday. + my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $refreshed_calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'description'}, $new_holiday{'description'}, 'description' ); + +} + + + +sub exception_holidays : Test( 8 ) { + my $self = shift; + + my $calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + + ok( exists $calendar->{'exception_holidays'}, 'exception_holidays' ); + + my %new_holiday = ( day => 4, + month => 5, + year => 2010, + title => 'example exception_holiday', + description => 'This is an example exception_holiday used for testing' ); + my $new_calendar = $calendar->insert_exception_holiday( %new_holiday ); + # diag( Data::Dumper->Dump( [ $new_calendar ], [ 'newcalendar' ] ) ); + + # the calendar object returned from insert_week_day_holiday should be updated + isa_ok( $new_calendar, 'C4::Calendar' ); + my $yyyymmdd = sprintf('%s/%s/%s', $new_holiday{'year'}, $new_holiday{'month'}, $new_holiday{'day'} ) ; + is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); + + # new calendar objects should have the newly inserted holiday. + my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $refreshed_calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); + +} + + +sub single_holidays : Test( 8 ) { + my $self = shift; + + my $calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + + ok( exists $calendar->{'single_holidays'}, 'single_holidays' ); + + my %new_holiday = ( day => 4, + month => 5, + year => 2011, + title => 'example single_holiday', + description => 'This is an example single_holiday used for testing' ); + my $new_calendar = $calendar->insert_single_holiday( %new_holiday ); + # diag( Data::Dumper->Dump( [ $new_calendar ], [ 'newcalendar' ] ) ); + + # the calendar object returned from insert_week_day_holiday should be updated + isa_ok( $new_calendar, 'C4::Calendar' ); + my $yyyymmdd = sprintf('%s/%s/%s', $new_holiday{'year'}, $new_holiday{'month'}, $new_holiday{'day'} ) ; + is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); + + # new calendar objects should have the newly inserted holiday. + my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); + isa_ok( $refreshed_calendar, 'C4::Calendar' ); + # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); + is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); + is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); + +} + + +1; + diff --git a/t/db_dependent/lib/KohaTest/Category.pm b/t/db_dependent/lib/KohaTest/Category.pm new file mode 100644 index 0000000000..3febfda916 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Category.pm @@ -0,0 +1,23 @@ +package KohaTest::Category; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Category; +sub testing_class { 'C4::Category' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new + all + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Circulation.pm b/t/db_dependent/lib/KohaTest/Circulation.pm new file mode 100644 index 0000000000..7d5e69d2ac --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Circulation.pm @@ -0,0 +1,142 @@ +package KohaTest::Circulation; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Circulation; +sub testing_class { 'C4::Circulation' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( barcodedecode + decode + transferbook + TooMany + itemissues + CanBookBeIssued + AddIssue + GetLoanLength + GetIssuingRule + GetBranchBorrowerCircRule + AddReturn + MarkIssueReturned + _FixOverduesOnReturn + _FixAccountForLostAndReturned + GetItemIssue + GetItemIssues + GetBiblioIssues + GetUpcomingDueIssues + CanBookBeRenewed + AddRenewal + GetRenewCount + GetIssuingCharges + AddIssuingCharge + GetTransfers + GetTransfersFromTo + DeleteTransfer + AnonymiseIssueHistory + updateWrongTransfer + UpdateHoldingbranch + CalcDateDue + CheckValidDatedue + CheckRepeatableHolidays + CheckSpecialHolidays + CheckRepeatableSpecialHolidays + CheckValidBarcode + ); + + can_ok( $self->testing_class, @methods ); +} + +=head3 setup_add_biblios + +everything in the C4::Circulation really requires items, so let's do this in the setup phase. + +=cut + +sub setup_add_biblios : Tests( setup => 8 ) { + my $self = shift; + + # we want to use a fresh batch of items, so clear these lists: + delete $self->{'items'}; + delete $self->{'biblios'}; + + $self->add_biblios( add_items => 1 ); +} + + +=head3 checkout_first_item + +named parameters: + borrower => borrower hashref, computed from $self->{'memberid'} if not given + barcode => item barcode, barcode of $self->{'items'}[0] if not given + issuedate => YYYY-MM-DD of date to mark issue checked out. defaults to today. + +=cut + +sub checkout_first_item { + my $self = shift; + my $params = shift; + + # get passed in borrower, or default to the one in $self. + my $borrower = $params->{'borrower'}; + if ( ! defined $borrower ) { + my $borrowernumber = $self->{'memberid'}; + $borrower = C4::Members::GetMemberDetails( $borrowernumber ); + } + + # get the barcode passed in, or default to the first one in the items list + my $barcode = $params->{'barcode'}; + if ( ! defined $barcode ) { + return unless $self->{'items'}[0]{'itemnumber'}; + $barcode = $self->get_barcode_from_itemnumber( $self->{'items'}[0]{'itemnumber'} ); + } + + # get issuedate from parameters. Default to undef, which will be interpreted as today + my $issuedate = $params->{'issuedate'}; + + my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode ); + + my $datedue = C4::Circulation::AddIssue( + $borrower, # borrower + $barcode, # barcode + undef, # datedue + undef, # cancelreserve + $issuedate # issuedate + ); + + my $issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + + return $issues->{'date_due'}; +} + +=head3 get_barcode_from_itemnumber + +pass in an itemnumber, returns a barcode. + +Should this get moved up to KohaTest.pm? Or, is there a better alternative in C4? + +=cut + +sub get_barcode_from_itemnumber { + my $self = shift; + my $itemnumber = shift; + + my $sql = <dbh() or return; + my $sth = $dbh->prepare($sql) or return; + $sth->execute($itemnumber) or return; + my ($barcode) = $sth->fetchrow_array; + return $barcode; +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Circulation/AddIssue.pm b/t/db_dependent/lib/KohaTest/Circulation/AddIssue.pm new file mode 100644 index 0000000000..2c3e3932ce --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Circulation/AddIssue.pm @@ -0,0 +1,132 @@ +package KohaTest::Circulation::AddIssue; +use base qw(KohaTest::Circulation); + +use strict; +use warnings; + +use Test::More; + +=head2 basic_usage + +basic usage of C4::Circulation::AddIssue + +Note: This logic is repeated in +KohaTest::Circulation::checkout_first_item, but without tests. This +includes tests at each step to make it easier to track down what's +broken as we go along. + +=cut + +sub basic_usage : Test( 13 ) { + my $self = shift; + + my $borrowernumber = $self->{'memberid'}; + ok( $borrowernumber, "we're going to work with borrower: $borrowernumber" ); + + my $borrower = C4::Members::GetMemberDetails( $borrowernumber ); + ok( $borrower, '...and we were able to look up that borrower' ); + is( $borrower->{'borrowernumber'}, $borrowernumber, '...and they have the right borrowernumber' ); + + my $itemnumber = $self->{'items'}[0]{'itemnumber'}; + ok( $itemnumber, "We're going to checkout itemnumber $itemnumber" ); + my $barcode = $self->get_barcode_from_itemnumber($itemnumber); + ok( $barcode, "...which has barcode $barcode" ); + + my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + # Note that we can't check for $before_issues as undef because GetItemIssue always returns a populated hashref + ok( ! defined $before_issues->{'borrowernumber'}, '...and is not currently checked out' ) + or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); + + my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode ); + is( scalar keys %$issuingimpossible, 0, 'the item CanBookBeIssued' ) + or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); + is( scalar keys %$needsconfirmation, 0, '...and the transaction does not needsconfirmation' ) + or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); + + # bug 2758 don't ask for confirmation if patron has $0.00 account balance + # and IssuingInProcess is on + my $orig_issuing_in_process = C4::Context->preference('IssuingInProcess'); + my $dbh = C4::Context->dbh; + $dbh->do("UPDATE systempreferences SET value = 1 WHERE variable = 'IssuingInProcess'"); + C4::Context->clear_syspref_cache(); # FIXME not needed after a syspref mutator is written + ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode ); + is( scalar keys %$issuingimpossible, 0, 'the item CanBookBeIssued with IssuingInProcess ON (bug 2758)' ) + or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); + is( scalar keys %$needsconfirmation, 0, + '...and the transaction does not needsconfirmation with IssuingInProcess ON (bug 2758)' ) + or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); + $dbh->do("UPDATE systempreferences SET value = ? WHERE variable = 'IssuingInProcess'", {}, $orig_issuing_in_process); + C4::Context->clear_syspref_cache(); # FIXME not needed after a syspref mutator is written + + my $datedue = C4::Circulation::AddIssue( $borrower, $barcode ); + ok( $datedue, "the item has been issued and it is due: $datedue" ); + + my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + is( $after_issues->{'borrowernumber'}, $borrowernumber, '...and now it is checked out to our borrower' ) + or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); + + my $loanlength = Date::Calc::Delta_Days( split( /-/, $after_issues->{'issuedate'} ), split( /-/, $after_issues->{'date_due'} ) ); + ok( $loanlength, "the loanlength is $loanlength days" ); + + # save this here since we refer to it in set_issuedate. + $self->{'loanlength'} = $loanlength; + +} + +=head2 set_issuedate + +Make sure that we can set the issuedate of an issue. + +Also, since we are specifying an issuedate and not a due date, the due +date should be calculated from the issuedate, not today. + +=cut + +sub set_issuedate : Test( 7 ) { + my $self = shift; + + my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + ok( ! defined $before_issues->{'borrowernumber'}, 'At this beginning, this item was not checked out.' ) + or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); + + my $issuedate = $self->random_date(); + ok( $issuedate, "Check out an item on $issuedate" ); + my $datedue = $self->checkout_first_item( { issuedate => $issuedate } ); + ok( $datedue, "...and it's due on $datedue" ); + + my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'We found this item checked out to our member.' ) + or diag( Data::Dumper->Dump( [ $after_issues ], [ 'issues' ] ) ); + is( $after_issues->{'issuedate'}, $issuedate, "...and it was issued on $issuedate" ) + or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); + + my $loanlength = Date::Calc::Delta_Days( split( /-/, $after_issues->{'issuedate'} ), split( /-/, $after_issues->{'date_due'} ) ); + ok( $loanlength, "the loanlength is $loanlength days" ); + is( $loanlength, $self->{'loanlength'} ); +} + +sub set_lastreneweddate_on_renewal : Test( 6 ) { + my $self = shift; + + my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + ok( ! defined $before_issues->{'borrowernumber'}, 'At this beginning, this item was not checked out.' ) + or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); + + my $datedue = $self->checkout_first_item( { issuedate => $self->yesterday() } ); + ok( $datedue, "The item is checked out and it's due on $datedue" ); + + my $issuedate = $self->random_date(); + ok( $issuedate, "Check out an item again on $issuedate" ); + # This will actually be a renewal + $datedue = $self->checkout_first_item( { issuedate => $issuedate } ); + ok( $datedue, "...and it's due on $datedue" ); + + my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'We found this item checked out to our member.' ) + or diag( Data::Dumper->Dump( [ $after_issues ], [ 'issues' ] ) ); + is( $after_issues->{'lastreneweddate'}, $issuedate, "...and it was renewed on $issuedate" ) + or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Circulation/GetUpcomingDueIssues.pm b/t/db_dependent/lib/KohaTest/Circulation/GetUpcomingDueIssues.pm new file mode 100644 index 0000000000..95dd1afb9a --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Circulation/GetUpcomingDueIssues.pm @@ -0,0 +1,26 @@ +package KohaTest::Circulation::GetUpcomingDueIssues; +use base qw(KohaTest::Circulation); + +use strict; +use warnings; + +use Test::More; + +=head2 basic_usage + +basic usage of C4::Circulation::GetUpcomingDueIssues() + +=cut + +sub basic_usage : Test(2) { + my $self = shift; + + my $upcoming = C4::Circulation::GetUpcomingDueIssues(); + isa_ok( $upcoming, 'ARRAY' ); + + is( scalar @$upcoming, 0, 'no issues yet' ) + or diag( Data::Dumper->Dump( [$upcoming], ['upcoming'] ) ); +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Circulation/MarkIssueReturned.pm b/t/db_dependent/lib/KohaTest/Circulation/MarkIssueReturned.pm new file mode 100644 index 0000000000..5722bcfe96 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Circulation/MarkIssueReturned.pm @@ -0,0 +1,85 @@ +package KohaTest::Circulation::MarkIssueReturned; +use base qw(KohaTest::Circulation); + +use strict; +use warnings; + +use Test::More; + +=head2 basic_usage + +basic usage of C4::Circulation::MarkIssueReturned + +=cut + +sub basic_usage : Test( 4 ) { + my $self = shift; + + my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + ok( ! defined $before_issues->{'borrowernumber'}, 'our item is not checked out' ) + or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); + + my $datedue = $self->checkout_first_item(); + ok( $datedue, "Now it is checked out and due on $datedue" ); + + my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'Our item is checked out to our borrower' ) + or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); + + C4::Circulation::MarkIssueReturned( $self->{'memberid'}, $self->{'items'}[0]{'itemnumber'} ); + + my $after_return = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + ok( ! defined $after_return->{'borrowernumber'}, 'The item is no longer checked out' ) + or diag( Data::Dumper->Dump( [ $after_return ], [ 'after_return' ] ) ); + +} + +=head2 set_returndate + +check an item out, then, check it back in, specifying the returndate. + +verify that it's checked back in and the returndate is correct. + +=cut + +sub set_retundate : Test( 7 ) { + my $self = shift; + + # It's not checked out to start with + my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + ok( ! defined $before_issues->{'borrowernumber'}, 'our item is not checked out' ) + or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); + + # check it out + my $datedue = $self->checkout_first_item(); + ok( $datedue, "Now it is checked out and due on $datedue" ); + + # verify that it has been checked out + my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'Our item is checked out to our borrower' ) + or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); + + # mark it as returned on some date + my $returndate = $self->random_date(); + ok( $returndate, "return this item on $returndate" ); + + C4::Circulation::MarkIssueReturned( $self->{'memberid'}, + $self->{'items'}[0]{'itemnumber'}, + undef, + $returndate ); + + # validate that it is no longer checked out. + my $after_return = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); + ok( ! defined $after_return->{'borrowernumber'}, 'The item is no longer checked out' ) + or diag( Data::Dumper->Dump( [ $after_return ], [ 'after_return' ] ) ); + + # grab the history for this item and make sure it looks right + my $history = C4::Circulation::GetItemIssues( $self->{'items'}[0]{'itemnumber'}, 1 ); + is( scalar @$history, 1, 'this item has been checked out one time.' ) + or diag( Data::Dumper->Dump( [ $history ], [ 'history' ] ) ); + is( $history->[0]{'returndate'}, $returndate, "...and it was returned on $returndate" ); + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Context.pm b/t/db_dependent/lib/KohaTest/Context.pm new file mode 100644 index 0000000000..bba7f888b7 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Context.pm @@ -0,0 +1,54 @@ +package KohaTest::Context; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Context; +sub testing_class { 'C4::Context' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + AUTOLOAD + boolean_preference + config + dbh + db_scheme2dbi + get_shelves_userenv + get_versions + import + KOHAVERSION + marcfromkohafield + ModZebrations + new + new_dbh + preference + read_config_file + restore_context + restore_dbh + set_context + set_dbh + set_shelves_userenv + set_userenv + stopwords + userenv + Zconn + zebraconfig + _common_config + _new_dbh + _new_marcfromkohafield + _new_stopwords + _new_userenv + _new_Zconn + _unset_userenv + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Context/preference.pm b/t/db_dependent/lib/KohaTest/Context/preference.pm new file mode 100644 index 0000000000..2ad73d1100 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Context/preference.pm @@ -0,0 +1,54 @@ +package KohaTest::Context::preference; +use base qw( KohaTest::Context ); + +use strict; +use warnings; + +use Test::More; + +use C4::Context; +sub testing_class { 'C4::Context' }; + + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head2 TEST METHODS + +standard test methods + +=head3 preference_does_not_exist + +=cut + +sub preference_does_not_exist : Test( 1 ) { + my $self = shift; + + my $missing = C4::Context->preference( 'doesnotexist' ); + + is( $missing, undef, 'a query for a missing syspref returns undef' ) + or diag( Data::Dumper->Dump( [ $missing ], [ 'missing' ] ) ); + +} + + +=head3 version_preference + +=cut + +sub version_preference : Test( 1 ) { + my $self = shift; + + my $version = C4::Context->preference( 'version' ); + + ok( $version, 'C4::Context->preference returns a good version number' ) + or diag( Data::Dumper->Dump( [ $version ], [ 'version' ] ) ); + +} + + + +1; diff --git a/t/db_dependent/lib/KohaTest/Dates.pm b/t/db_dependent/lib/KohaTest/Dates.pm new file mode 100644 index 0000000000..19a309d4a7 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Dates.pm @@ -0,0 +1,37 @@ +package KohaTest::Dates; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Dates; +sub testing_class { 'C4::Dates' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( _prefformat + regexp + dmy_map + _check_date_and_time + _chron_to_ymd + _chron_to_hms + new + init + output + today + _recognize_format + DHTMLcalendar + format + visual + format_date + format_date_in_iso + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Dates/Usage.pm b/t/db_dependent/lib/KohaTest/Dates/Usage.pm new file mode 100644 index 0000000000..8815c89103 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Dates/Usage.pm @@ -0,0 +1,103 @@ +package KohaTest::Dates::Usage; +use base qw( KohaTest::Dates ); + +use strict; +use warnings; + +use Test::More; + +use C4::Dates qw(format_date format_date_in_iso); + + +sub startup_init_constants : Tests(startup => 0) { + my $self = shift; + $self->{thash} = { + iso => [ '2001-01-01', '1989-09-21', '1952-01-00' ], + metric => [ "01-01-2001", '21-09-1989', '00-01-1952' ], + us => [ "01-01-2001", '09-21-1989', '01-00-1952' ], + sql => [ '20010101 010101', '19890921 143907', '19520100 000000' ], + }; + $self->{formats} = [ sort keys %{ $self->{thash} } ]; +} + +sub check_formats : Test( 8 ) { + my $self = shift; + + my $syspref = C4::Dates->new->format(); + ok( $syspref, "Your system preference is: $syspref" ); + + foreach ( @{ $self->{thash}->{'iso'} } ) { + ok( format_date($_), "able to format_date() on $_" ); + } + + foreach ( @{ $self->{thash}->{$syspref} } ) { + ok( format_date_in_iso($_), "able to format_date_in_iso() on $_" ); + } + ok( C4::Dates->today(), "(default) CLASS ->today : " . C4::Dates->today() ); +} + +sub defaults : Test( 24 ) { + my $self = shift; + + foreach (@{ $self->{formats} }) { + my $pre = sprintf '(%-6s)', $_; + my $date = C4::Dates->new(); + ok( $date, "$pre Date Creation : new()" ); + isa_ok( $date, 'C4::Dates' ); + ok( $_ eq $date->format($_), "$pre format($_) : " ); + ok( $date->visual(), "$pre visual()" ); + ok( $date->output(), "$pre output()" ); + ok( $date->today(), "$pre object->today" ); + + } +} + +sub valid_inputs : Test( 108 ) { + my $self = shift; + + foreach my $format (@{ $self->{formats} }) { + my $pre = sprintf '(%-6s)', $format; + foreach my $testval ( @{ $self->{thash}->{$format} } ) { + my ( $val, $today ); + my $date = C4::Dates->new( $testval, $format ); + ok( $date, "$pre Date Creation : new('$testval','$format')" ); + isa_ok( $date, 'C4::Dates' ); + ok( $date->regexp, "$pre has regexp()" ); + ok( $val = $date->output(), describe( "$pre output()", $val ) ); + foreach ( grep { !/$format/ } @{ $self->{formats} } ) { + ok( $today = $date->output($_), describe( sprintf( "$pre output(%8s)", "'$_'" ), $today ) ); + } + ok( $today = $date->today(), describe( "$pre object->today", $today ) ); + ok( $val = $date->output(), describe( "$pre output()", $val ) ); + } + } +} + +sub independence_from_class : Test( 1 ) { + my $self = shift; + + my $in1 = '12/25/1952'; # us + my $in2 = '13/01/2001'; # metric + my $d1 = C4::Dates->new( $in1, 'us' ); + my $d2 = C4::Dates->new( $in2, 'metric' ); + my $out1 = $d1->output('iso'); + my $out2 = $d2->output('iso'); + ok( $out1 ne $out2, "subsequent constructors get different dataspace ($out1 != $out2)" ); + +} + + + +sub describe { + my $front = sprintf( "%-25s", shift ); + my $tail = shift || 'FAILED'; + return "$front : $tail"; +} + +sub shutdown_clear_constants : Tests( shutdown => 0 ) { + my $self = shift; + delete $self->{thash}; + delete $self->{formats}; +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Heading.pm b/t/db_dependent/lib/KohaTest/Heading.pm new file mode 100644 index 0000000000..4f781a2ff7 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Heading.pm @@ -0,0 +1,27 @@ +package KohaTest::Heading; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Heading; +sub testing_class { 'C4::Heading' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new_from_bib_field + display_form + authorities + preferred_authorities + _query_limiters + _marc_format_handler + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Heading/MARC21.pm b/t/db_dependent/lib/KohaTest/Heading/MARC21.pm new file mode 100644 index 0000000000..41cd4d32e7 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Heading/MARC21.pm @@ -0,0 +1,41 @@ +package KohaTest::Heading::MARC21; +use base qw( KohaTest::Heading ); + +use strict; +use warnings; + +use Test::More; + +use C4::Heading; +use C4::Heading::MARC21; + +use MARC::Field; + +sub testing_class { 'C4::Heading::MARC21' }; + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new + valid_bib_heading_tag + parse_heading + _get_subject_thesaurus + _get_search_heading + _get_display_heading + ); + + can_ok( $self->testing_class, @methods ); +} + +sub bug2315 : Test( 1 ) { + + my $subject_heading = MARC::Field->new(650, ' ', '0', + a => "Dalziel, Andrew (Fictitious character", + ')' => "Fiction." + ); + my $display_form = C4::Heading::MARC21::_get_display_heading($subject_heading, 'a'); + is($display_form, "Dalziel, Andrew (Fictitious character", "bug 2315: no crash if heading subfield has metacharacter"); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ImportBatch.pm b/t/db_dependent/lib/KohaTest/ImportBatch.pm new file mode 100644 index 0000000000..a8fefaac9b --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ImportBatch.pm @@ -0,0 +1,130 @@ +package KohaTest::ImportBatch; +use base qw(KohaTest); + +use strict; +use warnings; + +use Test::More; + +use C4::ImportBatch; +use C4::Matcher; +sub testing_class { 'C4::ImportBatch' }; + + +sub routines : Test( 1 ) { + my $self = shift; + my @routines = qw( + GetZ3950BatchId + GetImportRecordMarc + AddImportBatch + GetImportBatch + AddBiblioToBatch + ModBiblioInBatch + BatchStageMarcRecords + AddItemsToImportBiblio + BatchFindBibDuplicates + BatchCommitBibRecords + BatchCommitItems + BatchRevertBibRecords + BatchRevertItems + CleanBatch + GetAllImportBatches + GetImportBatchRangeDesc + GetItemNumbersFromImportBatch + GetNumberOfNonZ3950ImportBatches + GetImportBibliosRange + GetBestRecordMatch + GetImportBatchStatus + SetImportBatchStatus + GetImportBatchOverlayAction + SetImportBatchOverlayAction + GetImportBatchNoMatchAction + SetImportBatchNoMatchAction + GetImportBatchItemAction + SetImportBatchItemAction + GetImportBatchItemAction + SetImportBatchItemAction + GetImportBatchMatcher + SetImportBatchMatcher + GetImportRecordOverlayStatus + SetImportRecordOverlayStatus + GetImportRecordStatus + SetImportRecordStatus + GetImportRecordMatches + SetImportRecordMatches + _create_import_record + _update_import_record_marc + _add_biblio_fields + _update_biblio_fields + _parse_biblio_fields + _update_batch_record_counts + _get_commit_action + _get_revert_action + ); + + can_ok($self->testing_class, @routines); +} + +sub startup_50_add_matcher : Test( startup => 1 ) { + my $self = shift; + # create test MARC21 ISBN matcher + my $matcher = C4::Matcher->new('biblio'); + $matcher->threshold(1000); + $matcher->code('TESTISBN'); + $matcher->description('test MARC21 ISBN matcher'); + $matcher->add_simple_matchpoint('isbn', 1000, '020', 'a', -1, 0, ''); + my $matcher_id = $matcher->store(); + like($matcher_id, qr/^\d+$/, "store new matcher and get back ID"); + + $self->{'matcher_id'} = $matcher_id; +} + +sub shutdown_50_remove_matcher : Test( shutdown => 6) { + my $self = shift; + my @matchers = C4::Matcher::GetMatcherList(); + cmp_ok(scalar(@matchers), ">=", 1, "at least one matcher present"); + my $matcher_id; + my $testisbn_count = 0; + # look for TESTISBN + foreach my $matcher (@matchers) { + if ($matcher->{'code'} eq 'TESTISBN') { + $testisbn_count++; + $matcher_id = $matcher->{'matcher_id'}; + } + } + ok($testisbn_count == 1, "only one TESTISBN matcher"); + like($matcher_id, qr/^\d+$/, "matcher ID is valid"); + my $matcher = C4::Matcher->fetch($matcher_id); + ok(defined($matcher), "got back a matcher"); + ok($matcher_id == $matcher->{'id'}, "got back the correct matcher"); + C4::Matcher->delete($matcher_id); + my $matcher2 = C4::Matcher->fetch($matcher_id); + ok(not(defined($matcher2)), "matcher removed"); + + delete $self->{'matcher_id'}; +} + +=head2 UTILITY METHODS + +=cut + +sub add_import_batch { + my $self = shift; + my $test_batch = shift + || { + overlay_action => 'create_new', + import_status => 'staging', + batch_type => 'batch', + file_name => 'foo', + comments => 'inserted during automated testing', + }; + my $batch_id = AddImportBatch( $test_batch->{'overlay_action'}, + $test_batch->{'import_status'}, + $test_batch->{'batch_type'}, + $test_batch->{'file_name'}, + $test_batch->{'comments'}, ); + return $batch_id; +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm b/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm new file mode 100644 index 0000000000..7b97e72537 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm @@ -0,0 +1,31 @@ +package KohaTest::ImportBatch::AddImportBatch; +use base qw( KohaTest::ImportBatch ); + +use strict; +use warnings; + +use Test::More; + +use C4::ImportBatch; +use C4::Matcher; +use C4::Biblio; + + +=head3 add_one + +=cut + +sub add_one : Test( 1 ) { + my $self = shift; + + my $batch_id = AddImportBatch( + 'create_new', #overlay_action + 'staging', # import_status + 'batch', # batc_type + 'foo', # file_name + 'inserted during automated testing', # comments + ); + ok( $batch_id, "successfully inserted batch: $batch_id" ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/AddItemsToImportBiblio.pm b/t/db_dependent/lib/KohaTest/ImportBatch/AddItemsToImportBiblio.pm new file mode 100644 index 0000000000..39d36df7d6 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ImportBatch/AddItemsToImportBiblio.pm @@ -0,0 +1,29 @@ +package KohaTest::ImportBatch::getImportBatch; +use base qw( KohaTest::ImportBatch ); + +use strict; +use warnings; + +use Test::More; + +use C4::ImportBatch; +use C4::Matcher; +use C4::Biblio; + + +sub something : Test( 2 ) { + my $self = shift; + + my $batch_id = $self->add_import_batch(); + ok( $batch_id, 'we have a batch_id' ); + + my $import_record_id = 0; + + my $marc_record = MARC::Record->new(); + + my @import_item_ids = C4::ImportBatch::AddItemsToImportBiblio( $batch_id, $import_record_id, $marc_record ); + is( scalar( @import_item_ids ), 0, 'none inserted' ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/BatchStageCommitRevert.pm b/t/db_dependent/lib/KohaTest/ImportBatch/BatchStageCommitRevert.pm new file mode 100644 index 0000000000..94f811528c --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ImportBatch/BatchStageCommitRevert.pm @@ -0,0 +1,252 @@ +package KohaTest::ImportBatch::BatchStageCommitRevert; +use base qw( KohaTest::ImportBatch ); + +use strict; +use warnings; + +use Test::More; + +use C4::ImportBatch; +use C4::Matcher; +use C4::Biblio; + +# define test records for various batches +sub startup_60_make_test_records : Test( startup ) { + my $self = shift; + $self->{'batches'} = { + 'batch1' => { + marc => _make_marc_batch([ + ['isbn001', 'title 1', ['batch-item-1'] ], + ['isbn002', 'title 2', [] ], + ['isbn003', 'title 3', ['batch-item-2','batch-item-3'] ], + ['isbn004', 'title 4', [ 'batch-item-4' ] ], + ['isbn005', 'title 5', [ 'batch-item-5', 'batch-item-6', 'batch-item-7' ] ], + ]), + args => { + parse_items => 1, + overlay_action => 'create_new', + nomatch_action => 'create_new', + item_action => 'always_add', + }, + results => { + num_bibs => 5, + num_items => 7, + num_invalid => 0, + num_matches => 0, + num_added => 5, + num_updated => 0, + num_items_added => 7, + num_items_errored => 0, + num_ignored => 0, + }, + }, + 'batch2' => { + marc => _make_marc_batch([ + ['isbn001', 'overlay title 1', ['batch-item-8'] ], + ['isbn002', 'overlay title 2', ['batch-item-9'] ], + ['isbn006', 'title 6', ['batch-item-10'] ], + ]), + args => { + parse_items => 1, + overlay_action => 'replace', + nomatch_action => 'create_new', + item_action => 'always_add', + }, + results => { + num_bibs => 3, + num_items => 3, + num_invalid => 0, + num_matches => 2, + num_added => 1, + num_updated => 2, + num_items_added => 3, + num_items_errored => 0, + num_ignored => 0, + }, + }, + 'batch3' => { + marc => _make_marc_batch([ + ['isbn007', 'title 7', ['batch-item-11'] ], + ['isbn006', 'overlay title 6', ['batch-item-12'] ], + ]), + args => { + parse_items => 1, + overlay_action => 'ignore', + nomatch_action => 'ignore', + item_action => 'always_add', + }, + results => { + num_bibs => 2, + num_items => 2, + num_invalid => 0, + num_matches => 1, + num_added => 0, + num_updated => 0, + num_items_added => 1, + num_items_errored => 0, + num_ignored => 2, + }, + }, + 'batch4' => { + marc => _make_marc_batch([ + ['isbn008', 'title 8', ['batch-item-13'] ], # not loading this item + ]), + args => { + parse_items => 0, + overlay_action => undef, + nomatch_action => 'create_new', + item_action => 'ignore', + }, + results => { + num_bibs => 1, + num_items => 0, + num_invalid => 0, + num_matches => 0, + num_added => 1, + num_updated => 0, + num_items_added => 0, + num_items_errored => 0, + num_ignored => 0, + }, + }, + 'batch5' => { + marc => _make_marc_batch([ + ['isbn009', 'title 9', ['batch-item-1'] ], # trigger dup barcode error + 'junkjunkjunkjunk', # trigger invalid bib + ]), + args => { + parse_items => 1, + overlay_action => undef, + nomatch_action => undef, + item_action => undef, + }, + results => { + num_bibs => 1, + num_items => 1, + num_invalid => 1, + num_matches => 0, + num_added => 1, + num_updated => 0, + num_items_added => 0, + num_items_errored => 1, + num_ignored => 0, + }, + }, + 'batch6' => { + marc => _make_marc_batch([ + ['isbn001', 'match title 1', ['batch-item-14', 'batch-item-15'] ], + ['isbn010', 'title 10', ['batch-item-16', 'batch-item-17'] ], + ]), + args => { + parse_items => 1, + overlay_action => 'ignore', + nomatch_action => 'create_new', + item_action => 'always_add', + }, + results => { + num_bibs => 2, + num_items => 4, + num_invalid => 0, + num_matches => 1, + num_added => 1, + num_updated => 0, + num_items_added => 4, + num_items_errored => 0, + num_ignored => 1, + }, + }, + }; + +} + +sub _make_marc_batch { + my $defs = shift; + my @marc = (); + foreach my $rec (@$defs) { + if (ref($rec) eq 'ARRAY') { + my $isbn = $rec->[0]; + my $title = $rec->[1]; + my $items = $rec->[2]; + my $bib = MARC::Record->new(); + $bib->leader(' nam a22 7a 4500'); + $bib->append_fields(MARC::Field->new('020', ' ', ' ', a => $isbn), + MARC::Field->new('245', ' ', ' ', a => $title)); + foreach my $barcode (@$items) { + my ($itemtag, $toss, $barcodesf, $branchsf); + ($itemtag, $toss) = GetMarcFromKohaField('items.itemnumber', ''); + ($toss, $barcodesf) = GetMarcFromKohaField('items.barcode', ''); + ($toss, $branchsf) = GetMarcFromKohaField('items.homebranch', ''); + $bib->append_fields(MARC::Field->new($itemtag, ' ', ' ', $barcodesf => $barcode, $branchsf => 'CPL')); + # FIXME: define branch in KohaTest + } + push @marc, $bib->as_usmarc(); + } else { + push @marc, $rec; + } + } + return join('', @marc); +} + +sub stage_commit_batches : Test( 75 ) { + my $self = shift; + + my $matcher = C4::Matcher->fetch($self->{'matcher_id'}); + ok(ref($matcher) eq 'C4::Matcher', "retrieved matcher"); + + for my $batch_key (sort keys %{ $self->{'batches'} }) { + my $batch = $self->{'batches'}->{$batch_key}; + my $args = $batch->{'args'}; + my $results = $batch->{'results'}; + my ($batch_id, $num_bibs, $num_items, @invalid) = + BatchStageMarcRecords('MARC21', $batch->{marc}, "$batch_key.mrc", "$batch_key comments", + '', $args->{'parse_items'}, 0); + like($batch_id, qr/^\d+$/, "staged $batch_key"); + cmp_ok($num_bibs, "==", $results->{'num_bibs'}, "$batch_key: correct number of bibs"); + cmp_ok($num_items, "==", $results->{'num_items'}, "$batch_key: correct number of items"); + cmp_ok(scalar(@invalid), "==", $results->{'num_invalid'}, "$batch_key: correct number of invalid bibs"); + + my $num_matches = BatchFindBibDuplicates($batch_id, $matcher, 10); + cmp_ok($num_matches, "==", $results->{'num_matches'}, "$batch_key: correct number of bib matches"); + + if (defined $args->{'overlay_action'}) { + if ($args->{'overlay_action'} eq 'create_new') { + cmp_ok(GetImportBatchOverlayAction($batch_id), "eq", 'create_new', "$batch_key: verify default overlay action"); + } else { + SetImportBatchOverlayAction($batch_id, $args->{'overlay_action'}); + cmp_ok(GetImportBatchOverlayAction($batch_id), "eq", $args->{'overlay_action'}, + "$batch_key: changed overlay action"); + } + } + if (defined $args->{'nomatch_action'}) { + if ($args->{'nomatch_action'} eq 'create_new') { + cmp_ok(GetImportBatchNoMatchAction($batch_id), "eq", 'create_new', "$batch_key: verify default nomatch action"); + } else { + SetImportBatchNoMatchAction($batch_id, $args->{'nomatch_action'}); + cmp_ok(GetImportBatchNoMatchAction($batch_id), "eq", $args->{'nomatch_action'}, + "$batch_key: changed nomatch action"); + } + } + if (defined $args->{'item_action'}) { + if ($args->{'item_action'} eq 'create_new') { + cmp_ok(GetImportBatchItemAction($batch_id), "eq", 'always_add', "$batch_key: verify default item action"); + } else { + SetImportBatchItemAction($batch_id, $args->{'item_action'}); + cmp_ok(GetImportBatchItemAction($batch_id), "eq", $args->{'item_action'}, + "$batch_key: changed item action"); + } + } + + my ($num_added, $num_updated, $num_items_added, + $num_items_errored, $num_ignored) = BatchCommitBibRecords($batch_id); + cmp_ok($num_added, "==", $results->{'num_added'}, "$batch_key: added correct number of bibs"); + cmp_ok($num_updated, "==", $results->{'num_updated'}, "$batch_key: updated correct number of bibs"); + cmp_ok($num_items_added, "==", $results->{'num_items_added'}, "$batch_key: added correct number of items"); + cmp_ok($num_items_errored, "==", $results->{'num_items_errored'}, "$batch_key: correct number of item add errors"); + cmp_ok($num_ignored, "==", $results->{'num_ignored'}, "$batch_key: ignored correct number of bibs"); + + $self->reindex_marc(); + } + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm b/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm new file mode 100644 index 0000000000..0b01707df1 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm @@ -0,0 +1,45 @@ +package KohaTest::ImportBatch::getImportBatch; +use base qw( KohaTest::ImportBatch ); + +use strict; +use warnings; + +use Test::More; + +use C4::ImportBatch; +use C4::Matcher; +use C4::Biblio; + + +=head3 add_one_and_find_it + +=cut + +sub add_one_and_find_it : Test( 7 ) { + my $self = shift; + + my $batch = { + overlay_action => 'create_new', + import_status => 'staging', + batch_type => 'batch', + file_name => 'foo', + comments => 'inserted during automated testing', + }; + my $batch_id = AddImportBatch( + $batch->{'overlay_action'}, + $batch->{'import_status'}, + $batch->{'batch_type'}, + $batch->{'file_name'}, + $batch->{'comments'}, + ); + ok( $batch_id, "successfully inserted batch: $batch_id" ); + + my $retrieved = GetImportBatch( $batch_id ); + + foreach my $key ( keys %$batch ) { + is( $retrieved->{$key}, $batch->{$key}, "both objects agree on $key" ); + } + is( $retrieved->{'import_batch_id'}, $batch_id, 'batch_id' ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportRecordMarc.pm b/t/db_dependent/lib/KohaTest/ImportBatch/GetImportRecordMarc.pm new file mode 100644 index 0000000000..b933b35bec --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ImportBatch/GetImportRecordMarc.pm @@ -0,0 +1,51 @@ +package KohaTest::ImportBatch::GetImportRecordMarc; +use base qw( KohaTest::ImportBatch ); + +use strict; +use warnings; + +use Test::More; + +use C4::ImportBatch; +use C4::Matcher; +use C4::Biblio; + + +=head3 record_does_not_exist + +=cut + +sub record_does_not_exist : Test( 1 ) { + my $self = shift; + + my $id = '999999999999'; + my $marc = GetImportRecordMarc( $id ); + ok( ! defined( $marc ), 'this marc is undefined' ); + +} + +sub record_does_exist : Test( 4 ) { + my $self = shift; + + # we need an import_batch, so let GetZ3950BatchId create one: + my $new_batch_id = GetZ3950BatchId('foo'); + ok( $new_batch_id, "got a new batch ID: $new_batch_id" ); + + my $sth = C4::Context->dbh->prepare( + "INSERT INTO import_records (import_batch_id, marc, marcxml) + VALUES (?, ?, ?)" + ); + my $execute = $sth->execute( + $new_batch_id, # batch_id + 'marc', # marc + 'marcxml', # marcxml + ); + ok( $execute, 'succesfully executed' ); + my $import_record_id = C4::Context->dbh->{'mysql_insertid'}; + ok( $import_record_id, 'we got an import_record_id' ); + + my $marc = GetImportRecordMarc($import_record_id); + ok( defined($marc), 'this marc is defined' ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/GetZ3950BatchId.pm b/t/db_dependent/lib/KohaTest/ImportBatch/GetZ3950BatchId.pm new file mode 100644 index 0000000000..f3f5d9cdb2 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ImportBatch/GetZ3950BatchId.pm @@ -0,0 +1,42 @@ +package KohaTest::ImportBatch::GetZ3950BatchId; +use base qw( KohaTest::ImportBatch ); + +use strict; +use warnings; + +use Test::More; + +use C4::ImportBatch; +use C4::Matcher; +use C4::Biblio; + + +=head3 batch_does_not_exist + +=cut + +sub batch_does_not_exist : Test( 5 ) { + my $self = shift; + + my $file_name = 'testing batch'; + + # lets make sure it doesn't exist first + my $sth = C4::Context->dbh->prepare('SELECT import_batch_id FROM import_batches + WHERE batch_type = ? + AND file_name = ?'); + ok( $sth->execute( 'z3950', $file_name, ), 'execute' ); + my $rowref = $sth->fetchrow_arrayref(); + ok( !defined( $rowref ), 'this batch does not exist' ); + + # now let GetZ3950BatchId create one + my $new_batch_id = GetZ3950BatchId( $file_name ); + ok( $new_batch_id, "got a new batch ID: $new_batch_id" ); + + # now search for the one that was just created + my $second_batch_id = GetZ3950BatchId( $file_name ); + ok( $second_batch_id, "got a second batch ID: $second_batch_id" ); + is( $second_batch_id, $new_batch_id, 'we got the same batch both times.' ); +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Installer.pm b/t/db_dependent/lib/KohaTest/Installer.pm new file mode 100644 index 0000000000..2a0f9f93d8 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Installer.pm @@ -0,0 +1,42 @@ +package KohaTest::Installer; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; +use C4::Languages; +use C4::Installer; + +sub SKIP_CLASS : Expensive { } + +sub testing_class { 'C4::Installer' }; + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new + marcflavour_list + marc_framework_sql_list + sample_data_sql_list + sql_file_list + load_db_schema + load_sql_in_order + set_marcflavour_syspref + set_indexing_engine + set_version_syspref + load_sql + ); + can_ok( $self->testing_class, @methods ); +} + +# ensure that we have a fresh, empty database +# after running through the installer tests +sub shutdown_50_init_db : Tests( shutdown ) { + my $self = shift; + + KohaTest::clear_test_database(); + KohaTest::create_test_database(); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Installer/SqlScripts.pm b/t/db_dependent/lib/KohaTest/Installer/SqlScripts.pm new file mode 100644 index 0000000000..510c574b21 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Installer/SqlScripts.pm @@ -0,0 +1,83 @@ +package KohaTest::Installer::SqlScripts; +use base qw( KohaTest::Installer ); + +use strict; +use warnings; + +use Test::More; +use C4::Languages; +use C4::Installer; + +sub startup_50_get_installer : Test( startup => 1 ) { + my $self = shift; + my $installer = C4::Installer->new(); + is(ref($installer), "C4::Installer", "created installer"); + $self->{installer} = $installer; +} + +sub installer_all_sample_data : Tests { + my $self = shift; + + skip "did not create installer" unless ref($self->{installer}) eq 'C4::Installer'; + + my $all_languages = getAllLanguages(); + # find the available directory names + my $dir=C4::Context->config('intranetdir')."/installer/data/" . + (C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql") . "/"; + opendir (MYDIR,$dir); + my @languages = grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR); + closedir MYDIR; + + cmp_ok(scalar(@languages), '>', 0, "at least one framework language defined"); + + foreach my $lang_code (@languages) { + SKIP: { + my $marc_flavours = $self->{installer}->marcflavour_list($lang_code); + ok(defined($marc_flavours), "at least one MARC flavour for $lang_code"); + skip "no MARC flavours for $lang_code" unless defined($marc_flavours); + + foreach my $flavour (@$marc_flavours) { + SKIP: { + $self->clear_test_database(); + my $schema_error = $self->{installer}->load_db_schema(); + is($schema_error, "", "no errors during schema load"); + skip "error during schema load" if $schema_error ne ""; + + my $list = $self->{installer}->sql_file_list($lang_code, $flavour, { optional => 1, mandatory => 1 }); + my $sql_count = scalar(@$list); + cmp_ok($sql_count, '>', 0, "at least one SQL init file for $lang_code, $flavour"); + skip "no SQL init files defined for $lang_code, $flavour" unless $sql_count > 0; + + my ($fwk_language, $installed_list) = $self->{installer}->load_sql_in_order($all_languages, @$list); + + # extract list of files + my $level; + my @file_list = map { + map { $_->{level} = $level; $_ } @{ $level = $_->{level}; $_->{fwklist} } + } @$installed_list; + my $num_processed = scalar(@file_list); + cmp_ok($num_processed, '==', $sql_count, "processed all sql scripts for $lang_code, $flavour"); + + my %sql_to_load = map { my $file = $_; + my @file = split qr(\/|\\), $file; + join("\t", $file[-2], $file[-1]) => 1 + } @$list; + foreach my $sql (@file_list) { + ok(exists($sql_to_load{ "$sql->{level}\t$sql->{fwkname}" }), + "SQL script $sql->{level}/$sql->{fwkname} is on list"); + delete $sql_to_load{ "$sql->{level}\t$sql->{fwkname}" }; + is($sql->{error}, "", "no errors when loading $sql->{fwkname}"); + } + ok(not(%sql_to_load), "no SQL scripts for $lang_code, $flavour left unloaded"); + } + } + } + } +} + +sub shutdown_50_clear_installer : Tests( shutdown ) { + my $self = shift; + delete $self->{installer}; +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Installer/get_file_path_from_name.pm b/t/db_dependent/lib/KohaTest/Installer/get_file_path_from_name.pm new file mode 100644 index 0000000000..40962a7209 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Installer/get_file_path_from_name.pm @@ -0,0 +1,36 @@ +package KohaTest::Installer::get_file_path_from_name; +use base qw( KohaTest::Installer ); + +use strict; +use warnings; + +use Test::More; +use C4::Languages; +use C4::Installer; + +sub startup_50_get_installer : Test( startup => 1 ) { + my $self = shift; + my $installer = C4::Installer->new(); + is(ref($installer), "C4::Installer", "created installer"); + $self->{installer} = $installer; +} + +sub search_for_known_scripts : Tests( 2 ) { + my $self = shift; + + skip "did not create installer" unless ref($self->{installer}) eq 'C4::Installer'; + + foreach my $script ( 'installer/data/mysql/en/mandatory/message_transport_types.sql', + 'installer/data/mysql/en/optional/sample_notices_message_attributes.sql', ) { + + ok( $self->{'installer'}->get_file_path_from_name( $script ), "found $script" ); + } + +} + +sub shutdown_50_clear_installer : Tests( shutdown ) { + my $self = shift; + delete $self->{installer}; +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ItemCirculationAlertPreference.pm b/t/db_dependent/lib/KohaTest/ItemCirculationAlertPreference.pm new file mode 100644 index 0000000000..3094b335a5 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ItemCirculationAlertPreference.pm @@ -0,0 +1,27 @@ +package KohaTest::ItemCirculationAlertPreference; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::ItemCirculationAlertPreference; +sub testing_class { 'C4::ItemCirculationAlertPreference' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new + create + delete + is_enabled_for + find + grid + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/ItemType.pm b/t/db_dependent/lib/KohaTest/ItemType.pm new file mode 100644 index 0000000000..2474ce3298 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/ItemType.pm @@ -0,0 +1,23 @@ +package KohaTest::ItemType; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::ItemType; +sub testing_class { 'C4::ItemType' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new + all + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Items.pm b/t/db_dependent/lib/KohaTest/Items.pm new file mode 100644 index 0000000000..7dcd9ab9ef --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Items.pm @@ -0,0 +1,60 @@ +package KohaTest::Items; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Items; +sub testing_class { 'C4::Items' } + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + + GetItem + AddItemFromMarc + AddItem + AddItemBatchFromMarc + ModItemFromMarc + ModItem + ModItemTransfer + ModDateLastSeen + DelItem + CheckItemPreSave + GetItemStatus + GetItemLocation + GetLostItems + GetItemsForInventory + GetItemsCount + GetItemInfosOf + GetItemsByBiblioitemnumber + GetItemsInfo + get_itemnumbers_of + GetItemnumberFromBarcode + get_item_authorised_values + get_authorised_value_images + GetMarcItem + _set_derived_columns_for_add + _set_derived_columns_for_mod + _do_column_fixes_for_mod + _get_single_item_column + _calc_items_cn_sort + _set_defaults_for_add + _koha_new_item + _koha_modify_item + _koha_delete_item + _marc_from_item_hash + _add_item_field_to_biblio + _replace_item_field_in_biblio + _repack_item_errors + _get_unlinked_item_subfields + _get_unlinked_subfields_xml + _parse_unlinked_item_subfields_from_xml + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Items/ColumnFixes.pm b/t/db_dependent/lib/KohaTest/Items/ColumnFixes.pm new file mode 100644 index 0000000000..aca4f73425 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Items/ColumnFixes.pm @@ -0,0 +1,77 @@ +package KohaTest::Items::ColumnFixes; +use base qw( KohaTest::Items ); + +use strict; +use warnings; + +use Test::More; + +use C4::Items; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head2 TEST METHODS + +standard test methods + +=head3 not_defined + + +=cut + +sub not_defined : Test( 4 ) { + + my $item_mod_fixes_1 = { + notforloan => undef, + damaged => undef, + wthdrawn => undef, + itemlost => undef, + }; + + C4::Items::_do_column_fixes_for_mod($item_mod_fixes_1); + is( $item_mod_fixes_1->{'notforloan'}, 0, 'null notforloan fixed during mod' ); + is( $item_mod_fixes_1->{'damaged'}, 0, 'null damaged fixed during mod' ); + is( $item_mod_fixes_1->{'wthdrawn'}, 0, 'null wthdrawn fixed during mod' ); + is( $item_mod_fixes_1->{'itemlost'}, 0, 'null itemlost fixed during mod' ); + +} + +sub empty : Test( 4 ) { + + my $item_mod_fixes_2 = { + notforloan => '', + damaged => '', + wthdrawn => '', + itemlost => '', + }; + + C4::Items::_do_column_fixes_for_mod($item_mod_fixes_2); + is( $item_mod_fixes_2->{'notforloan'}, 0, 'empty notforloan fixed during mod' ); + is( $item_mod_fixes_2->{'damaged'}, 0, 'empty damaged fixed during mod' ); + is( $item_mod_fixes_2->{'wthdrawn'}, 0, 'empty wthdrawn fixed during mod' ); + is( $item_mod_fixes_2->{'itemlost'}, 0, 'empty itemlost fixed during mod' ); + +} + +sub not_clobbered : Test( 4 ) { + + my $item_mod_fixes_3 = { + notforloan => 1, + damaged => 2, + wthdrawn => 3, + itemlost => 4, + }; + + C4::Items::_do_column_fixes_for_mod($item_mod_fixes_3); + is( $item_mod_fixes_3->{'notforloan'}, 1, 'do not clobber notforloan during mod' ); + is( $item_mod_fixes_3->{'damaged'}, 2, 'do not clobber damaged during mod' ); + is( $item_mod_fixes_3->{'wthdrawn'}, 3, 'do not clobber wthdrawn during mod' ); + is( $item_mod_fixes_3->{'itemlost'}, 4, 'do not clobber itemlost during mod' ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Items/GetItemsForInventory.pm b/t/db_dependent/lib/KohaTest/Items/GetItemsForInventory.pm new file mode 100644 index 0000000000..a56057ec23 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Items/GetItemsForInventory.pm @@ -0,0 +1,123 @@ +package KohaTest::Items::GetItemsForInventory; +use base qw( KohaTest::Items ); + +use strict; +use warnings; + +use Test::More; + +use C4::Items; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head2 startup_90_add_item_get_callnumber + +=cut + +sub startup_90_add_item_get_callnumber : Test( startup => 13 ) { + my $self = shift; + + $self->add_biblios( add_items => 1 ); + + ok( $self->{'items'}, 'An item has been aded' ) + or diag( Data::Dumper->Dump( [ $self->{'items'} ], ['items'] ) ); + + my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $self->{'items'}[0]{'biblionumber'} ); + ok( $biblioitems[0]->{'biblioitemnumber'}, '...and it has a biblioitemnumber' ) + or diag( Data::Dumper->Dump( [ \@biblioitems ], ['biblioitems'] ) ); + + my $items_info = GetItemsByBiblioitemnumber( $biblioitems[0]->{'biblioitemnumber'} ); + isa_ok( $items_info, 'ARRAY', '...and we can search with that biblioitemnumber' ) + or diag( Data::Dumper->Dump( [$items_info], ['items_info'] ) ); + cmp_ok( scalar @$items_info, '>', 0, '...and we can find at least one item with that biblioitemnumber' ); + + my $item_info = $items_info->[0]; + ok( $item_info->{'itemcallnumber'}, '...and the item we found has a call number: ' . $item_info->{'itemcallnumber'} ) + or diag( Data::Dumper->Dump( [$item_info], ['item_info'] ) ); + + $self->{'callnumber'} = $item_info->{'itemcallnumber'}; +} + + +=head2 TEST METHODS + +standard test methods + +=head3 missing_parameters + +the minlocation and maxlocation parameters are required. If they are +not provided, this method should somehow complain, such as returning +undef or emitina warning or something. + +=cut + +sub missing_parameters : Test( 1 ) { + my $self = shift; + local $TODO = 'GetItemsForInventory should fail when missing required parameters'; + + my $items = C4::Items::GetItemsForInventory(); + ok( ! defined $items, 'GetItemsForInventory fails when parameters are missing' ) + or diag( Data::Dumper->Dump( [ $items ], [ 'items' ] ) ); +} + +=head3 basic_usage + + +=cut + +sub basic_usage : Test( 4 ) { + my $self = shift; + + ok( $self->{'callnumber'}, 'we have a call number to search for: ' . $self->{'callnumber'} ); + my $items = C4::Items::GetItemsForInventory( $self->{'callnumber'}, $self->{'callnumber'} ); + isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' ); + is( scalar @$items, 1, '...and we found only one item' ); + my $our_item = $items->[0]; + is( $our_item->{'itemnumber'}, $self->{'items'}[0]{'itemnumber'}, '...and the item we found has the right itemnumber' ); + + # diag( Data::Dumper->Dump( [$items], ['items'] ) ); +} + +=head3 date_last_seen + + +=cut + +sub date_last_seen : Test( 6 ) { + my $self = shift; + + ok( $self->{'callnumber'}, 'we have a call number to search for: ' . $self->{'callnumber'} ); + + my $items = C4::Items::GetItemsForInventory( + $self->{'callnumber'}, # minlocation + $self->{'callnumber'}, # maxlocation + undef, # location + undef, # itemtype + C4::Dates->new( $self->tomorrow(), 'iso' )->output, # datelastseen + ); + + isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' ); + is( scalar @$items, 1, '...and we found only one item' ); + my $our_item = $items->[0]; + is( $our_item->{'itemnumber'}, $self->{'items'}[0]{'itemnumber'}, '...and the item we found has the right itemnumber' ); + + # give a datelastseen of yesterday, and we should not get our item. + $items = C4::Items::GetItemsForInventory( + $self->{'callnumber'}, # minlocation + $self->{'callnumber'}, # maxlocation + undef, # location + undef, # itemtype + C4::Dates->new( $self->yesterday(), 'iso' )->output, # datelastseen + ); + + isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' ); + is( scalar @$items, 0, '...and we found no items' ); + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Items/ModItemsFromMarc.pm b/t/db_dependent/lib/KohaTest/Items/ModItemsFromMarc.pm new file mode 100644 index 0000000000..d0522ee6cb --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Items/ModItemsFromMarc.pm @@ -0,0 +1,91 @@ +package KohaTest::Items::ModItemsFromMarc; +use base qw( KohaTest::Items ); + +use strict; +use warnings; + +use Test::More; + +use C4::Context; +use C4::Biblio; +use C4::Items; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head2 startup_90_add_item_get_callnumber + +=cut + +sub startup_90_add_item_get_callnumber : Test( startup => 13 ) { + my $self = shift; + + $self->add_biblios( count => 1, add_items => 1 ); + + ok( $self->{'items'}, 'An item has been aded' ) + or diag( Data::Dumper->Dump( [ $self->{'items'} ], ['items'] ) ); + + my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $self->{'items'}[0]{'biblionumber'} ); + ok( $biblioitems[0]->{'biblioitemnumber'}, '...and it has a biblioitemnumber' ) + or diag( Data::Dumper->Dump( [ \@biblioitems ], ['biblioitems'] ) ); + + my $items_info = GetItemsByBiblioitemnumber( $biblioitems[0]->{'biblioitemnumber'} ); + isa_ok( $items_info, 'ARRAY', '...and we can search with that biblioitemnumber' ) + or diag( Data::Dumper->Dump( [$items_info], ['items_info'] ) ); + cmp_ok( scalar @$items_info, '>', 0, '...and we can find at least one item with that biblioitemnumber' ); + + my $item_info = $items_info->[0]; + ok( $item_info->{'itemcallnumber'}, '...and the item we found has a call number: ' . $item_info->{'itemcallnumber'} ) + or diag( Data::Dumper->Dump( [$item_info], ['item_info'] ) ); + + $self->{itemnumber} = $item_info->{itemnumber}; +} + + +=head2 TEST METHODS + +standard test methods + +=head3 bug2466 + +Regression test for bug 2466 (when clearing an item field +via the cataloging or serials item editor, corresponding +column is not cleared). + +=cut + +sub bug2466 : Test( 8 ) { + my $self = shift; + + my $item = C4::Items::GetItem($self->{itemnumber}); + isa_ok($item, 'HASH', "item $self->{itemnumber} exists"); + + my $item_marc = C4::Items::GetMarcItem($item->{biblionumber}, $self->{itemnumber}); + isa_ok($item_marc, 'MARC::Record', "retrieved item MARC"); + + cmp_ok($item->{itemcallnumber}, 'ne', '', "item call number is not blank"); + + my ($callnum_tag, $callnum_subfield) = C4::Biblio::GetMarcFromKohaField('items.itemcallnumber', ''); + cmp_ok($callnum_tag, '>', 0, "found tag for itemcallnumber"); + + my $item_field = $item_marc->field($callnum_tag); + ok(defined($item_field), "retrieved MARC field for item"); + + $item_field->delete_subfield(code => $callnum_subfield); + + my $dbh = C4::Context->dbh; + my $item_from_marc = C4::Biblio::TransformMarcToKoha($dbh, $item_marc, '', 'items'); + ok(not(exists($item_from_marc->{itemcallnumber})), "itemcallnumber subfield removed"); + + C4::Items::ModItemFromMarc($item_marc, $item->{biblionumber}, $self->{itemnumber}); + + my $modified_item = C4::Items::GetItem($self->{itemnumber}); + isa_ok($modified_item, 'HASH', "retrieved modified item"); + + ok(not(defined($modified_item->{itemcallnumber})), "itemcallnumber is now undef"); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Items/SetDefaults.pm b/t/db_dependent/lib/KohaTest/Items/SetDefaults.pm new file mode 100644 index 0000000000..fd622a7402 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Items/SetDefaults.pm @@ -0,0 +1,86 @@ +package KohaTest::Items::SetDefaults; +use base qw( KohaTest::Items ); + +use strict; +use warnings; + +use Test::More; + +use C4::Items; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head2 TEST METHODS + +standard test methods + +=head3 + + +=cut + +sub add_some_items : Test( 3 ) { + + my $item_to_add_1 = { itemnotes => 'newitem', }; + + C4::Items::_set_defaults_for_add($item_to_add_1); + ok( exists $item_to_add_1->{'dateaccessioned'}, 'dateaccessioned added to new item' ); + like( $item_to_add_1->{'dateaccessioned'}, qr/^\d\d\d\d-\d\d-\d\d$/, 'new dateaccessioned is dddd-dd-dd' ); + is( $item_to_add_1->{'itemnotes'}, 'newitem', 'itemnotes not clobbered' ); + +} + +sub undefined : Test( 4 ) { + my $item_add_fixes_1 = { + notforloan => undef, + damaged => undef, + wthdrawn => undef, + itemlost => undef, + }; + + C4::Items::_set_defaults_for_add($item_add_fixes_1); + is( $item_add_fixes_1->{'notforloan'}, 0, 'null notforloan fixed during add' ); + is( $item_add_fixes_1->{'damaged'}, 0, 'null damaged fixed during add' ); + is( $item_add_fixes_1->{'wthdrawn'}, 0, 'null wthdrawn fixed during add' ); + is( $item_add_fixes_1->{'itemlost'}, 0, 'null itemlost fixed during add' ); +} + +sub empty_gets_fixed : Test( 4 ) { + + my $item_add_fixes_2 = { + notforloan => '', + damaged => '', + wthdrawn => '', + itemlost => '', + }; + + C4::Items::_set_defaults_for_add($item_add_fixes_2); + is( $item_add_fixes_2->{'notforloan'}, 0, 'empty notforloan fixed during add' ); + is( $item_add_fixes_2->{'damaged'}, 0, 'empty damaged fixed during add' ); + is( $item_add_fixes_2->{'wthdrawn'}, 0, 'empty wthdrawn fixed during add' ); + is( $item_add_fixes_2->{'itemlost'}, 0, 'empty itemlost fixed during add' ); + +} + +sub do_not_clobber : Test( 4 ) { + + my $item_add_fixes_3 = { + notforloan => 1, + damaged => 2, + wthdrawn => 3, + itemlost => 4, + }; + + C4::Items::_set_defaults_for_add($item_add_fixes_3); + is( $item_add_fixes_3->{'notforloan'}, 1, 'do not clobber notforloan during mod' ); + is( $item_add_fixes_3->{'damaged'}, 2, 'do not clobber damaged during mod' ); + is( $item_add_fixes_3->{'wthdrawn'}, 3, 'do not clobber wthdrawn during mod' ); + is( $item_add_fixes_3->{'itemlost'}, 4, 'do not clobber itemlost during mod' ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Koha.pm b/t/db_dependent/lib/KohaTest/Koha.pm new file mode 100644 index 0000000000..13a145a10c --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Koha.pm @@ -0,0 +1,49 @@ +package KohaTest::Koha; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Koha; +sub testing_class { 'C4::Koha' } + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( slashifyDate + DisplayISBN + subfield_is_koha_internal_p + GetItemTypes + get_itemtypeinfos_of + GetCcodes + getauthtypes + getauthtype + getframeworks + getframeworkinfo + getitemtypeinfo + getitemtypeimagedir + getitemtypeimagesrc + getitemtypeimagelocation + _getImagesFromDirectory + _getSubdirectoryNames + getImageSets + GetPrinters + GetPrinter + getnbpages + getallthemes + getFacets + get_infos_of + get_notforloan_label_of + displayServers + GetAuthValCode + GetAuthorisedValues + GetAuthorisedValueCategories + GetKohaAuthorisedValues + display_marc_indicators + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Koha/displayServers.pm b/t/db_dependent/lib/KohaTest/Koha/displayServers.pm new file mode 100644 index 0000000000..7794268e99 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Koha/displayServers.pm @@ -0,0 +1,192 @@ +package KohaTest::Koha::displayServers; +use base qw( KohaTest::Koha ); + +use strict; +use warnings; + +use Test::More; + +use C4::Koha; + +=head2 basic_usage + +call displayServers with no parameters and investigate the things that +it returns. This depends on there being at least one server defined, +as do some other tests in this module. + +=cut + +sub basic_usage : Test( 12 ) { + my $self = shift; + + my $servers = C4::Koha::displayServers(); + isa_ok( $servers, 'ARRAY' ); + my $firstserver = $servers->[0]; + isa_ok( $firstserver, 'HASH' ); + + my @keys = qw( opensearch icon value name checked zed label id encoding ); + is( scalar keys %$firstserver, scalar @keys, 'the hash has the right number of keys' ); + foreach my $key ( @keys ) { + ok( exists $firstserver->{$key}, "There is a $key key" ); + } + + # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); +} + +=head2 position_does_not_exist + +call displayServers with a position that does not exist and make sure +that we get none back. + +=cut + +sub position_does_not_exist : Test( 2 ) { + my $self = shift; + + my $servers = C4::Koha::displayServers( 'this does not exist' ); + isa_ok( $servers, 'ARRAY' ); + is( scalar @$servers, 0, 'received no servers' ); + + # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); +} + +=head2 position_does_exist + +call displayServers with a position that does exist and make sure that +we get at least one back. + +=cut + +sub position_does_exist : Test( 3 ) { + my $self = shift; + + my $position = $self->_get_a_position(); + ok( $position, 'We have a position that exists' ); + + my $servers = C4::Koha::displayServers( $position ); + isa_ok( $servers, 'ARRAY' ); + ok( scalar @$servers, 'received at least one server' ); + + # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); +} + +=head2 type_does_not_exist + +call displayServers with a type that does not exist and make sure +that we get none back. + +=cut + +sub type_does_not_exist : Test( 2 ) { + my $self = shift; + + my $servers = C4::Koha::displayServers( undef, 'this does not exist' ); + isa_ok( $servers, 'ARRAY' ); + is( scalar @$servers, 0, 'received no servers' ); + + # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); +} + +=head2 type_does_exist + +call displayServers with a type that does exist and make sure +that we get at least one back. + +=cut + +sub type_does_exist : Test( 3 ) { + my $self = shift; + + my $type = $self->_get_a_type(); + ok( $type, 'We have a type that exists' ); + + my $servers = C4::Koha::displayServers( undef, $type ); + isa_ok( $servers, 'ARRAY' ); + ok( scalar @$servers, 'received at least one server' ); + + # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); +} + +=head2 position_and_type + +call displayServers with a variety of both positions and types and +verify that we get either something or nothing back. + + +=cut + +sub position_and_type : Test( 8 ) { + my $self = shift; + + my ( $position, $type ) = $self->_get_a_position_and_type(); + ok( $position, 'We have a type that exists' ); + ok( $type, 'We have a type that exists' ); + + my $servers = C4::Koha::displayServers( $position, 'type does not exist' ); + isa_ok( $servers, 'ARRAY' ); + is( scalar @$servers, 0, 'received no servers' ); + + $servers = C4::Koha::displayServers( 'position does not exist', $type ); + isa_ok( $servers, 'ARRAY' ); + is( scalar @$servers, 0, 'received no servers' ); + + $servers = C4::Koha::displayServers( $position, $type ); + isa_ok( $servers, 'ARRAY' ); + ok( scalar @$servers, 'received at least one server' ); + + # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); +} + +=head1 INTERNAL METHODS + +these are not test methods, but they help me write them. + +=head2 _get_a_position + +returns a position value for which at least one server exists + +=cut + +sub _get_a_position { + my $self = shift; + + my ( $position, $type ) = $self->_get_a_position_and_type(); + return $position; + +} + +=head2 _get_a_type + +returns a type value for which at least one server exists + +=cut + +sub _get_a_type { + my $self = shift; + + my ( $position, $type ) = $self->_get_a_position_and_type(); + return $type; + +} + +=head2 _get_a_position_and_type + +returns a position and type for a server + +=cut + +sub _get_a_position_and_type { + my $self = shift; + + my $dbh = C4::Context->dbh; + my $sql = 'SELECT position, type FROM z3950servers'; + my $sth = $dbh->prepare($sql) or return; + $sth->execute or return; + + my @row = $sth->fetchrow_array; + return ( $row[0], $row[1] ); + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Koha/get_itemtypeinfos_of.pm b/t/db_dependent/lib/KohaTest/Koha/get_itemtypeinfos_of.pm new file mode 100644 index 0000000000..9845e90576 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Koha/get_itemtypeinfos_of.pm @@ -0,0 +1,59 @@ +package KohaTest::Koha::get_itemtypeinfos_of; +use base qw( KohaTest::Koha ); + +use strict; +use warnings; + +use Test::More; + +use C4::Koha; + +=head2 get_one + +calls get_itemtypeinfos_of on one item type and checks that it gets +back something sane. + +=cut + +sub get_one : Test( 8 ) { + my $self = shift; + + my $itemtype_info = C4::Koha::get_itemtypeinfos_of( 'BK' ); + ok( $itemtype_info, 'we got back something from get_itemtypeinfos_of' ); + isa_ok( $itemtype_info, 'HASH', '...and it' ); + ok( exists $itemtype_info->{'BK'}, '...and it has a BK key' ) + or diag( Data::Dumper->Dump( [ $itemtype_info ], [ 'itemtype_info' ] ) ); + is( scalar keys %$itemtype_info, 1, '...and it has 1 key' ); + foreach my $key ( qw( imageurl itemtype notforloan description ) ) { + ok( exists $itemtype_info->{'BK'}{$key}, "...and the BK info has a $key key" ); + } + +} + +=head2 get_two + +calls get_itemtypeinfos_of on a list of item types and verifies the +results. + +=cut + +sub get_two : Test( 13 ) { + my $self = shift; + + my @itemtypes = qw( BK MU ); + my $itemtype_info = C4::Koha::get_itemtypeinfos_of( @itemtypes ); + ok( $itemtype_info, 'we got back something from get_itemtypeinfos_of' ); + isa_ok( $itemtype_info, 'HASH', '...and it' ); + is( scalar keys %$itemtype_info, scalar @itemtypes, '...and it has ' . scalar @itemtypes . ' keys' ); + foreach my $it ( @itemtypes ) { + ok( exists $itemtype_info->{$it}, "...and it has a $it key" ) + or diag( Data::Dumper->Dump( [ $itemtype_info ], [ 'itemtype_info' ] ) ); + foreach my $key ( qw( imageurl itemtype notforloan description ) ) { + ok( exists $itemtype_info->{$it}{$key}, "...and the $it info has a $key key" ); + } + } + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Koha/getitemtypeimagedir.pm b/t/db_dependent/lib/KohaTest/Koha/getitemtypeimagedir.pm new file mode 100644 index 0000000000..ea8b034a39 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Koha/getitemtypeimagedir.pm @@ -0,0 +1,27 @@ +package KohaTest::Koha::getitemtypeimagedir; +use base qw( KohaTest::Koha ); + +use strict; +use warnings; + +use Test::More; + +use C4::Koha; + +sub check_default : Test( 5 ) { + my $self = shift; + + my $opac_directory = C4::Koha::getitemtypeimagedir('opac'); + my $default_directory = C4::Koha::getitemtypeimagedir('opac'); + my $intranet_directory = C4::Koha::getitemtypeimagedir('intranet'); + + ok( $opac_directory, 'the opac directory is defined' ); + ok( $default_directory, 'the default directory is defined' ); + ok( $intranet_directory, 'the intranet directory is defined' ); + + is( $opac_directory, $default_directory, 'the opac directory is returned as the default' ); + isnt( $intranet_directory, $default_directory, 'the intranet directory is not the same as the default' ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Letters.pm b/t/db_dependent/lib/KohaTest/Letters.pm new file mode 100644 index 0000000000..97d58fbed7 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Letters.pm @@ -0,0 +1,28 @@ +package KohaTest::Letters; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Members; +sub testing_class { 'C4::Letters' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( getletter + addalert + delalert + getalert + findrelatedto + SendAlerts + parseletter + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Letters/GetLetter.pm b/t/db_dependent/lib/KohaTest/Letters/GetLetter.pm new file mode 100644 index 0000000000..76b6ab4e81 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Letters/GetLetter.pm @@ -0,0 +1,33 @@ +package KohaTest::Letters::GetLetter; +use base qw( KohaTest::Letters ); + +use strict; +use warnings; + +use C4::Letters; +use Test::More; + +sub GetLetter : Test( 6 ) { + my $self = shift; + + my $letter = getletter( 'circulation', 'ODUE' ); + + isa_ok( $letter, 'HASH' ) + or diag( Data::Dumper->Dump( [ $letter ], [ 'letter' ] ) ); + + is( $letter->{'code'}, 'ODUE', 'code' ); + is( $letter->{'module'}, 'circulation', 'module' ); + ok( exists $letter->{'content'}, 'content' ); + ok( exists $letter->{'name'}, 'name' ); + ok( exists $letter->{'title'}, 'title' ); + + +} + +1; + + + + + + diff --git a/t/db_dependent/lib/KohaTest/Letters/GetLetters.pm b/t/db_dependent/lib/KohaTest/Letters/GetLetters.pm new file mode 100644 index 0000000000..576b3bf4c2 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Letters/GetLetters.pm @@ -0,0 +1,30 @@ +package KohaTest::Letters::GetLetters; +use base qw( KohaTest::Letters ); + +use strict; +use warnings; + +use C4::Letters; +use Test::More; + +sub GetDefaultLetters : Test( 2 ) { + my $self = shift; + + my $letters = GetLetters(); + + # the default install includes several entries in the letter table. + isa_ok( $letters, 'HASH' ) + or diag( Data::Dumper->Dump( [ $letters ], [ 'letters' ] ) ); + + ok( scalar keys( %$letters ) > 0, 'we got some letters' ); + + +} + +1; + + + + + + diff --git a/t/db_dependent/lib/KohaTest/Log.pm b/t/db_dependent/lib/KohaTest/Log.pm new file mode 100644 index 0000000000..dc7b26eef4 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Log.pm @@ -0,0 +1,25 @@ +package KohaTest::Log; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Log; +sub testing_class { 'C4::Log' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( logaction + GetLogStatus + displaylog + GetLogs + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Members.pm b/t/db_dependent/lib/KohaTest/Members.pm new file mode 100644 index 0000000000..ff18869bc9 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Members.pm @@ -0,0 +1,61 @@ +package KohaTest::Members; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Members; +sub testing_class { 'C4::Members' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( SearchMember + GetMemberDetails + patronflags + GetMember + GetMemberIssuesAndFines + ModMember + AddMember + Check_Userid + changepassword + fixup_cardnumber + GetGuarantees + UpdateGuarantees + GetPendingIssues + GetAllIssues + GetMemberAccountRecords + GetBorNotifyAcctRecord + checkuniquemember + checkcardnumber + getzipnamecity + getidcity + GetExpiryDate + checkuserpassword + GetborCatFromCatType + GetBorrowercategory + ethnicitycategories + fixEthnicity + GetAge + get_institutions + add_member_orgs + MoveMemberToDeleted + DelMember + ExtendMemberSubscriptionTo + GetTitles + GetPatronImage + PutPatronImage + RmPatronImage + GetBorrowersWhoHaveNotBorrowedSince + GetBorrowersWhoHaveNeverBorrowed + GetBorrowersWithIssuesHistoryOlderThan + GetBorrowersNamesAndLatestIssue + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Members/AttributeTypes.pm b/t/db_dependent/lib/KohaTest/Members/AttributeTypes.pm new file mode 100644 index 0000000000..652526705e --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Members/AttributeTypes.pm @@ -0,0 +1,119 @@ +package KohaTest::Members::AttributeTypes; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Members::AttributeTypes; +sub testing_class { 'C4::Members::AttributeTypes' }; + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new + fetch + GetAttributeTypes + code + description + repeatable + unique_id + opac_display + password_allowed + staff_searchable + authorised_value_category + store + delete + ); + + can_ok( $self->testing_class, @methods ); +} + +sub startup_50_create_types : Test( startup => 28 ) { + my $self = shift; + + my $type1 = C4::Members::AttributeTypes->new('CAMPUSID', 'institution ID'); + isa_ok($type1, 'C4::Members::AttributeTypes'); + is($type1->code(), 'CAMPUSID', "set code in constructor"); + is($type1->description(), 'institution ID', "set description in constructor"); + ok(!$type1->repeatable(), "repeatable defaults to false"); + ok(!$type1->unique_id(), "unique_id defaults to false"); + ok(!$type1->opac_display(), "opac_display defaults to false"); + ok(!$type1->password_allowed(), "password_allowed defaults to false"); + ok(!$type1->staff_searchable(), "staff_searchable defaults to false"); + is($type1->authorised_value_category(), '', "authorised_value_category defaults to ''"); + + $type1->repeatable('foobar'); + ok($type1->repeatable(), "repeatable now true"); + cmp_ok($type1->repeatable(), '==', 1, "repeatable not set to 'foobar'"); + $type1->repeatable(0); + ok(!$type1->repeatable(), "repeatable now false"); + + $type1->unique_id('foobar'); + ok($type1->unique_id(), "unique_id now true"); + cmp_ok($type1->unique_id(), '==', 1, "unique_id not set to 'foobar'"); + $type1->unique_id(0); + ok(!$type1->unique_id(), "unique_id now false"); + + $type1->opac_display('foobar'); + ok($type1->opac_display(), "opac_display now true"); + cmp_ok($type1->opac_display(), '==', 1, "opac_display not set to 'foobar'"); + $type1->opac_display(0); + ok(!$type1->opac_display(), "opac_display now false"); + + $type1->password_allowed('foobar'); + ok($type1->password_allowed(), "password_allowed now true"); + cmp_ok($type1->password_allowed(), '==', 1, "password_allowed not set to 'foobar'"); + $type1->password_allowed(0); + ok(!$type1->password_allowed(), "password_allowed now false"); + + $type1->staff_searchable('foobar'); + ok($type1->staff_searchable(), "staff_searchable now true"); + cmp_ok($type1->staff_searchable(), '==', 1, "staff_searchable not set to 'foobar'"); + $type1->staff_searchable(0); + ok(!$type1->staff_searchable(), "staff_searchable now false"); + + $type1->code('INSTID'); + is($type1->code(), 'CAMPUSID', 'code() allows retrieving but not setting'); + $type1->description('student ID'); + is($type1->description(), 'student ID', 'set description'); + $type1->authorised_value_category('CAT'); + is($type1->authorised_value_category(), 'CAT', 'set authorised_value_category'); + + $type1->repeatable(1); + $type1->staff_searchable(1); + $type1->store(); + is($type1->num_patrons(), 0, 'no patrons using the new attribute type yet'); + + my $type2 = C4::Members::AttributeTypes->new('ABC', 'ABC ID'); + $type2->store(); +} + +sub shutdown_50_list_and_remove_types : Test( shutdown => 11 ) { + my $self = shift; + + my @list = C4::Members::AttributeTypes::GetAttributeTypes(); + is_deeply(\@list, [ { code => 'ABC', description => 'ABC ID' }, + { code => 'CAMPUSID', description => 'student ID' } ], "retrieved list of types"); + + my $type1 = C4::Members::AttributeTypes->fetch($list[1]->{code}); + isa_ok($type1, 'C4::Members::AttributeTypes'); + is($type1->code(), 'CAMPUSID', 'fetched code'); + is($type1->description(), 'student ID', 'fetched description'); + is($type1->authorised_value_category(), 'CAT', 'fetched authorised_value_category'); + ok($type1->repeatable(), "fetched repeatable"); + ok(!$type1->unique_id(), "fetched unique_id"); + ok(!$type1->opac_display(), "fetched opac_display"); + ok(!$type1->password_allowed(), "fetched password_allowed"); + ok($type1->staff_searchable(), "fetched staff_searchable"); + + $type1->delete(); + C4::Members::AttributeTypes->delete('ABC'); + + my @newlist = C4::Members::AttributeTypes::GetAttributeTypes(); + is(scalar(@newlist), 0, "no types left after deletion"); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Members/DebarMember.pm b/t/db_dependent/lib/KohaTest/Members/DebarMember.pm new file mode 100644 index 0000000000..9e27d6647a --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Members/DebarMember.pm @@ -0,0 +1,44 @@ +package KohaTest::Members::DebarMember; +use base qw( KohaTest::Members ); + +use strict; +use warnings; + +use Test::More; + +use C4::Members; +sub testing_class { 'C4::Members' }; + + +sub simple_usage : Test( 6 ) { + my $self = shift; + + ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); + + my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); + ok( exists $details->{'flags'}, 'member details has a "flags" attribute'); + isa_ok( $details->{'flags'}, 'HASH', 'the "flags" attribute is a hashref'); + ok( ! $details->{'flags'}->{'DBARRED'}, 'this member is NOT debarred' ); + + # Now, let's debar this member and see what happens + my $success = C4::Members::DebarMember( $self->{'memberid'} ); + + ok( $success, 'we were able to debar the member' ); + + $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); + ok( $details->{'flags'}->{'DBARRED'}, 'this member is debarred now' ) + or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) ); +} + +sub incorrect_usage : Test( 2 ) { + my $self = shift; + + my $result = C4::Members::DebarMember(); + ok( ! defined $result, 'DebarMember returns undef when passed no parameters' ); + + $result = C4::Members::DebarMember( 'this is not a borrowernumber' ); + ok( ! defined $result, 'DebarMember returns undef when not passed a numeric argument' ); + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Members/GetMember.pm b/t/db_dependent/lib/KohaTest/Members/GetMember.pm new file mode 100644 index 0000000000..51870ad6ff --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Members/GetMember.pm @@ -0,0 +1,197 @@ +package KohaTest::Members::GetMember; +use base qw( KohaTest::Members ); + +use strict; +use warnings; + +use Test::More; + +use C4::Members; + +sub testing_class { 'C4::Members' } + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=head3 startup_create_borrower + +Creates a new borrower to use for these tests. Class variables that are +used to search by are stored for easy access by the methods. + +=cut + +sub startup_create_borrower : Test( startup => 1 ) { + my $self = shift; + + my $memberinfo = { + surname => 'surname' . $self->random_string(), + firstname => 'firstname' . $self->random_string(), + address => 'address' . $self->random_string(), + city => 'city' . $self->random_string(), + cardnumber => 'card' . $self->random_string(), + branchcode => 'U1BCG', + categorycode => 'D', # B => Board + dateexpiry => '2020-01-01', + password => 'testpassword', + userid => 'testuser', + dateofbirth => $self->random_date(), + }; + + my $borrowernumber = AddMember( %$memberinfo ); + ok( $borrowernumber, "created member: $borrowernumber" ); + $self->{get_new_borrowernumber} = $borrowernumber; + $self->{get_new_cardnumber} = $memberinfo->{cardnumber}; + $self->{get_new_firstname} = $memberinfo->{firstname}; + $self->{get_new_userid} = $memberinfo->{userid}; + + return; +} + +=head2 TESTING METHODS + +Standard test methods + +=head3 borrowernumber_get + +Validates that GetMember can search by borrowernumber + +=cut + +sub borrowernumber_get : Test( 6 ) { + my $self = shift; + + ok( $self->{get_new_borrowernumber}, + "we have a valid memberid $self->{get_new_borrowernumber} to test with" ); + + #search by borrowernumber + my $results = + C4::Members::GetMember( borrowernumber=>$self->{get_new_borrowernumber}); + ok( $results, 'we successfully called GetMember searching by borrowernumber' ); + + ok( exists $results->{borrowernumber}, + 'member details has a "borrowernumber" attribute' ); + is( $results->{borrowernumber}, + $self->{get_new_borrowernumber}, + '...and it matches the created borrowernumber' + ); + + ok( exists $results->{'category_type'}, "categories in the join returned values" ); + ok( $results->{description}, "...and description is valid: $results->{description}" ); +} + +=head3 cardnumber_get + +Validates that GetMember can search by cardnumber + +=cut + +sub cardnumber_get : Test( 6 ) { + my $self = shift; + + ok( $self->{get_new_cardnumber}, + "we have a valid cardnumber $self->{get_new_cardnumber} to test with" ); + + #search by cardnumber + my $results = C4::Members::GetMember( 'cardnumber'=>$self->{get_new_cardnumber} ); + ok( $results, 'we successfully called GetMember searching by cardnumber' ); + + ok( exists $results->{cardnumber}, 'member details has a "cardnumber" attribute' ); + is( $results->{cardnumber}, + $self->{get_new_cardnumber}, + '..and it matches the created cardnumber' + ); + + ok( exists $results->{'category_type'}, "categories in the join returned values" ); + ok( $results->{description}, "...and description is valid: $results->{description}" ); +} + +=head3 firstname_get + +Validates that GetMember can search by firstname. +Note that only the first result is used. + +=cut + +sub firstname_get : Test( 6 ) { + my $self = shift; + + ok( $self->{get_new_firstname}, + "we have a valid firstname $self->{get_new_firstname} to test with" ); + + ##search by firstname + my $results = C4::Members::GetMember( 'firstname'=>$self->{get_new_firstname} ); + ok( $results, 'we successfully called GetMember searching by firstname' ); + + ok( exists $results->{firstname}, 'member details has a "firstname" attribute' ); + is( $results->{'firstname'}, + $self->{get_new_firstname}, + '..and it matches the created firstname' + ); + + ok( exists $results->{'category_type'}, "categories in the join returned values" ); + ok( $results->{description}, "...and description is valid: $results->{description}" ); +} + +=head3 userid_get + +Validates that GetMember can search by userid. + +=cut + +sub userid_get : Test( 6 ) { + my $self = shift; + + ok( $self->{get_new_userid}, + "we have a valid userid $self->{get_new_userid} to test with" ); + + #search by userid + my $results = C4::Members::GetMember( 'userid'=>$self->{get_new_userid} ); + ok( $results, 'we successfully called GetMember searching by userid' ); + + ok( exists $results->{'userid'}, 'member details has a "userid" attribute' ); + is( $results->{userid}, + $self->{get_new_userid}, + '..and it matches the created userid' + ); + + ok( exists $results->{'category_type'}, "categories in the join returned values" ); + ok( $results->{description}, "...and description is valid: $results->{description}" ); +} + +=head3 missing_params + +Validates that GetMember returns undef when no parameters are passed to it + +=cut + +sub missing_params : Test( 1 ) { + my $self = shift; + + my $results = C4::Members::GetMember(); + + ok( !defined $results, 'returned undef when no parameters passed' ); + +} + +=head2 SHUTDOWN METHODS + +These get run once, after the main test methods in this module + +=head3 shutdown_remove_borrower + +Remove the new borrower information that was created in the startup method + +=cut + +sub shutdown_remove_borrower : Test( shutdown => 0 ) { + my $self = shift; + + delete $self->{get_new_borrowernumber}; + delete $self->{get_new_cardnumber}; + delete $self->{get_new_firstname}; + delete $self->{get_new_userid}; + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Members/GetMemberDetails.pm b/t/db_dependent/lib/KohaTest/Members/GetMemberDetails.pm new file mode 100644 index 0000000000..e93742bf69 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Members/GetMemberDetails.pm @@ -0,0 +1,150 @@ +package KohaTest::Members::GetMemberDetails; +use base qw( KohaTest::Members ); + +use strict; +use warnings; + +use Test::More; + +use C4::Members; + +sub testing_class { 'C4::Members' } + +=head3 STARTUP METHODS + +These are run once, before the main test methods in this module. + +=head2 startup_create_detailed_borrower + +Creates a new borrower to be used by the testing methods. Also +populates the class hash with values to be compared from the database +retrieval. + +=cut + +sub startup_create_detailed_borrower : Test( startup => 2 ) { + my $self = shift; + my ( $description, $type, $amount, $user ); + + my $memberinfo = { + surname => 'surname' . $self->random_string(), + firstname => 'firstname' . $self->random_string(), + address => 'address' . $self->random_string(), + city => 'city' . $self->random_string(), + cardnumber => 'card' . $self->random_string(), + branchcode => 'CPL', + categorycode => 'B', + dateexpiry => '2020-01-01', + password => 'testpassword', + userid => 'testuser', + flags => '0', + dateofbirth => $self->random_date(), + }; + + my $borrowernumber = AddMember( %$memberinfo ); + ok( $borrowernumber, "created member: $borrowernumber" ); + $self->{detail_borrowernumber} = $borrowernumber; + $self->{detail_cardnumber} = $memberinfo->{cardnumber}; + + #values for adding a record to accounts + $description = 'Test account'; + $type = 'M'; + $amount = 5.00; + $user = ''; + + my $acct_added = + C4::Accounts::manualinvoice( $borrowernumber, undef, $description, $type, $amount, + $user ); + + ok( $acct_added == 0, 'added account for borrower' ); + + $self->{amountoutstanding} = $amount; + + return; +} + +=head2 TESTING METHODS + +=head3 borrower_detail_get + +Tests the functionality of the GetMemberDetails method in C4::Members. +Validates the join on categories table works as well as the extra fields +the method gets from outside of either the borrowers and categories table like +amountoutstanding and user flags. + +=cut + +sub borrower_detail_get : Test( 8 ) { + my $self = shift; + + ok( $self->{detail_borrowernumber}, + 'we have a valid detailed borrower to test with' ); + + my $details = C4::Members::GetMemberDetails( $self->{detail_borrowernumber} ); + ok( $details, 'we successfully called GetMemberDetails' ); + ok( exists $details->{categorycode}, + 'member details has a "categorycode" attribute' ); + ok( $details->{categorycode}, '...and it is set to something' ); + + ok( exists $details->{category_type}, "categories in the join returned values" ); + + ok( $details->{category_type}, '...and category_type is valid' ); + + ok( $details->{amountoutstanding}, 'an amountoutstanding exists' ); + is( $details->{amountoutstanding}, + $self->{amountoutstanding}, + '...and matches inserted account record' + ); + +} + +=head3 cardnumber_detail_get + +This method tests the capability of GetMemberDetails to search on cardnumber. There doesn't seem to be any +current calls to GetMemberDetail using cardnumber though, so this test may not be necessary. + +=cut + +sub cardnumber_detail_get : Test( 8 ) { + my $self = shift; + + ok( $self->{detail_cardnumber}, + "we have a valid detailed borrower to test with $self->{detail_cardnumber}" ); + + my $details = C4::Members::GetMemberDetails( undef, $self->{detail_cardnumber} ); + ok( $details, 'we successfully called GetMemberDetails' ); + ok( exists $details->{categorycode}, + "member details has a 'categorycode' attribute $details->{categorycode}" ); + ok( $details->{categorycode}, '...and it is set to something' ); + + ok( exists $details->{category_type}, "categories in the join returned values" ); + + ok( $details->{category_type}, '...and category_type is valid' ); + +#FIXME These 2 methods will fail as borrowernumber is not set in GetMemberDetails when cardnumber is used instead. +#ok( $details->{amountoutstanding}, 'an amountoutstanding exists' ); +#is( $details->{amountoutstanding}, $self->{amountoutstanding}, '...and matches inserted account record' ); +} + +=head2 SHUTDOWN METHDOS + +These get run once, after the main test methods in this module. + +=head3 shutdown_remove_new_borrower + +Removes references in the Class to the new borrower created +in the startup methods. + +=cut + +sub shutdown_remove_new_borrower : Test( shutdown => 0 ) { + my $self = shift; + + delete $self->{detail_borrowernumber}; + delete $self->{detail_cardnumber}; + delete $self->{amountoutstanding}; + + return; +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Members/ModMember.pm b/t/db_dependent/lib/KohaTest/Members/ModMember.pm new file mode 100644 index 0000000000..876677fd5e --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Members/ModMember.pm @@ -0,0 +1,103 @@ +package KohaTest::Members::ModMember; +use base qw( KohaTest::Members ); + +use strict; +use warnings; + +use Test::More; + +use C4::Members; +sub testing_class { 'C4::Members' }; + + +sub a_simple_usage : Test( 7 ) { + my $self = shift; + + ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); + + my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); + ok( exists $details->{'dateofbirth'}, 'member details has a "dateofbirth" attribute'); + ok( $details->{'dateofbirth'}, '...and it is set to something' ); + + my $new_date_of_birth = $self->random_date(); + like( $new_date_of_birth, qr(^\d\d\d\d-\d\d-\d\d$), 'The new date of birth is a yyyy-mm-dd' ); + + my $success = C4::Members::ModMember( + borrowernumber => $self->{'memberid'}, + dateofbirth => $new_date_of_birth + ); + + ok( $success, 'we successfully called ModMember' ); + + $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); + ok( exists $details->{'dateofbirth'}, 'member details still has a "dateofbirth" attribute'); + is( $details->{'dateofbirth'}, $new_date_of_birth, '...and it is set to the new_date_of_birth' ); + +} + +sub incorrect_usage : Test( 1 ) { + my $self = shift; + + local $TODO = 'ModMember does not fail gracefully yet'; + + my $result = C4::Members::ModMember(); + ok( ! defined $result, 'ModMember returns false when passed no parameters' ); + +} + +=head2 preserve_dates + +In bug 2284, it was determined that a Member's dateofbirth could be +erased by a call to ModMember if no date_of_birth was passed in. Three +date fields (dateofbirth, dateexpiry ,and dateenrolled) are treated +differently than other fields by ModMember. This test method calls +ModMember with none of the date fields set to ensure that they are not +overwritten. + +=cut + + +sub preserve_dates : Test( 18 ) { + my $self = shift; + + ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); + + my %date_fields = ( + dateofbirth => $self->random_date(), + dateexpiry => $self->random_date(), + dateenrolled => $self->random_date(), + ); + + # stage our member with valid dates in all of the date fields + my $success = C4::Members::ModMember( + borrowernumber => $self->{'memberid'}, + %date_fields, + ); + ok( $success, 'succefully set the date fields.' ); + + # make sure that we successfully set the date fields. They're not undef. + my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); + foreach my $date_field ( keys %date_fields ) { + ok( exists $details->{$date_field}, qq(member details has a "$date_field" attribute) ); + ok( $details->{$date_field}, '...and it is set to something true' ); + is( $details->{$date_field}, $date_fields{$date_field}, '...and it is set to what we set it' ); + } + + # call ModMember to update the firstname. Notice that we're not + # updating any date fields. + $success = C4::Members::ModMember( + borrowernumber => $self->{'memberid'}, + firstname => $self->random_string, + ); + ok( $success, 'we successfully called ModMember' ); + + # make sure that none of the date fields have been molested by our call to ModMember. + $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); + foreach my $date_field ( keys %date_fields ) { + ok( exists $details->{$date_field}, qq(member details still has a "$date_field" attribute) ); + is( $details->{$date_field}, $date_fields{$date_field}, '...and it is set to the expected value' ); + } + +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Message.pm b/t/db_dependent/lib/KohaTest/Message.pm new file mode 100644 index 0000000000..d1d822f2ee --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Message.pm @@ -0,0 +1,52 @@ +package KohaTest::Message; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Message; +sub testing_class { 'C4::Message' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + new + find + find_last_message + enqueue + update + metadata + render_metadata + append + ); + + can_ok( $self->testing_class, @methods ); +} + +sub test_metadata : Test( 1 ) { + my $self = shift; + my $message = C4::Message->new; + $message->metadata({ + header => "Header", + body => [], + footer => "Footer", + }); + like($message->{metadata}, qr{^---}, "The metadata attribute should be serialized as YAML."); +} + +sub test_append : Test( 1 ) { + my $self = shift; + my $message = C4::Message->new; + $message->metadata({ + header => "Header", + body => [], + footer => "Footer", + }); + $message->append("foo"); + is($message->metadata->{body}->[0], "foo", "Appending a string should add an element to metadata.body."); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/NewsChannels.pm b/t/db_dependent/lib/KohaTest/NewsChannels.pm new file mode 100644 index 0000000000..507677e35e --- /dev/null +++ b/t/db_dependent/lib/KohaTest/NewsChannels.pm @@ -0,0 +1,28 @@ +package KohaTest::NewsChannels; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::NewsChannels; +sub testing_class { 'C4::NewsChannels' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + add_opac_new + upd_opac_new + del_opac_new + get_opac_new + get_opac_news + GetNewsToDisplay + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Overdues.pm b/t/db_dependent/lib/KohaTest/Overdues.pm new file mode 100644 index 0000000000..949c670961 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Overdues.pm @@ -0,0 +1,50 @@ +package KohaTest::Overdues; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Overdues; +sub testing_class { 'C4::Overdues' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( Getoverdues + checkoverdues + CalcFine + GetSpecialHolidays + GetRepeatableHolidays + GetWdayFromItemnumber + GetIssuesIteminfo + UpdateFine + BorType + ReplacementCost + GetFine + GetIssuingRules + ReplacementCost2 + GetNextIdNotify + NumberNotifyId + AmountNotify + UpdateAccountLines + GetItems + GetOverdueDelays + CheckAccountLineLevelInfo + GetOverduerules + CheckBorrowerDebarred + UpdateBorrowerDebarred + CheckExistantNotifyid + CheckAccountLineItemInfo + CheckItemNotify + GetOverduesForBranch + AddNotifyLine + RemoveNotifyLine + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm b/t/db_dependent/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm new file mode 100644 index 0000000000..4ff8db4916 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm @@ -0,0 +1,59 @@ +package KohaTest::Overdues::GetBranchcodesWithOverdueRules; +use base qw( KohaTest::Overdues ); + +use strict; +use warnings; + +use C4::Overdues; +use Test::More; + +sub my_branch_has_no_rules : Tests( 2 ) { + my $self = shift; + + ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); + + my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; + my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; + is( scalar @found_branches, 0, '...and it is not in the list of branches') + +} + +sub my_branch_has_overdue_rules : Tests( 3 ) { + my $self = shift; + + ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); + + my $dbh = C4::Context->dbh(); + my $sql = <<'END_SQL'; +INSERT INTO overduerules +(branchcode, categorycode, +delay1, letter1, debarred1, +delay2, letter2, debarred2, +delay3, letter3, debarred3) +VALUES +( ?, ?, +?, ?, ?, +?, ?, ?, +?, ?, ?) +END_SQL + + my $sth = $dbh->prepare($sql); + my $success = $sth->execute( $self->{'branchcode'}, $self->random_string(2), + 1, $self->random_string(), 0, + 5, $self->random_string(), 0, + 9, $self->random_string(), 1, ); + ok( $success, '...and we have successfully given it an overdue rule' ); + + my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; + my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; + is( scalar @found_branches, 1, '...and it IS in the list of branches.') + +} + +1; + + + + + + diff --git a/t/db_dependent/lib/KohaTest/Overdues/GetOverdues.pm b/t/db_dependent/lib/KohaTest/Overdues/GetOverdues.pm new file mode 100644 index 0000000000..3cfc4386bc --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Overdues/GetOverdues.pm @@ -0,0 +1,126 @@ +package KohaTest::Overdues::GetOverdues; +use base qw( KohaTest::Overdues ); + +use strict; +use warnings; + +use C4::Overdues; +use Test::More; + +=head3 create_overdue_item + +=cut + +sub startup_60_create_overdue_item : Test( startup => 17 ) { + my $self = shift; + + $self->add_biblios( add_items => 1 ); + + my $biblionumber = $self->{'biblios'}[0]; + ok( $biblionumber, 'biblionumber' ); + my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $biblionumber ); + ok( scalar @biblioitems > 0, 'there is at least one biblioitem' ); + my $biblioitemnumber = $biblioitems[0]->{'biblioitemnumber'}; + ok( $biblioitemnumber, 'got a biblioitemnumber' ); + + my $items = C4::Items::GetItemsByBiblioitemnumber( $biblioitemnumber); + + my $item = $items->[0]; + ok( $item->{'itemnumber'}, 'item number' ); + $self->{'overdueitemnumber'} = $item->{'itemnumber'}; + + # let's use the database to do date math for us. + # This is a US date, but that's how C4::Dates likes it, apparently. + my $dbh = C4::Context->dbh(); + my $date_list = $dbh->selectcol_arrayref( q( select DATE_FORMAT( FROM_DAYS( TO_DAYS( NOW() ) - 6 ), '%m/%d/%Y' ) ) ); + my $six_days_ago = shift( @$date_list ); + + my $duedate = C4::Dates->new( $six_days_ago ); + # diag( Data::Dumper->Dump( [ $duedate ], [ 'duedate' ] ) ); + + ok( $item->{'barcode'}, 'barcode' ) + or diag( Data::Dumper->Dump( [ $item ], [ 'item' ] ) ); + # my $item_from_barcode = C4::Items::GetItem( undef, $item->{'barcode'} ); + # diag( Data::Dumper->Dump( [ $item_from_barcode ], [ 'item_from_barcode' ] ) ); + + ok( $self->{'memberid'}, 'memberid' ); + my $borrower = C4::Members::GetMember( borrowernumber=>$self->{'memberid'} ); + ok( $borrower->{'borrowernumber'}, 'borrowernumber' ); + + my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $item->{'barcode'}, $duedate, 0 ); + # diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); + is( keys %$issuingimpossible, 0, 'issuing is not impossible' ); + is( keys %$needsconfirmation, 0, 'issuing needs no confirmation' ); + + C4::Circulation::AddIssue( $borrower, $item->{'barcode'}, $duedate ); +} + +sub basic_usage : Test( 2 ) { + my $self = shift; + + my $overdues = C4::Overdues::Getoverdues(); + isa_ok( $overdues, 'ARRAY' ); + is( scalar @$overdues, 1, 'found our one overdue book' ); +} + +sub limit_minimum_and_maximum : Test( 2 ) { + my $self = shift; + + my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 100 } ); + isa_ok( $overdues, 'ARRAY' ); + is( scalar @$overdues, 1, 'found our one overdue book' ); +} + +sub limit_and_do_not_find_it : Test( 2 ) { + my $self = shift; + + my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 2 } ); + isa_ok( $overdues, 'ARRAY' ); + is( scalar @$overdues, 0, 'there are no overdue books in that range.' ); +} + +=pod + +sub run_overduenotices_script : Test( 1 ) { + my $self = shift; + + # make sure member wants alerts + C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'}, + { code => 'PREDEmail', + value => '1' } ); + + # we're screwing with C4::Circulation::GetUpcomingIssues by passing in a negative number. + C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'}, + { code => 'PREDDAYS', + value => '-6' } ); + + + my $before_count = $self->count_message_queue(); + + my $output = qx( ../misc/cronjobs/advance_notices.pl -c ); + + my $after_count = $self->count_message_queue(); + is( $after_count, $before_count + 1, 'there is one more message in the queue than there used to be.' ) + or diag $output; + +} + + +=cut + +sub count_message_queue { + my $self = shift; + + my $dbh = C4::Context->dbh(); + my $statement = q( select count(0) from message_queue where status = 'pending' ); + my $countlist = $dbh->selectcol_arrayref( $statement ); + return $countlist->[0]; +} + +1; + + + + + + diff --git a/t/db_dependent/lib/KohaTest/Print.pm b/t/db_dependent/lib/KohaTest/Print.pm new file mode 100644 index 0000000000..02fd5fb894 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Print.pm @@ -0,0 +1,24 @@ +package KohaTest::Print; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Print; +sub testing_class { 'C4::Print' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( remoteprint + printreserve + printslip + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Reserves.pm b/t/db_dependent/lib/KohaTest/Reserves.pm new file mode 100644 index 0000000000..5317029c75 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Reserves.pm @@ -0,0 +1,41 @@ +package KohaTest::Reserves; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Reserves; +sub testing_class { 'C4::Reserves' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( AddReserve + GetReservesFromBiblionumber + GetReservesFromItemnumber + GetReservesFromBorrowernumber + GetReserveCount + GetOtherReserves + GetReserveFee + GetReservesToBranch + GetReservesForBranch + CheckReserves + CancelReserve + ModReserve + ModReserveFill + ModReserveStatus + ModReserveAffect + ModReserveCancelAll + ModReserveMinusPriority + GetReserveInfo + _FixPriority + _Findgroupreserve + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/SMS.pm b/t/db_dependent/lib/KohaTest/SMS.pm new file mode 100644 index 0000000000..00af101538 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/SMS.pm @@ -0,0 +1,23 @@ +package KohaTest::SMS; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::SMS; +sub testing_class { 'C4::SMS' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( send_sms + driver + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/SMS/send_sms.pm b/t/db_dependent/lib/KohaTest/SMS/send_sms.pm new file mode 100644 index 0000000000..d6bbb64c5b --- /dev/null +++ b/t/db_dependent/lib/KohaTest/SMS/send_sms.pm @@ -0,0 +1,25 @@ +package KohaTest::SMS::send_sms; +use base qw( KohaTest::SMS ); + +use strict; +use warnings; + +use Test::More; + +use C4::SMS; +sub testing_class { 'C4::SMS' }; + + +sub send_a_message : Test( 1 ) { + my $self = shift; + + my $success = C4::SMS->send_sms( { destination => '+1 212-555-1111', + message => 'This is the message', + driver => 'Test' } ); + + ok( $success, "send_sms returned a true: $success" ); + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Scripts.pm b/t/db_dependent/lib/KohaTest/Scripts.pm new file mode 100644 index 0000000000..f44274dd15 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Scripts.pm @@ -0,0 +1,18 @@ +package KohaTest::Scripts; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Search; +sub testing_class { return; }; + +# Since this is an abstract base class, this prevents these tests from +# being run directly unless we're testing a subclass. It just makes +# things faster. +__PACKAGE__->SKIP_CLASS( 1 ); + + +1; diff --git a/t/db_dependent/lib/KohaTest/Scripts/longoverdue.pm b/t/db_dependent/lib/KohaTest/Scripts/longoverdue.pm new file mode 100644 index 0000000000..e00fb0c9e8 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Scripts/longoverdue.pm @@ -0,0 +1,97 @@ +package KohaTest::Scripts::longoverdue; +use base qw( KohaTest::Scripts ); + +use strict; +use warnings; + +use Test::More; +use Time::localtime; + + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=head3 create_overdue_item + +=cut + +sub create_overdue_item : Test( startup => 12 ) { + my $self = shift; + + $self->add_biblios( add_items => 1 ); + + my $biblionumber = $self->{'biblios'}[0]; + ok( $biblionumber, 'biblionumber' ); + my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $biblionumber ); + ok( scalar @biblioitems > 0, 'there is at least one biblioitem' ); + my $biblioitemnumber = $biblioitems[0]->{'biblioitemnumber'}; + ok( $biblioitemnumber, 'got a biblioitemnumber' ); + + my $items = C4::Items::GetItemsByBiblioitemnumber( $biblioitemnumber); + + my $itemnumber = $items->[0]->{'itemnumber'}; + ok( $items->[0]->{'itemnumber'}, 'item number' ); + + $self->{'overdueitemnumber'} = $itemnumber; + +} + +sub set_overdue_item_lost : Test( 13 ) { + my $self = shift; + + my $item = C4::Items::GetItem( $self->{'overdueitemnumber'} ); + is( $item->{'itemnumber'}, $self->{'overdueitemnumber'}, 'itemnumber' ); + + ok( exists $item->{'itemlost'}, 'itemlost exists' ); + ok( ! $item->{'itemlost'}, 'item is not lost' ); + + # This is a US date, but that's how C4::Dates likes it, apparently. + my $duedatestring = sprintf( '%02d/%02d/%04d', + localtime->mon() + 1, + localtime->mday(), + localtime->year() + 1900 - 1, # it was due a year ago. + ); + my $duedate = C4::Dates->new( $duedatestring ); + # diag( Data::Dumper->Dump( [ $duedate ], [ 'duedate' ] ) ); + + ok( $item->{'barcode'}, 'barcode' ) + or diag( Data::Dumper->Dump( [ $item ], [ 'item' ] ) ); + # my $item_from_barcode = C4::Items::GetItem( undef, $item->{'barcode'} ); + # diag( Data::Dumper->Dump( [ $item_from_barcode ], [ 'item_from_barcode' ] ) ); + + my $borrower = C4::Members::GetMember( borrowernumber => $self->{'memberid'} ); + ok( $borrower->{'borrowernumber'}, 'borrowernumber' ); + + my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $item->{'barcode'}, $duedate, 0 ); + # diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); + is( keys %$issuingimpossible, 0, 'issuing is not impossible' ); + is( keys %$needsconfirmation, 0, 'issuing needs no confirmation' ); + + my $issue_due_date = C4::Circulation::AddIssue( $borrower, $item->{'barcode'}, $duedate ); + ok( $issue_due_date, 'due date' ); + is( $issue_due_date, $duedate, 'AddIssue returned the same date we passed to it' ); + + # I have to make this in a different format since that's how the database holds it. + my $duedateyyyymmdd = sprintf( '%04d-%02d-%02d', + localtime->year() + 1900 - 1, # it was due a year ago. + localtime->mon() + 1, + localtime->mday(), + ); + + my $issued_item = C4::Items::GetItem( $self->{'overdueitemnumber'} ); + is( $issued_item->{'onloan'}, $duedateyyyymmdd, "the item is checked out and due $duedatestring" ); + is( $issued_item->{'itemlost'}, 0, 'the item is not lost' ); + # diag( Data::Dumper->Dump( [ $issued_item ], [ 'issued_item' ] ) ); + + qx( ../misc/cronjobs/longoverdue.pl --lost 90=2 --confirm ); + + my $lost_item = C4::Items::GetItem( $self->{'overdueitemnumber'} ); + is( $lost_item->{'onloan'}, $duedateyyyymmdd, "the item is checked out and due $duedatestring" ); + is( $lost_item->{'itemlost'}, 2, 'the item is lost' ); + # diag( Data::Dumper->Dump( [ $lost_item ], [ 'lost_item' ] ) ); + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Search.pm b/t/db_dependent/lib/KohaTest/Search.pm new file mode 100644 index 0000000000..4ad190b0b8 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Search.pm @@ -0,0 +1,37 @@ +package KohaTest::Search; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Search; +sub testing_class { 'C4::Search' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( + FindDuplicate + SimpleSearch + getRecords + pazGetRecords + _remove_stopwords + _detect_truncation + _build_stemmed_operand + _build_weighted_query + buildQuery + searchResults + NZgetRecords + NZanalyse + NZoperatorAND + NZoperatorOR + NZoperatorNOT + NZorder + ); + + can_ok( $self->testing_class, @methods ); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Search/NoZebra.pm b/t/db_dependent/lib/KohaTest/Search/NoZebra.pm new file mode 100644 index 0000000000..ade916a561 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Search/NoZebra.pm @@ -0,0 +1,235 @@ +package KohaTest::Search::NoZebra; +use base qw( KohaTest::Search ); + +use strict; +use warnings; + +use Test::More; + +use MARC::Record; + +use C4::Search; +use C4::Biblio; +use C4::Context; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=cut + +=head3 startup_50_init_nozebra + +Turn on NoZebra mode, for now, assumes and requires +that the test database has started out using Zebra. + +=cut + +sub startup_50_init_nozebra : Test( startup => 3 ) { + my $using_nozebra = C4::Context->preference('NoZebra'); + ok(!$using_nozebra, "starting out using Zebra"); + my $dbh = C4::Context->dbh; + $dbh->do("UPDATE systempreferences SET value=1 WHERE variable='NoZebra'"); + $dbh->do("UPDATE systempreferences SET value=0 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')"); + C4::Context->clear_syspref_cache(); + $using_nozebra = C4::Context->preference('NoZebra'); + ok($using_nozebra, "switched to NoZebra"); + + my $sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); + $sth->execute; + my ($count) = $sth->fetchrow_array; + $sth->finish; + cmp_ok($count, '==', 0, "NoZebra index starts off empty"); +} + +sub startup_51_add_bibs : Test( startup => 2 ) { + my $self = shift; + + my $bib1 = MARC::Record->new(); + $bib1->leader(' nam a22 7a 4500'); + $bib1->append_fields( + MARC::Field->new('010', ' ', ' ', a => 'lccn001'), + MARC::Field->new('020', ' ', ' ', a => 'isbn001'), + MARC::Field->new('022', ' ', ' ', a => 'issn001'), + MARC::Field->new('100', ' ', ' ', a => 'Cat, Felix T.'), + MARC::Field->new('245', ' ', ' ', a => 'Of mice and men :', b=> 'a history'), + ); + my $bib2 = MARC::Record->new(); + $bib2->leader(' nam a22 7a 4500'); + $bib2->append_fields( + MARC::Field->new('010', ' ', ' ', a => 'lccn002'), + MARC::Field->new('020', ' ', ' ', a => 'isbn002'), + MARC::Field->new('022', ' ', ' ', a => 'issn002'), + MARC::Field->new('100', ' ', ' ', a => 'Dog, Rover T.'), + MARC::Field->new('245', ' ', ' ', a => 'Of mice and men :', b=> 'a digression'), + ); + + my $dbh = C4::Context->dbh; + my $count_sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); + my $count; + my ($bib1_bibnum, $bib1_bibitemnum) = AddBiblio($bib1, ''); + $count_sth->execute; + ($count) = $count_sth->fetchrow_array; + cmp_ok($count, '==', 14, "correct number of new words indexed"); # tokens + biblionumber + __RAW__ + + my ($bib2_bibnum, $bib2_bibitemnum) = AddBiblio($bib2, ''); + $count_sth->execute; + ($count) = $count_sth->fetchrow_array; + cmp_ok($count, '==', 22, "correct number of new words indexed"); # tokens + biblionumber + __RAW__ + + push @{ $self->{nozebra_test_bibs} }, $bib1_bibnum, $bib2_bibnum; +} + +=head2 TEST METHODS + +Standard test methods + +=cut + +sub basic_searches_via_nzanalyze : Test( 28 ) { + my $self = shift; + my ($bib1_bibnum, $bib2_bibnum) = @{ $self->{nozebra_test_bibs} }; + + my $results = C4::Search::NZanalyse('foobar'); + ok(!defined($results), "no hits on 'foobar'"); + + $results = C4::Search::NZanalyse('dog'); + my ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 1, "one hit on 'dog'"); + is($bib2_bibnum, $bibnumbers[0], "correct hit on 'dog'"); + + $results = C4::Search::NZanalyse('au=dog'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 1, "one hit on 'au=dog'"); + is($bib2_bibnum, $bibnumbers[0], "correct hit on 'au=dog'"); + + $results = C4::Search::NZanalyse('isbn=dog'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 0, "zero hits on 'isbn=dog'"); + + $results = C4::Search::NZanalyse('cat'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 1, "one hit on 'cat'"); + is($bib1_bibnum, $bibnumbers[0], "correct hit on 'cat'"); + + $results = C4::Search::NZanalyse('cat and dog'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 0, "zero hits on 'cat and dog'"); + + $results = C4::Search::NZanalyse('cat or dog'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 2, "two hits on 'cat or dog'"); + is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'cat or dog'"); + + $results = C4::Search::NZanalyse('mice and men'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 2, "two hits on 'mice and men'"); + is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'mice and men'"); + + $results = C4::Search::NZanalyse('title=digression or issn=issn001'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 2, "two hits on 'title=digression or issn=issn001'"); + is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'title=digression or issn=issn001'"); + + $results = C4::Search::NZanalyse('title=digression and issn=issn002'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 1, "two hits on 'title=digression and issn=issn002'"); + is($bib2_bibnum, $bibnumbers[0], "correct hit on 'title=digression and issn=issn002'"); + + $results = C4::Search::NZanalyse('mice not men'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 0, "zero hits on 'mice not men'"); + + $results = C4::Search::NZanalyse('mice not dog'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 1, "one hit on 'mice not dog'"); + is($bib1_bibnum, $bibnumbers[0], "correct hit on 'mice not dog'"); + + $results = C4::Search::NZanalyse('isbn > a'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 2, "two hits on 'isbn > a'"); + is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'isbn > a'"); + + $results = C4::Search::NZanalyse('isbn < z'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 2, "two hits on 'isbn < z'"); + is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'isbn < z'"); + + $results = C4::Search::NZanalyse('isbn > isbn001'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 1, "one hit on 'isbn > isbn001'"); + is($bib2_bibnum, $bibnumbers[0], "correct hit on 'isbn > isbn001'"); + + $results = C4::Search::NZanalyse('isbn>=isbn001'); + ($hits, @bibnumbers) = parse_nzanalyse($results); + cmp_ok($hits, '==', 2, "two hits on 'isbn>=isbn001'"); + is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'isbn>=isbn001'"); +} + +sub parse_nzanalyse { + my $results = shift; + my @bibnumbers = (); + if (defined $results) { + # NZanalyze currently has a funky way of returning results - + # it does not guarantee that a biblionumber occurs only + # once in the results string. Hence we must remove + # duplicates, like NZorder (inefficently) does + my %hash; + @bibnumbers = grep { ++$hash{$_} == 1 } map { my @f = split /,/, $_; $f[0]; } split /;/, $results; + } + return scalar(@bibnumbers), @bibnumbers; +} + +=head2 SHUTDOWN METHODS + +These get run once, after all of the main tests methods in this module + +=cut + +sub shutdown_49_remove_bibs : Test( shutdown => 4 ) { + my $self = shift; + my ($bib1_bibnum, $bib2_bibnum) = @{ $self->{nozebra_test_bibs} }; + + my $dbh = C4::Context->dbh; + my $count_sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); + my $count; + + my $error = DelBiblio($bib2_bibnum); + ok(!defined($error), "deleted bib $bib2_bibnum"); + $count_sth->execute; + ($count) = $count_sth->fetchrow_array; + TODO: { local $TODO = 'nothing actually gets deleted from nozebra currently'; + cmp_ok($count, '==', 14, "correct number of words indexed after bib $bib2_bibnum deleted"); + } + + $error = DelBiblio($bib1_bibnum); + ok(!defined($error), "deleted bib $bib1_bibnum"); + $count_sth->execute; + ($count) = $count_sth->fetchrow_array; + TODO: { local $TODO = 'nothing actually gets deleted from nozebra currently'; + cmp_ok($count, '==', 0, "no entries left in nozebra after bib $bib1_bibnum deleted"); + } + + delete $self->{nozebra_test_bibs}; +} + +sub shutdown_50_init_nozebra : Test( shutdown => 3 ) { + my $using_nozebra = C4::Context->preference('NoZebra'); + ok($using_nozebra, "still in NoZebra mode"); + my $dbh = C4::Context->dbh; + $dbh->do("UPDATE systempreferences SET value=0 WHERE variable='NoZebra'"); + $dbh->do("UPDATE systempreferences SET value=1 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')"); + C4::Context->clear_syspref_cache(); + $using_nozebra = C4::Context->preference('NoZebra'); + ok(!$using_nozebra, "switched to Zebra"); + + # FIXME + $dbh->do("DELETE FROM nozebra"); + my $sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); + $sth->execute; + my ($count) = $sth->fetchrow_array; + $sth->finish; + cmp_ok($count, '==', 0, "NoZebra index finishes up empty"); +} + +1; diff --git a/t/db_dependent/lib/KohaTest/Search/SimpleSearch.pm b/t/db_dependent/lib/KohaTest/Search/SimpleSearch.pm new file mode 100644 index 0000000000..95324f2441 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Search/SimpleSearch.pm @@ -0,0 +1,140 @@ +package KohaTest::Search::SimpleSearch; +use base qw( KohaTest::Search ); + +use strict; +use warnings; + +use Test::More; + +use C4::Search; +use C4::Biblio; + +=head2 STARTUP METHODS + +These get run once, before the main test methods in this module + +=head3 insert_test_data + +=cut + +sub insert_test_data : Test( startup => 71 ) { + my $self = shift; + + # get original 'Finn Test' count + my $query = 'Finn Test'; + my ( $error, $results ) = SimpleSearch( $query ); + $self->{'orig_finn_test_hits'} = scalar(@$results); + + # I'm going to add a bunch of biblios so that I can search for them. + $self->add_biblios( count => 10, + add_items => 1 ); + +} + +=head2 STARTUP METHODS + +standard test methods + +=head3 basic_test + +basic usage. + +=cut + +sub basic_test : Test( 2 ) { + my $self = shift; + + my $query = 'test'; + + my ( $error, $results ) = SimpleSearch( $query ); + ok( ! defined $error, 'no error found during search' ); + like( $results->[0], qr/$query/i, 'the result seems to match the query' ) + or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); + +} + +=head3 basic_test_with_server + +Test the usage where we specify no limits, but we do specify a server. + +=cut + +sub basic_test_with_server : Test( 2 ) { + my $self = shift; + + my $query = 'test'; + + my ( $error, $results ) = SimpleSearch( $query, undef, undef, [ 'biblioserver' ] ); + ok( ! defined $error, 'no error found during search' ); + like( $results->[0], qr/$query/i, 'the result seems to match the query' ) + or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); + +} + + +=head3 basic_test_no_results + +Make sure we get back an empty listref when there are no results. + +=cut + +sub basic_test_no_results : Test( 3 ) { + my $self = shift; + + my $query = 'This string is almost guaranteed to not match anything.'; + + my ( $error, $results ) = SimpleSearch( $query ); + ok( ! defined $error, 'no error found during search' ); + isa_ok( $results, 'ARRAY' ); + is( scalar( @$results ), 0, 'an empty list was returned.' ) + or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); +} + +=head3 limits + +check that the SimpleTest method limits the number of results returned. + +=cut + +sub limits : Test( 8 ) { + my $self = shift; + + my $query = 'Finn Test'; + + { + my ( $error, $results ) = SimpleSearch( $query ); + ok( ! defined $error, 'no error found during search' ); + my $expected_hits = 10 + $self->{'orig_finn_test_hits'}; + is( scalar @$results, $expected_hits, "found all $expected_hits results." ) + or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); + } + + my $offset = 4; + { + my ( $error, $results ) = SimpleSearch( $query, $offset ); + ok( ! defined $error, 'no error found during search' ); + my $expected_hits = 6 + $self->{'orig_finn_test_hits'}; + is( scalar @$results, $expected_hits, "found $expected_hits results." ) + or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); + } + + my $max_results = 2; + { + my ( $error, $results ) = SimpleSearch( $query, $offset, $max_results ); + ok( ! defined $error, 'no error found during search' ); + is( scalar @$results, $max_results, "found $max_results results." ) + or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); + } + + { + my ( $error, $results ) = SimpleSearch( $query, 0, $max_results ); + ok( ! defined $error, 'no error found during search' ); + is( scalar @$results, $max_results, "found $max_results results." ) + or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); + } + + +} + + +1; diff --git a/t/db_dependent/lib/KohaTest/Serials.pm b/t/db_dependent/lib/KohaTest/Serials.pm new file mode 100644 index 0000000000..e7bb2497cb --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Serials.pm @@ -0,0 +1,65 @@ +package KohaTest::Serials; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Serials; +sub testing_class { 'C4::Serials' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( GetSuppliersWithLateIssues + GetLateIssues + GetSubscriptionHistoryFromSubscriptionId + GetSerialStatusFromSerialId + GetSerialInformation + AddItem2Serial + UpdateClaimdateIssues + GetSubscription + GetFullSubscription + PrepareSerialsData + GetSubscriptionsFromBiblionumber + GetFullSubscriptionsFromBiblionumber + GetSubscriptions + GetSerials + GetSerials2 + GetLatestSerials + GetNextSeq + GetSeq + GetExpirationDate + CountSubscriptionFromBiblionumber + ModSubscriptionHistory + ModSerialStatus + ModSubscription + NewSubscription + ReNewSubscription + NewIssue + ItemizeSerials + HasSubscriptionExpired + DelSubscription + DelIssue + GetLateOrMissingIssues + removeMissingIssue + updateClaim + getsupplierbyserialid + check_routing + addroutingmember + reorder_members + delroutingmember + getroutinglist + countissuesfrom + abouttoexpire + in_array + GetNextDate + itemdata + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Suggestions.pm b/t/db_dependent/lib/KohaTest/Suggestions.pm new file mode 100644 index 0000000000..0c74717a0f --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Suggestions.pm @@ -0,0 +1,30 @@ +package KohaTest::Suggestions; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Suggestions; +sub testing_class { 'C4::Suggestions' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( SearchSuggestion + GetSuggestion + GetSuggestionFromBiblionumber + GetSuggestionByStatus + CountSuggestion + NewSuggestion + ModStatus + ConnectSuggestionAndBiblio + DelSuggestion + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/db_dependent/lib/KohaTest/Z3950.pm b/t/db_dependent/lib/KohaTest/Z3950.pm new file mode 100644 index 0000000000..3d94cff151 --- /dev/null +++ b/t/db_dependent/lib/KohaTest/Z3950.pm @@ -0,0 +1,25 @@ +package KohaTest::Z3950; +use base qw( KohaTest ); + +use strict; +use warnings; + +use Test::More; + +use C4::Z3950; +sub testing_class { 'C4::Z3950' }; + + +sub methods : Test( 1 ) { + my $self = shift; + my @methods = qw( getz3950servers + z3950servername + addz3950queue + checkz3950searchdone + ); + + can_ok( $self->testing_class, @methods ); +} + +1; + diff --git a/t/lib/KohaTest.pm b/t/lib/KohaTest.pm deleted file mode 100644 index 323b55a67b..0000000000 --- a/t/lib/KohaTest.pm +++ /dev/null @@ -1,844 +0,0 @@ -package KohaTest; -use base qw(Test::Class); - -use Test::More; -use Data::Dumper; - -eval "use Test::Class"; -plan skip_all => "Test::Class required for performing database tests" if $@; -# Or, maybe I should just die there. - -use C4::Auth; -use C4::Biblio; -use C4::Bookseller; -use C4::Context; -use C4::Items; -use C4::Members; -use C4::Search; -use C4::Installer; -use C4::Languages; -use File::Temp qw/ tempdir /; -use CGI; -use Time::localtime; - -# Since this is an abstract base class, this prevents these tests from -# being run directly unless we're testing a subclass. It just makes -# things faster. -__PACKAGE__->SKIP_CLASS( 1 ); - -INIT { - if ($ENV{SINGLE_TEST}) { - # if we're running the tests in one - # or more test files specified via - # - # make test-single TEST_FILES=lib/KohaTest/Foo.pm - # - # use this INIT trick taken from the POD for - # Test::Class::Load. - start_zebrasrv(); - Test::Class->runtests; - stop_zebrasrv(); - } -} - -use Attribute::Handlers; - -=head2 Expensive test method attribute - -If a test method is decorated with an Expensive -attribute, it is skipped unless the RUN_EXPENSIVE_TESTS -environment variable is defined. - -To declare an entire test class and its subclasses expensive, -define a SKIP_CLASS with the Expensive attribute: - - sub SKIP_CLASS : Expensive { } - -=cut - -sub Expensive : ATTR(CODE) { - my ($package, $symbol, $sub, $attr, $data, $phase) = @_; - my $name = *{$symbol}{NAME}; - if ($name eq 'SKIP_CLASS') { - if ($ENV{'RUN_EXPENSIVE_TESTS'}) { - *{$symbol} = sub { 0; } - } else { - *{$symbol} = sub { "Skipping expensive test classes $package (and subclasses)"; } - } - } else { - unless ($ENV{'RUN_EXPENSIVE_TESTS'}) { - # a test method that runs no tests and just returns a scalar is viewed by Test::Class as a skip - *{$symbol} = sub { "Skipping expensive test $package\:\:$name"; } - } - } -} - -=head2 startup methods - -these are run once, at the beginning of the whole test suite - -=cut - -sub startup_15_truncate_tables : Test( startup => 1 ) { - my $self = shift; - -# my @truncate_tables = qw( accountlines -# accountoffsets -# action_logs -# alert -# aqbasket -# aqbookfund -# aqbooksellers -# aqbudget -# aqorderdelivery -# aqorders -# auth_header -# auth_subfield_structure -# auth_tag_structure -# auth_types -# authorised_values -# biblio -# biblio_framework -# biblioitems -# borrowers -# branchcategories -# branches -# branchrelations -# branchtransfers -# browser -# categories -# cities -# class_sort_rules -# class_sources -# currency -# deletedbiblio -# deletedbiblioitems -# deletedborrowers -# deleteditems -# ethnicity -# import_batches -# import_biblios -# import_items -# import_record_matches -# import_records -# issues -# issuingrules -# items -# itemtypes -# labels -# labels_conf -# labels_profile -# labels_templates -# language_descriptions -# language_rfc4646_to_iso639 -# language_script_bidi -# language_script_mapping -# language_subtag_registry -# letter -# marc_matchers -# marc_subfield_structure -# marc_tag_structure -# matchchecks -# matcher_matchpoints -# matchpoint_component_norms -# matchpoint_components -# matchpoints -# notifys -# nozebra -# old_issues -# old_reserves -# opac_news -# overduerules -# patroncards -# patronimage -# printers -# printers_profile -# repeatable_holidays -# reports_dictionary -# reserveconstraints -# reserves -# reviews -# roadtype -# saved_reports -# saved_sql -# serial -# serialitems -# services_throttle -# sessions -# special_holidays -# statistics -# stopwords -# subscription -# subscriptionhistory -# subscriptionroutinglist -# suggestions -# systempreferences -# tags -# userflags -# virtualshelfcontents -# virtualshelves -# z3950servers -# zebraqueue -# ); - - my @truncate_tables = qw( accountlines - accountoffsets - alert - aqbasket - aqbooksellers - aqorderdelivery - aqorders - auth_header - branchcategories - branchrelations - branchtransfers - browser - cities - deletedbiblio - deletedbiblioitems - deletedborrowers - deleteditems - ethnicity - issues - issuingrules - labels - labels_profile - matchchecks - notifys - nozebra - old_issues - old_reserves - overduerules - patroncards - patronimage - printers - printers_profile - reports_dictionary - reserveconstraints - reserves - reviews - roadtype - saved_reports - saved_sql - serial - serialitems - services_throttle - special_holidays - statistics - subscription - subscriptionhistory - subscriptionroutinglist - suggestions - tags - virtualshelfcontents - ); - - my $failed_to_truncate = 0; - foreach my $table ( @truncate_tables ) { - my $dbh = C4::Context->dbh(); - $dbh->do( "truncate $table" ) - or $failed_to_truncate = 1; - } - is( $failed_to_truncate, 0, 'truncated tables' ); -} - -=head2 startup_20_add_bookseller - -we need a bookseller for many of the tests, so let's insert one. Feel -free to use this one, or insert your own. - -=cut - -sub startup_20_add_bookseller : Test(startup => 1) { - my $self = shift; - - my $booksellerinfo = { name => 'bookseller ' . $self->random_string(), - }; - - my $id = AddBookseller( $booksellerinfo ); - ok( $id, "created bookseller: $id" ); - $self->{'booksellerid'} = $id; - - return; -} - -=head2 startup_22_add_bookfund - -we need a bookfund for many of the tests. This currently uses one that -is in the skeleton database. free to use this one, or insert your -own. - -=cut - -sub startup_22_add_bookfund : Test(startup => 2) { - my $self = shift; - - my $bookfundid = 'GEN'; - my $bookfund = GetBookFund( $bookfundid, undef ); - # diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund ) ) ); - is( $bookfund->{'bookfundid'}, $bookfundid, "found bookfund: '$bookfundid'" ); - is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" ); - - $self->{'bookfundid'} = $bookfundid; - return; -} - -=head2 startup_24_add_branch - -=cut - -sub startup_24_add_branch : Test(startup => 1) { - my $self = shift; - - my $branch_info = { - add => 1, - branchcode => $self->random_string(3), - branchname => $self->random_string(), - branchaddress1 => $self->random_string(), - branchaddress2 => $self->random_string(), - branchaddress3 => $self->random_string(), - branchphone => $self->random_phone(), - branchfax => $self->random_phone(), - brancemail => $self->random_email(), - branchip => $self->random_ip(), - branchprinter => $self->random_string(), - }; - C4::Branch::ModBranch($branch_info); - $self->{'branchcode'} = $branch_info->{'branchcode'}; - ok( $self->{'branchcode'}, "created branch: $self->{'branchcode'}" ); - -} - -=head2 startup_24_add_member - -Add a patron/member for the tests to use - -=cut - -sub startup_24_add_member : Test(startup => 1) { - my $self = shift; - - my $memberinfo = { surname => 'surname ' . $self->random_string(), - firstname => 'firstname' . $self->random_string(), - address => 'address' . $self->random_string(), - city => 'city' . $self->random_string(), - cardnumber => 'card' . $self->random_string(), - branchcode => 'CPL', # CPL => Centerville - categorycode => 'PT', # PT => PaTron - dateexpiry => '2010-01-01', - password => 'testpassword', - dateofbirth => $self->random_date(), - }; - - my $borrowernumber = AddMember( %$memberinfo ); - ok( $borrowernumber, "created member: $borrowernumber" ); - $self->{'memberid'} = $borrowernumber; - - return; -} - -=head2 startup_30_login - -=cut - -sub startup_30_login : Test( startup => 2 ) { - my $self = shift; - - $self->{'sessionid'} = '12345678'; # does this value matter? - my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - ok( $borrower_details->{'cardnumber'}, 'cardnumber' ); - - # make a cookie and force it into $cgi. - # This would be a lot easier with Test::MockObject::Extends. - my $cgi = CGI->new( { userid => $borrower_details->{'cardnumber'}, - password => 'testpassword' } ); - my $setcookie = $cgi->cookie( -name => 'CGISESSID', - -value => $self->{'sessionid'} ); - $cgi->{'.cookies'} = { CGISESSID => $setcookie }; - is( $cgi->cookie('CGISESSID'), $self->{'sessionid'}, 'the CGISESSID cookie is set' ); - # diag( Data::Dumper->Dump( [ $cgi->cookie('CGISESSID') ], [ qw( cookie ) ] ) ); - - # C4::Auth::checkauth sometimes emits a warning about unable to append to sessionlog. That's OK. - my ( $userid, $cookie, $sessionID ) = C4::Auth::checkauth( $cgi, 'noauth', {}, 'intranet' ); - # diag( Data::Dumper->Dump( [ $userid, $cookie, $sessionID ], [ qw( userid cookie sessionID ) ] ) ); - - # my $session = C4::Auth::get_session( $sessionID ); - # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) ); - - -} - -=head2 setup methods - -setup methods are run before every test method - -=cut - -=head2 teardown methods - -teardown methods are many time, once at the end of each test method. - -=cut - -=head2 shutdown methods - -shutdown methods are run once, at the end of the test suite - -=cut - -=head2 utility methods - -These are not test methods, but they're handy - -=cut - -=head3 random_string - -Nice for generating names and such. It's not actually random, more -like arbitrary. - -=cut - -sub random_string { - my $self = shift; - - my $wordsize = shift || 6; # how many letters in your string? - - # leave out these characters: "oOlL10". They're too confusing. - my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 ); - - my $randomstring; - foreach ( 0..$wordsize ) { - $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ]; - } - return $randomstring; - -} - -=head3 random_phone - -generates a random phone number. Currently, it's not actually random. It's an unusable US phone number - -=cut - -sub random_phone { - my $self = shift; - - return '212-555-5555'; - -} - -=head3 random_email - -generates a random email address. They're all in the unusable -'example.com' domain that is designed for this purpose. - -=cut - -sub random_email { - my $self = shift; - - return $self->random_string() . '@example.com'; - -} - -=head3 random_ip - -returns an IP address suitable for testing purposes. - -=cut - -sub random_ip { - my $self = shift; - - return '127.0.0.2'; - -} - -=head3 random_date - -returns a somewhat random date in the iso (yyyy-mm-dd) format. - -=cut - -sub random_date { - my $self = shift; - - my $year = 1800 + int( rand(300) ); # 1800 - 2199 - my $month = 1 + int( rand(12) ); # 1 - 12 - my $day = 1 + int( rand(28) ); # 1 - 28 - # stop at the 28th to keep us from generating February 31st and such. - - return sprintf( '%04d-%02d-%02d', $year, $month, $day ); - -} - -=head3 tomorrow - -returns tomorrow's date as YYYY-MM-DD. - -=cut - -sub tomorrow { - my $self = shift; - - return $self->days_from_now( 1 ); - -} - -=head3 yesterday - -returns yesterday's date as YYYY-MM-DD. - -=cut - -sub yesterday { - my $self = shift; - - return $self->days_from_now( -1 ); -} - - -=head3 days_from_now - -returns an arbitrary date based on today in YYYY-MM-DD format. - -=cut - -sub days_from_now { - my $self = shift; - my $days = shift or return; - - my $seconds = time + $days * 60*60*24; - my $yyyymmdd = sprintf( '%04d-%02d-%02d', - localtime( $seconds )->year() + 1900, - localtime( $seconds )->mon() + 1, - localtime( $seconds )->mday() ); - return $yyyymmdd; -} - -=head3 add_biblios - - $self->add_biblios( count => 10, - add_items => 1, ); - - named parameters: - count: number of biblios to add - add_items: should you add items for each one? - - returns: - I don't know yet. - - side effects: - adds the biblionumbers to the $self->{'biblios'} listref - - Notes: - Should I allow you to pass in biblio information, like title? - Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace. - This runs 10 tests, plus 4 for each "count", plus 3 more for each item added. - -=cut - -sub add_biblios { - my $self = shift; - my %param = @_; - - $param{'count'} = 1 unless defined( $param{'count'} ); - $param{'add_items'} = 0 unless defined( $param{'add_items'} ); - - foreach my $counter ( 1..$param{'count'} ) { - my $marcrecord = MARC::Record->new(); - isa_ok( $marcrecord, 'MARC::Record' ); - my @marc_fields = ( MARC::Field->new( '100', '1', '0', - a => 'Twain, Mark', - d => "1835-1910." ), - MARC::Field->new( '245', '1', '4', - a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ), - c => "Mark Twain ; illustrated by E.W. Kemble." ), - MARC::Field->new( '952', '0', '0', - p => '12345678' . $self->random_string() ), # barcode - MARC::Field->new( '952', '0', '0', - o => $self->random_string() ), # callnumber - MARC::Field->new( '952', '0', '0', - a => 'CPL', - b => 'CPL' ), - ); - - my $appendedfieldscount = $marcrecord->append_fields( @marc_fields ); - - diag $MARC::Record::ERROR if ( $MARC::Record::ERROR ); - is( $appendedfieldscount, scalar @marc_fields, 'added correct number of MARC fields' ); - - my $frameworkcode = ''; # XXX I'd like to put something reasonable here. - my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode ); - ok( $biblionumber, "the biblionumber is $biblionumber" ); - ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" ); - if ( $param{'add_items'} ) { - # my @iteminfo = AddItem( {}, $biblionumber ); - my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber ); - is( $iteminfo[0], $biblionumber, "biblionumber is $biblionumber" ); - is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" ); - ok( $iteminfo[2], "itemnumber is $iteminfo[2]" ); - push @{ $self->{'items'} }, - { biblionumber => $iteminfo[0], - biblioitemnumber => $iteminfo[1], - itemnumber => $iteminfo[2], - }; - } - push @{$self->{'biblios'}}, $biblionumber; - } - - $self->reindex_marc(); - my $query = 'Finn Test'; - my ( $error, $results ) = SimpleSearch( $query ); - if ( $param{'count'} <= scalar( @$results ) ) { - pass( "found all $param{'count'} titles" ); - } else { - fail( "we never found all $param{'count'} titles" ); - } - -} - -=head3 reindex_marc - -Do a fast reindexing of all of the bib and authority -records and mark all zebraqueue entries done. - -Useful for test routines that need to do a -lot of indexing without having to wait for -zebraqueue. - -In NoZebra model, this only marks zebraqueue -done - the records should already be indexed. - -=cut - -sub reindex_marc { - my $self = shift; - - # mark zebraqueue done regardless of the indexing mode - my $dbh = C4::Context->dbh(); - $dbh->do("UPDATE zebraqueue SET done = 1 WHERE done = 0"); - - return if C4::Context->preference('NoZebra'); - - my $directory = tempdir(CLEANUP => 1); - foreach my $record_type qw(biblio authority) { - mkdir "$directory/$record_type"; - my $sth = $dbh->prepare($record_type eq "biblio" ? "SELECT marc FROM biblioitems" : "SELECT marc FROM auth_header"); - $sth->execute(); - open OUT, ">:utf8", "$directory/$record_type/records"; - while (my ($blob) = $sth->fetchrow_array) { - print OUT $blob; - } - close OUT; - my $zebra_server = "${record_type}server"; - my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'}; - my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'}; - my $zebra_db = $record_type eq 'biblio' ? 'biblios' : 'authorities'; - system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 init > /dev/null 2>\&1"; - system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 update $directory/${record_type} > /dev/null 2>\&1"; - system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 commit > /dev/null 2>\&1"; - } - -} - - -=head3 clear_test_database - - removes all tables from test database so that install starts with a clean slate - -=cut - -sub clear_test_database { - - diag "removing tables from test database"; - - my $dbh = C4::Context->dbh; - my $schema = C4::Context->config("database"); - - my @tables = get_all_tables($dbh, $schema); - foreach my $table (@tables) { - drop_all_foreign_keys($dbh, $table); - } - - foreach my $table (@tables) { - drop_table($dbh, $table); - } -} - -sub get_all_tables { - my ($dbh, $schema) = @_; - my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?"); - my @tables = (); - $sth->execute($schema); - while (my ($table) = $sth->fetchrow_array) { - push @tables, $table; - } - $sth->finish; - return @tables; -} - -sub drop_all_foreign_keys { - my ($dbh, $table) = @_; - # get the table description - my $sth = $dbh->prepare("SHOW CREATE TABLE $table"); - $sth->execute; - my $vsc_structure = $sth->fetchrow; - # split on CONSTRAINT keyword - my @fks = split /CONSTRAINT /,$vsc_structure; - # parse each entry - foreach (@fks) { - # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop - $_ = /(.*) FOREIGN KEY.*/; - my $id = $1; - if ($id) { - # we have found 1 foreign, drop it - $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id"); - if ( $dbh->err ) { - diag "unable to DROP FOREIGN KEY '$id' on TABLE '$table' due to: " . $dbh->errstr(); - } - undef $id; - } - } -} - -sub drop_table { - my ($dbh, $table) = @_; - $dbh->do("DROP TABLE $table"); - if ( $dbh->err ) { - diag "unable to drop table: '$table' due to: " . $dbh->errstr(); - } -} - -=head3 create_test_database - - sets up the test database. - -=cut - -sub create_test_database { - - diag 'creating testing database...'; - my $installer = C4::Installer->new() or die 'unable to create new installer'; - # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] ); - my $all_languages = getAllLanguages(); - my $error = $installer->load_db_schema(); - die "unable to load_db_schema: $error" if ( $error ); - my $list = $installer->sql_file_list('en', 'marc21', { optional => 1, - mandatory => 1 } ); - my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list); - $installer->set_version_syspref(); - $installer->set_marcflavour_syspref('MARC21'); - $installer->set_indexing_engine(0); - diag 'database created.' -} - - -=head3 start_zebrasrv - - This method deletes and reinitializes the zebra database directory, - and then spans off a zebra server. - -=cut - -sub start_zebrasrv { - - stop_zebrasrv(); - diag 'cleaning zebrasrv...'; - - foreach my $zebra_server ( qw( biblioserver authorityserver ) ) { - my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'}; - my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'}; - foreach my $zebra_db_name ( qw( biblios authorities ) ) { - my $command = "zebraidx -c $zebra_config -d $zebra_db_name init"; - my $return = system( $command . ' > /dev/null 2>&1' ); - if ( $return != 0 ) { - diag( "command '$command' died with value: " . $? >> 8 ); - } - - $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name"; - diag $command; - $return = system( $command . ' > /dev/null 2>&1' ); - if ( $return != 0 ) { - diag( "command '$command' died with value: " . $? >> 8 ); - } - } - } - - diag 'starting zebrasrv...'; - - my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' ); - my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s', - $ENV{'KOHA_CONF'}, - File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ), - $pidfile, - ); - diag $command; - my $output = qx( $command ); - if ( $output ) { - diag $output; - } - if ( -e $pidfile, 'pidfile exists' ) { - diag 'zebrasrv started.'; - } else { - die 'unable to start zebrasrv'; - } - return $output; -} - -=head3 stop_zebrasrv - - using the PID file for the zebra server, send it a TERM signal with - "kill". We can't tell if the process actually dies or not. - -=cut - -sub stop_zebrasrv { - - my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' ); - if ( -e $pidfile ) { - open( my $pidh, '<', $pidfile ) - or return; - if ( defined $pidh ) { - my ( $pid ) = <$pidh> or return; - close $pidh; - my $killed = kill 15, $pid; # 15 is TERM - if ( $killed != 1 ) { - warn "unable to kill zebrasrv with pid: $pid"; - } - } - } -} - - -=head3 start_zebraqueue_daemon - - kick off a zebraqueue_daemon.pl process. - -=cut - -sub start_zebraqueue_daemon { - - my $command = q(run/bin/koha-zebraqueue-ctl.sh start); - diag $command; - my $started = system( $command ); - diag "started: $started"; - -} - -=head3 stop_zebraqueue_daemon - - -=cut - -sub stop_zebraqueue_daemon { - - my $command = q(run/bin/koha-zebraqueue-ctl.sh stop); - diag $command; - my $started = system( $command ); - diag "started: $started"; - -} - -1; diff --git a/t/lib/KohaTest/Accounts.pm b/t/lib/KohaTest/Accounts.pm deleted file mode 100644 index 703d478196..0000000000 --- a/t/lib/KohaTest/Accounts.pm +++ /dev/null @@ -1,30 +0,0 @@ -package KohaTest::Accounts; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Accounts; -sub testing_class { 'C4::Accounts' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( recordpayment - makepayment - getnextacctno - returnlost - manualinvoice - fixcredit - refund - getcharges - getcredits - getrefunds - ); # removed fixaccounts (unused by codebase) - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Acquisition.pm b/t/lib/KohaTest/Acquisition.pm deleted file mode 100644 index eca0b16c10..0000000000 --- a/t/lib/KohaTest/Acquisition.pm +++ /dev/null @@ -1,147 +0,0 @@ -package KohaTest::Acquisition; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Acquisition; -use C4::Context; -use C4::Members; -use Time::localtime; - -sub testing_class { 'C4::Acquisition' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( GetBasket - NewBasket - CloseBasket - GetPendingOrders - GetOrders - GetOrderNumber - GetOrder - NewOrder - ModOrder - ModOrderBiblioNumber - ModReceiveOrder - SearchOrder - DelOrder - GetParcel - GetParcels - GetLateOrders - GetHistory - GetRecentAcqui - ); - - can_ok( $self->testing_class, @methods ); -} - -=head3 create_new_basket - - creates a baseket by creating an order with no baseket number. - - named parameters: - authorizedby - invoice - date - - returns: baseket number, order number - - runs 4 tests - -=cut - -sub create_new_basket { - my $self = shift; - my %param = @_; - $param{'authorizedby'} = $self->{'memberid'} unless exists $param{'authorizedby'}; - $param{'invoice'} = 123 unless exists $param{'invoice'}; - - my $today = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900, - localtime->mon() + 1, - localtime->mday() ); - - # I actually think that this parameter is unused. - $param{'date'} = $today unless exists $param{'date'}; - - $self->add_biblios( add_items => 1 ); - ok( scalar @{$self->{'biblios'}} > 0, 'we have added at least one biblio' ); - - my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno, - $self->{'biblios'}[0], # $bibnum, - undef, # $title, - 1, # $quantity, - undef, # $listprice, - $self->{'booksellerid'}, # $booksellerid, - $param{'authorizedby'}, # $authorisedby, - undef, # $notes, - $self->{'bookfundid'}, # $bookfund, - undef, # $bibitemnum, - 1, # $rrp, - 1, # $ecost, - undef, # $gst, - undef, # $budget, - undef, # $cost, - undef, # $sub, - $param{'invoice'}, # $invoice, - undef, # $sort1, - undef, # $sort2, - undef, # $purchaseorder - ); - ok( $basketno, "my basket number is $basketno" ); - ok( $ordernumber, "my order number is $ordernumber" ); - - my $order = GetOrder( $ordernumber ); - is( $order->{'ordernumber'}, $ordernumber, 'got the right order' ) - or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) ); - - is( $order->{'budgetdate'}, $today, "the budget date is $today" ); - - # XXX should I stuff these in $self? - return ( $basketno, $ordernumber ); - -} - - -sub enable_independant_branches { - my $self = shift; - - my $member = GetMember( 'borrowernumber' =>$self->{'memberid'} ); - - C4::Context::set_userenv( 0, # usernum - $self->{'memberid'}, # userid - undef, # usercnum - undef, # userfirstname - undef, # usersurname - $member->{'branchcode'}, # userbranch - undef, # branchname - 0, # userflags - undef, # emailaddress - undef, # branchprinter - ); - - # set a preference. There's surely a method for this, but I can't find it. - my $retval = C4::Context->dbh->do( q(update systempreferences set value = '1' where variable = 'IndependantBranches') ); - ok( $retval, 'set the preference' ); - - ok( C4::Context->userenv, 'usernev' ); - isnt( C4::Context->userenv->{flags}, 1, 'flag != 1' ) - or diag( Data::Dumper->Dump( [ C4::Context->userenv ], [ 'userenv' ] ) ); - - is( C4::Context->userenv->{branch}, $member->{'branchcode'}, 'we have set the right branch in C4::Context: ' . $member->{'branchcode'} ); - -} - -sub disable_independant_branches { - my $self = shift; - - my $retval = C4::Context->dbh->do( q(update systempreferences set value = '0' where variable = 'IndependantBranches') ); - ok( $retval, 'set the preference back' ); - - -} -1; diff --git a/t/lib/KohaTest/Acquisition/GetHistory.pm b/t/lib/KohaTest/Acquisition/GetHistory.pm deleted file mode 100644 index 8c7c475337..0000000000 --- a/t/lib/KohaTest/Acquisition/GetHistory.pm +++ /dev/null @@ -1,157 +0,0 @@ -package KohaTest::Acquisition::GetHistory; -use base qw( KohaTest::Acquisition ); - -use strict; -use warnings; - -use Test::More; - -use C4::Acquisition; -use C4::Context; -use C4::Members; -use C4::Biblio; -use C4::Bookseller; - -=head3 no_history - - - -=cut - -sub no_history : Test( 4 ) { - my $self = shift; - - # my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on ) - - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory(); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 0, 'order_loop is empty' ); - is( $total_qty, 0, 'total_qty' ); - is( $total_price, 0, 'total_price' ); - is( $total_qtyreceived, 0, 'total_qtyreceived' ); - - -} - -=head3 one_order - -=cut - -sub one_order : Test( 50 ) { - my $self = shift; - - my ( $basketno, $ordernumber ) = $self->create_new_basket(); - ok( $basketno, "basketno is $basketno" ); - ok( $ordernumber, "ordernumber is $ordernumber" ); - - # No arguments fetches no history. - { - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory(); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 0, 'order_loop is empty' ); - is( $total_qty, 0, 'total_qty' ); - is( $total_price, 0, 'total_price' ); - is( $total_qtyreceived, 0, 'total_qtyreceived' ); - } - - my $bibliodata = GetBiblioData( $self->{'biblios'}[0] ); - ok( $bibliodata->{'title'}, 'the biblio has a title' ) - or diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) ); - - # searching by title should find it. - { - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $bibliodata->{'title'} ); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 1, 'order_loop searched by title' ); - is( $total_qty, 1, 'total_qty searched by title' ); - is( $total_price, 1, 'total_price searched by title' ); - is( $total_qtyreceived, 0, 'total_qtyreceived searched by title' ); - - # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) ); - } - - # searching by author - { - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, $bibliodata->{'author'} ); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 1, 'order_loop searched by author' ); - is( $total_qty, 1, 'total_qty searched by author' ); - is( $total_price, 1, 'total_price searched by author' ); - is( $total_qtyreceived, 0, 'total_qtyreceived searched by author' ); - } - - # searching by name - { - # diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) ); - - my $bookseller = GetBookSellerFromId( $self->{'booksellerid'} ); - ok( $bookseller->{'name'}, 'bookseller name' ) - or diag( Data::Dumper->Dump( [ $bookseller ], [ 'bookseller' ] ) ); - - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, $bookseller->{'name'} ); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 1, 'order_loop searched by name' ); - is( $total_qty, 1, 'total_qty searched by name' ); - is( $total_price, 1, 'total_price searched by name' ); - is( $total_qtyreceived, 0, 'total_qtyreceived searched by name' ); - } - - # searching by from_date - { - my $tomorrow = $self->tomorrow(); - # diag( "tomorrow is $tomorrow" ); - - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, undef, undef, $tomorrow ); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 1, 'order_loop searched by to_date' ); - is( $total_qty, 1, 'total_qty searched by to_date' ); - is( $total_price, 1, 'total_price searched by to_date' ); - is( $total_qtyreceived, 0, 'total_qtyreceived searched by to_date' ); - } - - # searching by from_date - { - my $yesterday = $self->yesterday(); - # diag( "yesterday was $yesterday" ); - - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, undef, $yesterday ); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 1, 'order_loop searched by from_date' ); - is( $total_qty, 1, 'total_qty searched by from_date' ); - is( $total_price, 1, 'total_price searched by from_date' ); - is( $total_qtyreceived, 0, 'total_qtyreceived searched by from_date' ); - } - - # set up some things necessary to make GetHistory use the IndependantBranches - $self->enable_independant_branches(); - - # just search by title here, we need to search by something. - { - my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $bibliodata->{'title'} ); - # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) ); - - is( scalar @$order_loop, 1, 'order_loop searched by title' ); - is( $total_qty, 1, 'total_qty searched by title' ); - is( $total_price, 1, 'total_price searched by title' ); - is( $total_qtyreceived, 0, 'total_qtyreceived searched by title' ); - - # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) ); - } - - # reset that. - $self->disable_independant_branches(); - - - - -} - - -1; diff --git a/t/lib/KohaTest/Acquisition/GetLateOrders.pm b/t/lib/KohaTest/Acquisition/GetLateOrders.pm deleted file mode 100644 index a2f95ea380..0000000000 --- a/t/lib/KohaTest/Acquisition/GetLateOrders.pm +++ /dev/null @@ -1,106 +0,0 @@ -package KohaTest::Acquisition::GetLateOrders; -use base qw( KohaTest::Acquisition ); - -use strict; -use warnings; - -use Test::More; - -use C4::Acquisition; -use C4::Context; -use C4::Members; - -=head3 no_orders - -=cut - -sub no_orders : Test( 1 ) { - my $self = shift; - - my @orders = GetLateOrders( 1 ); - is( scalar @orders, 0, 'There are no orders, so we found 0.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - -} - -=head3 one_order - -=cut - -sub one_order : Test( 29 ) { - my $self = shift; - - my ( $basketid, $ordernumber ) = $self->create_new_basket(); - ok( $basketid, 'a new basket was created' ); - ok( $ordernumber, 'the basket has an order in it.' ); - # we need this basket to be closed. - CloseBasket( $basketid ); - - my @orders = GetLateOrders( 0 ); - - { - my @orders = GetLateOrders( 0 ); - is( scalar @orders, 1, 'An order closed today is 0 days late.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - { - my @orders = GetLateOrders( 1 ); - is( scalar @orders, 0, 'An order closed today is not 1 day late.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - { - my @orders = GetLateOrders( -1 ); - is( scalar @orders, 1, 'an order closed today is -1 day late.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - - # provide some vendor information - { - my @orders = GetLateOrders( 0, $self->{'booksellerid'} ); - is( scalar @orders, 1, 'We found this late order with the right supplierid.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - { - my @orders = GetLateOrders( 0, $self->{'booksellerid'} + 1 ); - is( scalar @orders, 0, 'We found no late orders with the wrong supplierid.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - - # provide some branch information - my $member = GetMember( borrowernumber=>$self->{'memberid'} ); - # diag( Data::Dumper->Dump( [ $member ], [ 'member' ] ) ); - { - my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} ); - is( scalar @orders, 1, 'We found this late order with the right branchcode.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - { - my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' ); - is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - - # set up some things necessary to make GetLateOrders use the IndependantBranches - $self->enable_independant_branches(); - - { - my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} ); - is( scalar @orders, 1, 'We found this late order with the right branchcode.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - { - my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' ); - is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' ) - or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) ); - } - - # reset that. - $self->disable_independant_branches(); - -} - - - - - -1; diff --git a/t/lib/KohaTest/Acquisition/GetParcel.pm b/t/lib/KohaTest/Acquisition/GetParcel.pm deleted file mode 100644 index c26e5f2cb4..0000000000 --- a/t/lib/KohaTest/Acquisition/GetParcel.pm +++ /dev/null @@ -1,65 +0,0 @@ -package KohaTest::Acquisition::GetParcel; -use base qw( KohaTest::Acquisition ); - -use strict; -use warnings; - -use Test::More; -use Time::localtime; - -use C4::Acquisition; - -=head3 no_parcel - -at first, there should be no parcels for our bookseller. - -=cut - -sub no_parcel : Test( 1 ) { - my $self = shift; - - my @parcel = GetParcel( $self->{'booksellerid'}, undef, undef ); - is( scalar @parcel, 0, 'our new bookseller has no parcels' ) - or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) ); -} - -=head3 one_parcel - -we create an order, mark it as received, and then see if we can find -it with GetParcel. - -=cut - -sub one_parcel : Test( 17 ) { - my $self = shift; - - my $invoice = 123; # XXX what should this be? - - my $today = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900, - localtime->mon() + 1, - localtime->mday() ); - my ( $basketno, $ordernumber ) = $self->create_new_basket(); - - ok( $basketno, "my basket number is $basketno" ); - ok( $ordernumber, "my order number is $ordernumber" ); - my $datereceived = ModReceiveOrder( $self->{'biblios'}[0], # biblionumber - $ordernumber, # $ordernumber, - undef, # $quantrec, - undef, # $user, - undef, # $cost, - $invoice, # $invoiceno, - undef, # $freight, - undef, # $rrp, - $self->{'bookfundid'}, # $bookfund, - $today, # $datereceived - ); - is( $datereceived, $today, "the parcel was received on $datereceived" ); - - my @parcel = GetParcel( $self->{'booksellerid'}, $invoice, $today ); - is( scalar @parcel, 1, 'we found one (1) parcel.' ) - or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) ); - -} - -1; diff --git a/t/lib/KohaTest/Acquisition/GetParcels.pm b/t/lib/KohaTest/Acquisition/GetParcels.pm deleted file mode 100644 index fd3ad0fba8..0000000000 --- a/t/lib/KohaTest/Acquisition/GetParcels.pm +++ /dev/null @@ -1,289 +0,0 @@ -package KohaTest::Acquisition::GetParcels; -use base qw( KohaTest::Acquisition ); - -use strict; -use warnings; - -use Test::More; -use Time::localtime; - -use C4::Acquisition; - -=head2 NOTE - -Please do not confuse this with the test suite for C4::Acquisition::GetParcel. - -=head3 no_parcels - -at first, there should be no parcels for our bookseller. - -=cut - -sub no_parcels : Test( 1 ) { - my $self = shift; - - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - # order - # code ( aqorders.booksellerinvoicenumber ) - # datefrom - # date to - ); - - is( scalar @parcels, 0, 'our new bookseller has no parcels' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); -} - -=head3 one_parcel - -we create an order, mark it as received, and then see if we can find -it with GetParcels. - -=cut - -sub one_parcel : Test( 19 ) { - my $self = shift; - - my $invoice = 123; # XXX what should this be? - my $today = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900, - localtime->mon() + 1, - localtime->mday() ); - - $self->create_order( authorizedby => 1, # XXX what should this be? - invoice => $invoice, - date => $today ); - - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - # order - # code ( aqorders.booksellerinvoicenumber ) - # datefrom - # date to - ); - is( scalar @parcels, 1, 'we found one (1) parcel.' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - - my $thisparcel = shift( @parcels ); - is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' ) - or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); - - is( $thisparcel->{'datereceived'}, $today, 'datereceived' ); - is( $thisparcel->{'biblio'}, 1, 'biblio' ); - is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' ); - - # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); - -} - -=head3 two_parcels - -we create another order, mark it as received, and then see if we can find -them all with GetParcels. - -=cut - -sub two_parcels : Test( 31 ) { - my $self = shift; - - my $invoice = 1234; # XXX what should this be? - my $today = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900, - localtime->mon() + 1, - localtime->mday() ); - $self->create_order( authorizedby => 1, # XXX what should this be? - invoice => $invoice, - date => $today ); - - { - # fetch them all and check that this one is last - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - # order - # code ( aqorders.booksellerinvoicenumber ) - # datefrom - # date to - ); - is( scalar @parcels, 2, 'we found two (2) parcels.' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - - my $thisparcel = pop( @parcels ); - is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' ) - or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); - - is( $thisparcel->{'datereceived'}, $today, 'datereceived' ); - is( $thisparcel->{'biblio'}, 1, 'biblio' ); - is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' ); - } - - { - # fetch just one, by using the exact code - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - undef, # order - $invoice, # code ( aqorders.booksellerinvoicenumber ) - undef, # datefrom - undef, # date to - ); - is( scalar @parcels, 1, 'we found one (1) parcels.' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - - my $thisparcel = pop( @parcels ); - is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' ) - or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); - - is( $thisparcel->{'datereceived'}, $today, 'datereceived' ); - is( $thisparcel->{'biblio'}, 1, 'biblio' ); - is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' ); - } - - { - # fetch them both by using code 123, which gets 123 and 1234 - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - undef, # order - '123', # code ( aqorders.booksellerinvoicenumber ) - undef, # datefrom - undef, # date to - ); - is( scalar @parcels, 2, 'we found 2 parcels.' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - - } - - { - # fetch them both, and try to order them - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - 'aqorders.booksellerinvoicenumber', # order - undef, # code ( aqorders.booksellerinvoicenumber ) - undef, # datefrom - undef, # date to - ); - is( scalar @parcels, 2, 'we found 2 parcels.' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - is( $parcels[0]->{'booksellerinvoicenumber'}, 123 ); - is( $parcels[1]->{'booksellerinvoicenumber'}, 1234 ); - - } - - { - # fetch them both, and try to order them, descending - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - 'aqorders.booksellerinvoicenumber desc', # order - undef, # code ( aqorders.booksellerinvoicenumber ) - undef, # datefrom - undef, # date to - ); - is( scalar @parcels, 2, 'we found 2 parcels.' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - is( $parcels[0]->{'booksellerinvoicenumber'}, 1234 ); - is( $parcels[1]->{'booksellerinvoicenumber'}, 123 ); - - } - - - - - # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); - -} - - -=head3 z_several_parcels_with_different_dates - -we create an order, mark it as received, and then see if we can find -it with GetParcels. - -=cut - -sub z_several_parcels_with_different_dates : Test( 44 ) { - my $self = shift; - - my $authorizedby = 1; # XXX what should this be? - - my @inputs = ( { invoice => 10, - date => sprintf( '%04d-%02d-%02d', - 1950, - localtime->mon() + 1, - 10 ), # I'm using the invoice number as the day. - }, - { invoice => 15, - date => sprintf( '%04d-%02d-%02d', - 1950, - localtime->mon() + 1, - 15 ), # I'm using the invoice number as the day. - }, - { invoice => 20, - date => sprintf( '%04d-%02d-%02d', - 1950, - localtime->mon() + 1, - 20 ), # I'm using the invoice number as the day. - }, - ); - - foreach my $input ( @inputs ) { - $self->create_order( authorizedby => $authorizedby, - invoice => $input->{'invoice'}, - date => $input->{'date'}, - ); - } - - my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - undef, # order - undef, # code ( aqorders.booksellerinvoicenumber ) - sprintf( '%04d-%02d-%02d', - 1950, - localtime->mon() + 1, - 10 ), # datefrom - sprintf( '%04d-%02d-%02d', - 1950, - localtime->mon() + 1, - 20 ), # dateto - ); - is( scalar @parcels, scalar @inputs, 'we found all of the parcels.' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - - @parcels = GetParcels( $self->{'booksellerid'}, # bookseller - undef, # order - undef, # code ( aqorders.booksellerinvoicenumber ) - sprintf( '%04d-%02d-%02d', - 1950, - localtime->mon() + 1, - 10 ), # datefrom - sprintf( '%04d-%02d-%02d', - 1950, - localtime->mon() + 1, - 16 ), # dateto - ); - is( scalar @parcels, scalar @inputs - 1, 'we found all of the parcels except one' ) - or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) ); - - - - # diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) ); - -} - -sub create_order { - my $self = shift; - my %param = @_; - $param{'authorizedby'} = 1 unless exists $param{'authorizedby'}; - $param{'invoice'} = 1 unless exists $param{'invoice'}; - $param{'date'} = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900, - localtime->mon() + 1, - localtime->mday() ) unless exists $param{'date'}; - - my ( $basketno, $ordernumber ) = $self->create_new_basket( %param ); - - my $datereceived = ModReceiveOrder( $self->{'biblios'}[0], # biblionumber - $ordernumber, # $ordernumber, - undef, # $quantrec, - undef, # $user, - undef, # $cost, - $param{'invoice'}, # $invoiceno, - undef, # $freight, - undef, # $rrp, - $self->{'bookfundid'}, # $bookfund, - $param{'date'}, # $datereceived - ); - is( $datereceived, $param{'date'}, "the parcel was received on $datereceived" ); - -} - -1; diff --git a/t/lib/KohaTest/Acquisition/GetPendingOrders.pm b/t/lib/KohaTest/Acquisition/GetPendingOrders.pm deleted file mode 100644 index cf4bb1551a..0000000000 --- a/t/lib/KohaTest/Acquisition/GetPendingOrders.pm +++ /dev/null @@ -1,82 +0,0 @@ -package KohaTest::Acquisition::GetPendingOrders; -use base qw( KohaTest::Acquisition ); - -use strict; -use warnings; - -use Test::More; - -use C4::Acquisition; - -=head3 no_orders - -at first, there should be no orders for our bookseller. - -=cut - -sub no_orders : Test( 1 ) { - my $self = shift; - - my $orders = GetPendingOrders( $self->{'booksellerid'} ); - is( scalar @$orders, 0, 'our new bookseller has no pending orders' ) - or diag( Data::Dumper->Dump( [ $orders ], [ 'orders' ] ) ); -} - -=head3 new_order - -we make an order, then see if it shows up in the pending orders - -=cut - -sub one_new_order : Test( 49 ) { - my $self = shift; - - my ( $basketno, $ordernumber ) = $self->create_new_basket(); - - ok( $basketno, "basketno is $basketno" ); - ok( $ordernumber, "ordernumber is $ordernumber" ); - - my $orders = GetPendingOrders( $self->{'booksellerid'} ); - is( scalar @$orders, 1, 'we successfully entered one order.' ); - - my @expectedfields = qw( basketno - biblioitemnumber - biblionumber - booksellerinvoicenumber - budgetdate - cancelledby - closedate - creationdate - currency - datecancellationprinted - datereceived - ecost - entrydate - firstname - freight - gst - listprice - notes - ordernumber - purchaseordernumber - quantity - quantityreceived - rrp - serialid - sort1 - sort2 - subscription - supplierreference - surname - timestamp - title - totalamount - unitprice ); - my $firstorder = $orders->[0]; - for my $field ( @expectedfields ) { - ok( exists( $firstorder->{ $field } ), "This order has a $field field" ); - } - -} - -1; diff --git a/t/lib/KohaTest/Acquisition/NewOrder.pm b/t/lib/KohaTest/Acquisition/NewOrder.pm deleted file mode 100644 index 972cde2f5d..0000000000 --- a/t/lib/KohaTest/Acquisition/NewOrder.pm +++ /dev/null @@ -1,108 +0,0 @@ -package KohaTest::Acquisition::NewOrder; -use base qw( KohaTest::Acquisition ); - -use strict; -use warnings; - -use Test::More; -use Time::localtime; - -use C4::Acquisition; - -=head3 new_order_no_budget - -If we make a new order and don't pass in a budget date, it defaults to -today. - -=cut - -sub new_order_no_budget : Test( 4 ) { - my $self = shift; - - my $authorizedby = 1; # XXX what should this be? - my $invoice = 123; # XXX what should this be? - my $today = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900, - localtime->mon() + 1, - localtime->mday() ); - my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno, - 1, # $bibnum, - undef, # $title, - undef, # $quantity, - undef, # $listprice, - $self->{'booksellerid'}, # $booksellerid, - $authorizedby, # $authorisedby, - undef, # $notes, - $self->{'bookfundid'}, # $bookfund, - undef, # $bibitemnum, - undef, # $rrp, - undef, # $ecost, - undef, # $gst, - undef, # $budget, - undef, # $cost, - undef, # $sub, - $invoice, # $invoice, - undef, # $sort1, - undef, # $sort2, - undef, # $purchaseorder, - undef, # $branchcode - ); - ok( $basketno, "my basket number is $basketno" ); - ok( $ordernumber, "my order number is $ordernumber" ); - - my $order = GetOrder( $ordernumber ); - is( $order->{'ordernumber'}, $ordernumber, 'got the right order' ) - or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) ); - - is( $order->{'budgetdate'}, $today, "the budget date is $today" ); -} - -=head3 new_order_set_budget - -Let's set the budget date of this new order. It actually pretty much -only pays attention to the current month and year. - -=cut - -sub new_order_set_budget : Test( 4 ) { - my $self = shift; - - my $authorizedby = 1; # XXX what should this be? - my $invoice = 123; # XXX what should this be? - my $today = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900, - localtime->mon() + 1, - localtime->mday() ); - my ( $basketno, $ordernumber ) = NewOrder( undef, # $basketno, - 1, # $bibnum, - undef, # $title, - undef, # $quantity, - undef, # $listprice, - $self->{'booksellerid'}, # $booksellerid, - $authorizedby, # $authorisedby, - undef, # $notes, - $self->{'bookfundid'}, # $bookfund, - undef, # $bibitemnum, - undef, # $rrp, - undef, # $ecost, - undef, # $gst, - 'does not matter, just not undef', # $budget, - undef, # $cost, - undef, # $sub, - $invoice, # $invoice, - undef, # $sort1, - undef, # $sort2, - undef, # $purchaseorder, - undef, # $branchcode - ); - ok( $basketno, "my basket number is $basketno" ); - ok( $ordernumber, "my order number is $ordernumber" ); - - my $order = GetOrder( $ordernumber ); - is( $order->{'ordernumber'}, $ordernumber, 'got the right order' ) - or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) ); - - like( $order->{'budgetdate'}, qr(^2\d\d\d-07-01$), "the budget date ($order->{'budgetdate'}) is a July 1st." ); -} - -1; diff --git a/t/lib/KohaTest/AuthoritiesMarc.pm b/t/lib/KohaTest/AuthoritiesMarc.pm deleted file mode 100644 index 6114843ca4..0000000000 --- a/t/lib/KohaTest/AuthoritiesMarc.pm +++ /dev/null @@ -1,41 +0,0 @@ -package KohaTest::AuthoritiesMarc; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::AuthoritiesMarc; -sub testing_class { 'C4::AuthoritiesMarc' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( GetAuthMARCFromKohaField - SearchAuthorities - CountUsage - CountUsageChildren - GetAuthTypeCode - GetTagsLabels - AddAuthority - DelAuthority - ModAuthority - GetAuthorityXML - GetAuthority - GetAuthType - AUTHhtml2marc - FindDuplicateAuthority - BuildSummary - BuildUnimarcHierarchies - BuildUnimarcHierarchy - GetHeaderAuthority - AddAuthorityTrees - merge - get_auth_type_location - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Biblio.pm b/t/lib/KohaTest/Biblio.pm deleted file mode 100644 index 3e6634cb48..0000000000 --- a/t/lib/KohaTest/Biblio.pm +++ /dev/null @@ -1,73 +0,0 @@ -package KohaTest::Biblio; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Biblio; -sub testing_class { 'C4::Biblio' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - AddBiblio - ModBiblio - ModBiblioframework - DelBiblio - LinkBibHeadingsToAuthorities - GetBiblioData - GetBiblioItemData - GetBiblioItemByBiblioNumber - GetBiblioFromItemNumber - GetBiblio - GetBiblioItemInfosOf - GetMarcStructure - GetUsedMarcStructure - GetMarcFromKohaField - GetMarcBiblio - GetXmlBiblio - GetAuthorisedValueDesc - GetMarcNotes - GetMarcSubjects - GetMarcAuthors - GetMarcUrls - GetMarcSeries - GetFrameworkCode - GetPublisherNameFromIsbn - TransformKohaToMarc - TransformKohaToMarcOneField - TransformHtmlToXml - TransformHtmlToMarc - TransformMarcToKoha - _get_inverted_marc_field_map - _disambiguate - get_koha_field_from_marc - TransformMarcToKohaOneField - PrepareItemrecordDisplay - ModZebra - GetNoZebraIndexes - _DelBiblioNoZebra - _AddBiblioNoZebra - _find_value - _koha_marc_update_bib_ids - _koha_marc_update_biblioitem_cn_sort - _koha_add_biblio - _koha_modify_biblio - _koha_modify_biblioitem_nonmarc - _koha_add_biblioitem - _koha_delete_biblio - _koha_delete_biblioitems - ModBiblioMarc - z3950_extended_services - set_service_options - get_biblio_authorised_values - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Biblio/GetNoZebraIndexes.pm b/t/lib/KohaTest/Biblio/GetNoZebraIndexes.pm deleted file mode 100644 index 11dffbefd2..0000000000 --- a/t/lib/KohaTest/Biblio/GetNoZebraIndexes.pm +++ /dev/null @@ -1,72 +0,0 @@ -package KohaTest::Biblio::GetNoZebraIndexes; -use base qw( KohaTest::Biblio ); - -use strict; -use warnings; - -use Test::More; - -use C4::Biblio; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - - -=head2 TEST METHODS - -standard test methods - -=head3 - -=cut - -sub returns_expected_hashref : Test(2) { - my $self = shift; - - my %nzi = C4::Biblio::GetNoZebraIndexes(); - ok( scalar keys %nzi, 'got some keys from GetNoZebraIndexes' ); - - my %expected = ( - 'title' => '130a,210a,222a,240a,243a,245a,245b,246a,246b,247a,247b,250a,250b,440a,830a', - 'author' => '100a,100b,100c,100d,110a,111a,111b,111c,111d,245c,700a,710a,711a,800a,810a,811a', - 'isbn' => '020a', - 'issn' => '022a', - 'lccn' => '010a', - 'biblionumber' => '999c', - 'itemtype' => '942c', - 'publisher' => '260b', - 'date' => '260c', - 'note' => '500a,501a,504a,505a,508a,511a,518a,520a,521a,522a,524a,526a,530a,533a,538a,541a,546a,555a,556a,562a,563a,583a,585a,582a', - 'subject' => '600*,610*,611*,630*,650*,651*,653*,654*,655*,662*,690*', - 'dewey' => '082', - 'bc' => '952p', - 'callnum' => '952o', - 'an' => '6009,6109,6119', - 'homebranch' => '952a,952c' - ); - is_deeply( \%nzi, \%expected, 'GetNoZebraIndexes returns the expected hashref' ); -} - -=head2 HELPER METHODS - -These methods are used by other test methods, but -are not meant to be called directly. - -=cut - -=cut - - -=head2 SHUTDOWN METHODS - -These get run once, after the main test methods in this module - -=head3 - -=cut - - -1; diff --git a/t/lib/KohaTest/Biblio/ModBiblio.pm b/t/lib/KohaTest/Biblio/ModBiblio.pm deleted file mode 100644 index 5b29ea8b61..0000000000 --- a/t/lib/KohaTest/Biblio/ModBiblio.pm +++ /dev/null @@ -1,154 +0,0 @@ -package KohaTest::Biblio::ModBiblio; -use base qw( KohaTest::Biblio ); - -use strict; -use warnings; - -use Test::More; - -use C4::Biblio; -use C4::Items; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=head3 add_bib_to_modify - -=cut - -sub add_bib_to_modify : Test( startup => 3 ) { - my $self = shift; - - my $bib = MARC::Record->new(); - $bib->leader(' ngm a22 7a 4500'); - $bib->append_fields( - MARC::Field->new('100', ' ', ' ', a => 'Moffat, Steven'), - MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'), - ); - - my ($bibnum, $bibitemnum) = AddBiblio($bib, ''); - $self->{'bib_to_modify'} = $bibnum; - - # add an item - my ($item_bibnum, $item_bibitemnum, $itemnumber) = AddItem({ homebranch => 'CPL', holdingbranch => 'CPL' } , $bibnum); - - cmp_ok($item_bibnum, '==', $bibnum, "new item is linked to correct biblionumber"); - cmp_ok($item_bibitemnum, '==', $bibitemnum, "new item is linked to correct biblioitemnumber"); - - $self->reindex_marc(); - - my $marc = $self->fetch_bib($bibnum); - $self->sort_item_and_bibnumber_fields($marc); - $self->{'bib_to_modify_formatted'} = $marc->as_formatted(); # simple way to compare later -} - -=head2 TEST METHODS - -standard test methods - -=head3 bug_2297 - -Regression test for bug 2297 (saving a subscription duplicates MARC item fields) - -=cut - -sub bug_2297 : Test( 5 ) { - my $self = shift; - - my $bibnum = $self->{'bib_to_modify'}; - my $marc = $self->fetch_bib($bibnum); - $self->check_item_count($marc, 1); - - ModBiblio($marc, $bibnum, ''); # no change made to bib - - my $modified_marc = $self->fetch_bib($bibnum); - diag "checking item field count after null modification"; - $self->check_item_count($modified_marc, 1); - - $self->sort_item_and_bibnumber_fields($modified_marc); - is($modified_marc->as_formatted(), $self->{'bib_to_modify_formatted'}, "no change to bib after null modification"); -} - -=head2 HELPER METHODS - -These methods are used by other test methods, but -are not meant to be called directly. - -=cut - -=head3 fetch_bib - -=cut - -sub fetch_bib { # +1 to test count per call - my $self = shift; - my $bibnum = shift; - - my $marc = GetMarcBiblio($bibnum); - ok(defined($marc), "retrieved bib record $bibnum"); - - return $marc; -} - -=head3 check_item_count - -=cut - -sub check_item_count { # +1 to test count per call - my $self = shift; - my $marc = shift; - my $expected_items = shift; - - my ($itemtag, $itemsubfield) = GetMarcFromKohaField("items.itemnumber", ''); - my @item_fields = $marc->field($itemtag); - cmp_ok(scalar(@item_fields), "==", $expected_items, "exactly one item field"); -} - -=head3 sort_item_and_bibnumber_fields - -This method sorts the field containing the embedded item data -and the bibnumber - ModBiblio(), AddBiblio(), and ModItem() do -not guarantee that these fields will be sorted in tag order. - -=cut - -sub sort_item_and_bibnumber_fields { - my $self = shift; - my $marc = shift; - - my ($itemtag, $itemsubfield) = GetMarcFromKohaField("items.itemnumber", ''); - my ($bibnumtag, $bibnumsubfield) = GetMarcFromKohaField("biblio.biblionumber", ''); - - my @item_fields = (); - foreach my $field ($marc->field($itemtag)) { - push @item_fields, $field; - $marc->delete_field($field); - } - $marc->insert_fields_ordered(@item_fields) if scalar(@item_fields);; - - my @bibnum_fields = (); - foreach my $field ($marc->field($bibnumtag)) { - push @bibnum_fields, $field; - $marc->delete_field($field); - } - $marc->insert_fields_ordered(@bibnum_fields) if scalar(@bibnum_fields); - -} - -=head2 SHUTDOWN METHODS - -These get run once, after the main test methods in this module - -=head3 shutdown_clean_object - -=cut - -sub shutdown_clean_object : Test( shutdown => 0 ) { - my $self = shift; - - delete $self->{'bib_to_modify'}; - delete $self->{'bib_to_modify_formatted'}; -} - -1; diff --git a/t/lib/KohaTest/Biblio/get_biblio_authorised_values.pm b/t/lib/KohaTest/Biblio/get_biblio_authorised_values.pm deleted file mode 100644 index aab03a0e55..0000000000 --- a/t/lib/KohaTest/Biblio/get_biblio_authorised_values.pm +++ /dev/null @@ -1,48 +0,0 @@ -package KohaTest::Biblio::get_biblio_authorised_values; -use base qw( KohaTest::Biblio ); - -use strict; -use warnings; - -use Test::More; - -use C4::Biblio; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=head3 insert_test_data - -=cut - -sub insert_test_data : Test( startup => 71 ) { - my $self = shift; - - # I'm going to add a bunch of biblios so that I can search for them. - $self->add_biblios( count => 10, - add_items => 1 ); - - -} - -=head2 TEST METHODS - -standard test methods - -=head3 basic_test - -basic usage. - -=cut - -sub basic_test : Test( 1 ) { - my $self = shift; - - ok( $self->{'biblios'}[0], 'we have a biblionumber' ); - my $authorised_values = C4::Biblio::get_biblio_authorised_values( $self->{'biblios'}[0] ); - diag( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) ); - -} - -1; diff --git a/t/lib/KohaTest/Branch.pm b/t/lib/KohaTest/Branch.pm deleted file mode 100644 index ce7ff603f5..0000000000 --- a/t/lib/KohaTest/Branch.pm +++ /dev/null @@ -1,36 +0,0 @@ -package KohaTest::Branch; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Branch; -sub testing_class { 'C4::Branch' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( GetBranches - GetBranchName - ModBranch - GetBranchCategory - GetBranchCategories - GetCategoryTypes - GetBranch - GetBranchDetail - get_branchinfos_of - GetBranchesInCategory - GetBranchInfo - DelBranch - ModBranchCategoryInfo - DelBranchCategory - CheckBranchCategorycode - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Branch/GetBranches.pm b/t/lib/KohaTest/Branch/GetBranches.pm deleted file mode 100644 index 1dc5d0fcc5..0000000000 --- a/t/lib/KohaTest/Branch/GetBranches.pm +++ /dev/null @@ -1,41 +0,0 @@ -package KohaTest::Branch::GetBranches; -use base qw( KohaTest::Branch ); - -use strict; -use warnings; - -use Test::More; - -use C4::Branch; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head2 TEST METHODS - -standard test methods - -=head3 onlymine - - When you pass in something true to GetBranches, it limits the - response to only your branch. - -=cut - -sub onlymine : Test( 4 ) { - my $self = shift; - - # C4::Branch::GetBranches uses this variable, so make sure it exists. - ok( C4::Context->userenv->{'branch'}, 'we have a branch' ); - my $branches = C4::Branch::GetBranches( 'onlymine' ); - # diag( Data::Dumper->Dump( [ $branches ], [ 'branches' ] ) ); - is( scalar( keys %$branches ), 1, 'one key for our branch only' ); - ok( exists $branches->{ C4::Context->userenv->{'branch'} }, 'my branch was returned' ); - is( $branches->{ C4::Context->userenv->{'branch'} }->{'branchcode'}, C4::Context->userenv->{'branch'}, 'branchcode' ); - -} - -1; diff --git a/t/lib/KohaTest/Breeding.pm b/t/lib/KohaTest/Breeding.pm deleted file mode 100644 index d098ae5ffa..0000000000 --- a/t/lib/KohaTest/Breeding.pm +++ /dev/null @@ -1,23 +0,0 @@ -package KohaTest::Breeding; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Breeding; -sub testing_class { 'C4::Breeding' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( ImportBreeding - BreedingSearch - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Calendar.pm b/t/lib/KohaTest/Calendar.pm deleted file mode 100644 index 8b1cda74d0..0000000000 --- a/t/lib/KohaTest/Calendar.pm +++ /dev/null @@ -1,34 +0,0 @@ -package KohaTest::Calendar; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Calendar; -sub testing_class { 'C4::Calendar' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( new - get_week_days_holidays - get_day_month_holidays - get_exception_holidays - get_single_holidays - insert_week_day_holiday - insert_day_month_holiday - insert_single_holiday - insert_exception_holiday - delete_holiday - isHoliday - addDate - daysBetween - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Calendar/New.pm b/t/lib/KohaTest/Calendar/New.pm deleted file mode 100644 index 745366b434..0000000000 --- a/t/lib/KohaTest/Calendar/New.pm +++ /dev/null @@ -1,186 +0,0 @@ -package KohaTest::Calendar::New; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Calendar; -sub testing_class { 'C4::Calendar' }; - - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head2 TEST METHODS - -standard test methods - -=head3 instantiation - - just test to see if I can instantiate an object - -=cut - -sub instantiation : Test( 14 ) { - my $self = shift; - - my $calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - - ok( exists $calendar->{'day_month_holidays'}, 'day_month_holidays' ); - ok( exists $calendar->{'single_holidays'}, 'single_holidays' ); - ok( exists $calendar->{'week_days_holidays'}, 'week_days_holidays' ); - ok( exists $calendar->{'exception_holidays'}, 'exception_holidays' ); - - # sample data has Sundays as a holiday - ok( exists $calendar->{'week_days_holidays'}->{'0'} ); - is( $calendar->{'week_days_holidays'}->{'0'}->{'title'}, '', 'Sunday title' ); - is( $calendar->{'week_days_holidays'}->{'0'}->{'description'}, 'Sundays', 'Sunday description' ); - - # sample data has Christmas as a holiday - ok( exists $calendar->{'day_month_holidays'}->{'12/25'} ); - is( $calendar->{'day_month_holidays'}->{'12/25'}->{'title'}, '', 'Christmas title' ); - is( $calendar->{'day_month_holidays'}->{'12/25'}->{'description'}, 'Christmas', 'Christmas description' ); - - # sample data has New Year's Day as a holiday - ok( exists $calendar->{'day_month_holidays'}->{'1/1'} ); - is( $calendar->{'day_month_holidays'}->{'1/1'}->{'title'}, '', 'New Year title' ); - is( $calendar->{'day_month_holidays'}->{'1/1'}->{'description'}, q(New Year's Day), 'New Year description' ); - -} - -sub week_day_holidays : Test( 8 ) { - my $self = shift; - - my $calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - - ok( exists $calendar->{'week_days_holidays'}, 'week_days_holidays' ); - - my %new_holiday = ( weekday => 1, - title => 'example week_day_holiday', - description => 'This is an example week_day_holiday used for testing' ); - my $new_calendar = $calendar->insert_week_day_holiday( %new_holiday ); - - # the calendar object returned from insert_week_day_holiday should be updated - isa_ok( $new_calendar, 'C4::Calendar' ); - is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'description'}, $new_holiday{'description'}, 'description' ); - - # new calendar objects should have the newly inserted holiday. - my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $refreshed_calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'week_days_holidays'}->{ $new_holiday{'weekday'} }->{'description'}, $new_holiday{'description'}, 'description' ); - -} - - -sub day_month_holidays : Test( 8 ) { - my $self = shift; - - my $calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - - ok( exists $calendar->{'day_month_holidays'}, 'day_month_holidays' ); - - my %new_holiday = ( day => 4, - month => 5, - title => 'example day_month_holiday', - description => 'This is an example day_month_holiday used for testing' ); - my $new_calendar = $calendar->insert_day_month_holiday( %new_holiday ); - - # the calendar object returned from insert_week_day_holiday should be updated - isa_ok( $new_calendar, 'C4::Calendar' ); - my $mmdd = sprintf('%s/%s', $new_holiday{'month'}, $new_holiday{'day'} ) ; - is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'description'}, $new_holiday{'description'}, 'description' ); - - # new calendar objects should have the newly inserted holiday. - my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $refreshed_calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'day_month_holidays'}->{ $mmdd }->{'description'}, $new_holiday{'description'}, 'description' ); - -} - - - -sub exception_holidays : Test( 8 ) { - my $self = shift; - - my $calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - - ok( exists $calendar->{'exception_holidays'}, 'exception_holidays' ); - - my %new_holiday = ( day => 4, - month => 5, - year => 2010, - title => 'example exception_holiday', - description => 'This is an example exception_holiday used for testing' ); - my $new_calendar = $calendar->insert_exception_holiday( %new_holiday ); - # diag( Data::Dumper->Dump( [ $new_calendar ], [ 'newcalendar' ] ) ); - - # the calendar object returned from insert_week_day_holiday should be updated - isa_ok( $new_calendar, 'C4::Calendar' ); - my $yyyymmdd = sprintf('%s/%s/%s', $new_holiday{'year'}, $new_holiday{'month'}, $new_holiday{'day'} ) ; - is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); - - # new calendar objects should have the newly inserted holiday. - my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $refreshed_calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'exception_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); - -} - - -sub single_holidays : Test( 8 ) { - my $self = shift; - - my $calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - - ok( exists $calendar->{'single_holidays'}, 'single_holidays' ); - - my %new_holiday = ( day => 4, - month => 5, - year => 2011, - title => 'example single_holiday', - description => 'This is an example single_holiday used for testing' ); - my $new_calendar = $calendar->insert_single_holiday( %new_holiday ); - # diag( Data::Dumper->Dump( [ $new_calendar ], [ 'newcalendar' ] ) ); - - # the calendar object returned from insert_week_day_holiday should be updated - isa_ok( $new_calendar, 'C4::Calendar' ); - my $yyyymmdd = sprintf('%s/%s/%s', $new_holiday{'year'}, $new_holiday{'month'}, $new_holiday{'day'} ) ; - is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); - - # new calendar objects should have the newly inserted holiday. - my $refreshed_calendar = C4::Calendar->new( branchcode => '' ); - isa_ok( $refreshed_calendar, 'C4::Calendar' ); - # diag( Data::Dumper->Dump( [ $calendar ], [ 'calendar' ] ) ); - is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'title'}, $new_holiday{'title'}, 'title' ); - is( $new_calendar->{'single_holidays'}->{ $yyyymmdd }->{'description'}, $new_holiday{'description'}, 'description' ); - -} - - -1; - diff --git a/t/lib/KohaTest/Category.pm b/t/lib/KohaTest/Category.pm deleted file mode 100644 index 3febfda916..0000000000 --- a/t/lib/KohaTest/Category.pm +++ /dev/null @@ -1,23 +0,0 @@ -package KohaTest::Category; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Category; -sub testing_class { 'C4::Category' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new - all - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Circulation.pm b/t/lib/KohaTest/Circulation.pm deleted file mode 100644 index 7d5e69d2ac..0000000000 --- a/t/lib/KohaTest/Circulation.pm +++ /dev/null @@ -1,142 +0,0 @@ -package KohaTest::Circulation; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Circulation; -sub testing_class { 'C4::Circulation' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( barcodedecode - decode - transferbook - TooMany - itemissues - CanBookBeIssued - AddIssue - GetLoanLength - GetIssuingRule - GetBranchBorrowerCircRule - AddReturn - MarkIssueReturned - _FixOverduesOnReturn - _FixAccountForLostAndReturned - GetItemIssue - GetItemIssues - GetBiblioIssues - GetUpcomingDueIssues - CanBookBeRenewed - AddRenewal - GetRenewCount - GetIssuingCharges - AddIssuingCharge - GetTransfers - GetTransfersFromTo - DeleteTransfer - AnonymiseIssueHistory - updateWrongTransfer - UpdateHoldingbranch - CalcDateDue - CheckValidDatedue - CheckRepeatableHolidays - CheckSpecialHolidays - CheckRepeatableSpecialHolidays - CheckValidBarcode - ); - - can_ok( $self->testing_class, @methods ); -} - -=head3 setup_add_biblios - -everything in the C4::Circulation really requires items, so let's do this in the setup phase. - -=cut - -sub setup_add_biblios : Tests( setup => 8 ) { - my $self = shift; - - # we want to use a fresh batch of items, so clear these lists: - delete $self->{'items'}; - delete $self->{'biblios'}; - - $self->add_biblios( add_items => 1 ); -} - - -=head3 checkout_first_item - -named parameters: - borrower => borrower hashref, computed from $self->{'memberid'} if not given - barcode => item barcode, barcode of $self->{'items'}[0] if not given - issuedate => YYYY-MM-DD of date to mark issue checked out. defaults to today. - -=cut - -sub checkout_first_item { - my $self = shift; - my $params = shift; - - # get passed in borrower, or default to the one in $self. - my $borrower = $params->{'borrower'}; - if ( ! defined $borrower ) { - my $borrowernumber = $self->{'memberid'}; - $borrower = C4::Members::GetMemberDetails( $borrowernumber ); - } - - # get the barcode passed in, or default to the first one in the items list - my $barcode = $params->{'barcode'}; - if ( ! defined $barcode ) { - return unless $self->{'items'}[0]{'itemnumber'}; - $barcode = $self->get_barcode_from_itemnumber( $self->{'items'}[0]{'itemnumber'} ); - } - - # get issuedate from parameters. Default to undef, which will be interpreted as today - my $issuedate = $params->{'issuedate'}; - - my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode ); - - my $datedue = C4::Circulation::AddIssue( - $borrower, # borrower - $barcode, # barcode - undef, # datedue - undef, # cancelreserve - $issuedate # issuedate - ); - - my $issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - - return $issues->{'date_due'}; -} - -=head3 get_barcode_from_itemnumber - -pass in an itemnumber, returns a barcode. - -Should this get moved up to KohaTest.pm? Or, is there a better alternative in C4? - -=cut - -sub get_barcode_from_itemnumber { - my $self = shift; - my $itemnumber = shift; - - my $sql = <dbh() or return; - my $sth = $dbh->prepare($sql) or return; - $sth->execute($itemnumber) or return; - my ($barcode) = $sth->fetchrow_array; - return $barcode; -} - -1; - diff --git a/t/lib/KohaTest/Circulation/AddIssue.pm b/t/lib/KohaTest/Circulation/AddIssue.pm deleted file mode 100644 index 2c3e3932ce..0000000000 --- a/t/lib/KohaTest/Circulation/AddIssue.pm +++ /dev/null @@ -1,132 +0,0 @@ -package KohaTest::Circulation::AddIssue; -use base qw(KohaTest::Circulation); - -use strict; -use warnings; - -use Test::More; - -=head2 basic_usage - -basic usage of C4::Circulation::AddIssue - -Note: This logic is repeated in -KohaTest::Circulation::checkout_first_item, but without tests. This -includes tests at each step to make it easier to track down what's -broken as we go along. - -=cut - -sub basic_usage : Test( 13 ) { - my $self = shift; - - my $borrowernumber = $self->{'memberid'}; - ok( $borrowernumber, "we're going to work with borrower: $borrowernumber" ); - - my $borrower = C4::Members::GetMemberDetails( $borrowernumber ); - ok( $borrower, '...and we were able to look up that borrower' ); - is( $borrower->{'borrowernumber'}, $borrowernumber, '...and they have the right borrowernumber' ); - - my $itemnumber = $self->{'items'}[0]{'itemnumber'}; - ok( $itemnumber, "We're going to checkout itemnumber $itemnumber" ); - my $barcode = $self->get_barcode_from_itemnumber($itemnumber); - ok( $barcode, "...which has barcode $barcode" ); - - my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - # Note that we can't check for $before_issues as undef because GetItemIssue always returns a populated hashref - ok( ! defined $before_issues->{'borrowernumber'}, '...and is not currently checked out' ) - or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); - - my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode ); - is( scalar keys %$issuingimpossible, 0, 'the item CanBookBeIssued' ) - or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); - is( scalar keys %$needsconfirmation, 0, '...and the transaction does not needsconfirmation' ) - or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); - - # bug 2758 don't ask for confirmation if patron has $0.00 account balance - # and IssuingInProcess is on - my $orig_issuing_in_process = C4::Context->preference('IssuingInProcess'); - my $dbh = C4::Context->dbh; - $dbh->do("UPDATE systempreferences SET value = 1 WHERE variable = 'IssuingInProcess'"); - C4::Context->clear_syspref_cache(); # FIXME not needed after a syspref mutator is written - ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $barcode ); - is( scalar keys %$issuingimpossible, 0, 'the item CanBookBeIssued with IssuingInProcess ON (bug 2758)' ) - or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); - is( scalar keys %$needsconfirmation, 0, - '...and the transaction does not needsconfirmation with IssuingInProcess ON (bug 2758)' ) - or diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); - $dbh->do("UPDATE systempreferences SET value = ? WHERE variable = 'IssuingInProcess'", {}, $orig_issuing_in_process); - C4::Context->clear_syspref_cache(); # FIXME not needed after a syspref mutator is written - - my $datedue = C4::Circulation::AddIssue( $borrower, $barcode ); - ok( $datedue, "the item has been issued and it is due: $datedue" ); - - my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - is( $after_issues->{'borrowernumber'}, $borrowernumber, '...and now it is checked out to our borrower' ) - or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); - - my $loanlength = Date::Calc::Delta_Days( split( /-/, $after_issues->{'issuedate'} ), split( /-/, $after_issues->{'date_due'} ) ); - ok( $loanlength, "the loanlength is $loanlength days" ); - - # save this here since we refer to it in set_issuedate. - $self->{'loanlength'} = $loanlength; - -} - -=head2 set_issuedate - -Make sure that we can set the issuedate of an issue. - -Also, since we are specifying an issuedate and not a due date, the due -date should be calculated from the issuedate, not today. - -=cut - -sub set_issuedate : Test( 7 ) { - my $self = shift; - - my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - ok( ! defined $before_issues->{'borrowernumber'}, 'At this beginning, this item was not checked out.' ) - or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); - - my $issuedate = $self->random_date(); - ok( $issuedate, "Check out an item on $issuedate" ); - my $datedue = $self->checkout_first_item( { issuedate => $issuedate } ); - ok( $datedue, "...and it's due on $datedue" ); - - my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'We found this item checked out to our member.' ) - or diag( Data::Dumper->Dump( [ $after_issues ], [ 'issues' ] ) ); - is( $after_issues->{'issuedate'}, $issuedate, "...and it was issued on $issuedate" ) - or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); - - my $loanlength = Date::Calc::Delta_Days( split( /-/, $after_issues->{'issuedate'} ), split( /-/, $after_issues->{'date_due'} ) ); - ok( $loanlength, "the loanlength is $loanlength days" ); - is( $loanlength, $self->{'loanlength'} ); -} - -sub set_lastreneweddate_on_renewal : Test( 6 ) { - my $self = shift; - - my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - ok( ! defined $before_issues->{'borrowernumber'}, 'At this beginning, this item was not checked out.' ) - or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); - - my $datedue = $self->checkout_first_item( { issuedate => $self->yesterday() } ); - ok( $datedue, "The item is checked out and it's due on $datedue" ); - - my $issuedate = $self->random_date(); - ok( $issuedate, "Check out an item again on $issuedate" ); - # This will actually be a renewal - $datedue = $self->checkout_first_item( { issuedate => $issuedate } ); - ok( $datedue, "...and it's due on $datedue" ); - - my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'We found this item checked out to our member.' ) - or diag( Data::Dumper->Dump( [ $after_issues ], [ 'issues' ] ) ); - is( $after_issues->{'lastreneweddate'}, $issuedate, "...and it was renewed on $issuedate" ) - or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); - -} - -1; diff --git a/t/lib/KohaTest/Circulation/GetUpcomingDueIssues.pm b/t/lib/KohaTest/Circulation/GetUpcomingDueIssues.pm deleted file mode 100644 index 95dd1afb9a..0000000000 --- a/t/lib/KohaTest/Circulation/GetUpcomingDueIssues.pm +++ /dev/null @@ -1,26 +0,0 @@ -package KohaTest::Circulation::GetUpcomingDueIssues; -use base qw(KohaTest::Circulation); - -use strict; -use warnings; - -use Test::More; - -=head2 basic_usage - -basic usage of C4::Circulation::GetUpcomingDueIssues() - -=cut - -sub basic_usage : Test(2) { - my $self = shift; - - my $upcoming = C4::Circulation::GetUpcomingDueIssues(); - isa_ok( $upcoming, 'ARRAY' ); - - is( scalar @$upcoming, 0, 'no issues yet' ) - or diag( Data::Dumper->Dump( [$upcoming], ['upcoming'] ) ); -} - - -1; diff --git a/t/lib/KohaTest/Circulation/MarkIssueReturned.pm b/t/lib/KohaTest/Circulation/MarkIssueReturned.pm deleted file mode 100644 index 5722bcfe96..0000000000 --- a/t/lib/KohaTest/Circulation/MarkIssueReturned.pm +++ /dev/null @@ -1,85 +0,0 @@ -package KohaTest::Circulation::MarkIssueReturned; -use base qw(KohaTest::Circulation); - -use strict; -use warnings; - -use Test::More; - -=head2 basic_usage - -basic usage of C4::Circulation::MarkIssueReturned - -=cut - -sub basic_usage : Test( 4 ) { - my $self = shift; - - my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - ok( ! defined $before_issues->{'borrowernumber'}, 'our item is not checked out' ) - or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); - - my $datedue = $self->checkout_first_item(); - ok( $datedue, "Now it is checked out and due on $datedue" ); - - my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'Our item is checked out to our borrower' ) - or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); - - C4::Circulation::MarkIssueReturned( $self->{'memberid'}, $self->{'items'}[0]{'itemnumber'} ); - - my $after_return = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - ok( ! defined $after_return->{'borrowernumber'}, 'The item is no longer checked out' ) - or diag( Data::Dumper->Dump( [ $after_return ], [ 'after_return' ] ) ); - -} - -=head2 set_returndate - -check an item out, then, check it back in, specifying the returndate. - -verify that it's checked back in and the returndate is correct. - -=cut - -sub set_retundate : Test( 7 ) { - my $self = shift; - - # It's not checked out to start with - my $before_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - ok( ! defined $before_issues->{'borrowernumber'}, 'our item is not checked out' ) - or diag( Data::Dumper->Dump( [ $before_issues ], [ 'before_issues' ] ) ); - - # check it out - my $datedue = $self->checkout_first_item(); - ok( $datedue, "Now it is checked out and due on $datedue" ); - - # verify that it has been checked out - my $after_issues = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - is( $after_issues->{'borrowernumber'}, $self->{'memberid'}, 'Our item is checked out to our borrower' ) - or diag( Data::Dumper->Dump( [ $after_issues ], [ 'after_issues' ] ) ); - - # mark it as returned on some date - my $returndate = $self->random_date(); - ok( $returndate, "return this item on $returndate" ); - - C4::Circulation::MarkIssueReturned( $self->{'memberid'}, - $self->{'items'}[0]{'itemnumber'}, - undef, - $returndate ); - - # validate that it is no longer checked out. - my $after_return = C4::Circulation::GetItemIssue( $self->{'items'}[0]{'itemnumber'} ); - ok( ! defined $after_return->{'borrowernumber'}, 'The item is no longer checked out' ) - or diag( Data::Dumper->Dump( [ $after_return ], [ 'after_return' ] ) ); - - # grab the history for this item and make sure it looks right - my $history = C4::Circulation::GetItemIssues( $self->{'items'}[0]{'itemnumber'}, 1 ); - is( scalar @$history, 1, 'this item has been checked out one time.' ) - or diag( Data::Dumper->Dump( [ $history ], [ 'history' ] ) ); - is( $history->[0]{'returndate'}, $returndate, "...and it was returned on $returndate" ); - -} - - -1; diff --git a/t/lib/KohaTest/Context.pm b/t/lib/KohaTest/Context.pm deleted file mode 100644 index bba7f888b7..0000000000 --- a/t/lib/KohaTest/Context.pm +++ /dev/null @@ -1,54 +0,0 @@ -package KohaTest::Context; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Context; -sub testing_class { 'C4::Context' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - AUTOLOAD - boolean_preference - config - dbh - db_scheme2dbi - get_shelves_userenv - get_versions - import - KOHAVERSION - marcfromkohafield - ModZebrations - new - new_dbh - preference - read_config_file - restore_context - restore_dbh - set_context - set_dbh - set_shelves_userenv - set_userenv - stopwords - userenv - Zconn - zebraconfig - _common_config - _new_dbh - _new_marcfromkohafield - _new_stopwords - _new_userenv - _new_Zconn - _unset_userenv - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Context/preference.pm b/t/lib/KohaTest/Context/preference.pm deleted file mode 100644 index 2ad73d1100..0000000000 --- a/t/lib/KohaTest/Context/preference.pm +++ /dev/null @@ -1,54 +0,0 @@ -package KohaTest::Context::preference; -use base qw( KohaTest::Context ); - -use strict; -use warnings; - -use Test::More; - -use C4::Context; -sub testing_class { 'C4::Context' }; - - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head2 TEST METHODS - -standard test methods - -=head3 preference_does_not_exist - -=cut - -sub preference_does_not_exist : Test( 1 ) { - my $self = shift; - - my $missing = C4::Context->preference( 'doesnotexist' ); - - is( $missing, undef, 'a query for a missing syspref returns undef' ) - or diag( Data::Dumper->Dump( [ $missing ], [ 'missing' ] ) ); - -} - - -=head3 version_preference - -=cut - -sub version_preference : Test( 1 ) { - my $self = shift; - - my $version = C4::Context->preference( 'version' ); - - ok( $version, 'C4::Context->preference returns a good version number' ) - or diag( Data::Dumper->Dump( [ $version ], [ 'version' ] ) ); - -} - - - -1; diff --git a/t/lib/KohaTest/Dates.pm b/t/lib/KohaTest/Dates.pm deleted file mode 100644 index 19a309d4a7..0000000000 --- a/t/lib/KohaTest/Dates.pm +++ /dev/null @@ -1,37 +0,0 @@ -package KohaTest::Dates; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Dates; -sub testing_class { 'C4::Dates' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( _prefformat - regexp - dmy_map - _check_date_and_time - _chron_to_ymd - _chron_to_hms - new - init - output - today - _recognize_format - DHTMLcalendar - format - visual - format_date - format_date_in_iso - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Dates/Usage.pm b/t/lib/KohaTest/Dates/Usage.pm deleted file mode 100644 index 8815c89103..0000000000 --- a/t/lib/KohaTest/Dates/Usage.pm +++ /dev/null @@ -1,103 +0,0 @@ -package KohaTest::Dates::Usage; -use base qw( KohaTest::Dates ); - -use strict; -use warnings; - -use Test::More; - -use C4::Dates qw(format_date format_date_in_iso); - - -sub startup_init_constants : Tests(startup => 0) { - my $self = shift; - $self->{thash} = { - iso => [ '2001-01-01', '1989-09-21', '1952-01-00' ], - metric => [ "01-01-2001", '21-09-1989', '00-01-1952' ], - us => [ "01-01-2001", '09-21-1989', '01-00-1952' ], - sql => [ '20010101 010101', '19890921 143907', '19520100 000000' ], - }; - $self->{formats} = [ sort keys %{ $self->{thash} } ]; -} - -sub check_formats : Test( 8 ) { - my $self = shift; - - my $syspref = C4::Dates->new->format(); - ok( $syspref, "Your system preference is: $syspref" ); - - foreach ( @{ $self->{thash}->{'iso'} } ) { - ok( format_date($_), "able to format_date() on $_" ); - } - - foreach ( @{ $self->{thash}->{$syspref} } ) { - ok( format_date_in_iso($_), "able to format_date_in_iso() on $_" ); - } - ok( C4::Dates->today(), "(default) CLASS ->today : " . C4::Dates->today() ); -} - -sub defaults : Test( 24 ) { - my $self = shift; - - foreach (@{ $self->{formats} }) { - my $pre = sprintf '(%-6s)', $_; - my $date = C4::Dates->new(); - ok( $date, "$pre Date Creation : new()" ); - isa_ok( $date, 'C4::Dates' ); - ok( $_ eq $date->format($_), "$pre format($_) : " ); - ok( $date->visual(), "$pre visual()" ); - ok( $date->output(), "$pre output()" ); - ok( $date->today(), "$pre object->today" ); - - } -} - -sub valid_inputs : Test( 108 ) { - my $self = shift; - - foreach my $format (@{ $self->{formats} }) { - my $pre = sprintf '(%-6s)', $format; - foreach my $testval ( @{ $self->{thash}->{$format} } ) { - my ( $val, $today ); - my $date = C4::Dates->new( $testval, $format ); - ok( $date, "$pre Date Creation : new('$testval','$format')" ); - isa_ok( $date, 'C4::Dates' ); - ok( $date->regexp, "$pre has regexp()" ); - ok( $val = $date->output(), describe( "$pre output()", $val ) ); - foreach ( grep { !/$format/ } @{ $self->{formats} } ) { - ok( $today = $date->output($_), describe( sprintf( "$pre output(%8s)", "'$_'" ), $today ) ); - } - ok( $today = $date->today(), describe( "$pre object->today", $today ) ); - ok( $val = $date->output(), describe( "$pre output()", $val ) ); - } - } -} - -sub independence_from_class : Test( 1 ) { - my $self = shift; - - my $in1 = '12/25/1952'; # us - my $in2 = '13/01/2001'; # metric - my $d1 = C4::Dates->new( $in1, 'us' ); - my $d2 = C4::Dates->new( $in2, 'metric' ); - my $out1 = $d1->output('iso'); - my $out2 = $d2->output('iso'); - ok( $out1 ne $out2, "subsequent constructors get different dataspace ($out1 != $out2)" ); - -} - - - -sub describe { - my $front = sprintf( "%-25s", shift ); - my $tail = shift || 'FAILED'; - return "$front : $tail"; -} - -sub shutdown_clear_constants : Tests( shutdown => 0 ) { - my $self = shift; - delete $self->{thash}; - delete $self->{formats}; -} - -1; diff --git a/t/lib/KohaTest/Heading.pm b/t/lib/KohaTest/Heading.pm deleted file mode 100644 index 4f781a2ff7..0000000000 --- a/t/lib/KohaTest/Heading.pm +++ /dev/null @@ -1,27 +0,0 @@ -package KohaTest::Heading; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Heading; -sub testing_class { 'C4::Heading' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new_from_bib_field - display_form - authorities - preferred_authorities - _query_limiters - _marc_format_handler - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Heading/MARC21.pm b/t/lib/KohaTest/Heading/MARC21.pm deleted file mode 100644 index 41cd4d32e7..0000000000 --- a/t/lib/KohaTest/Heading/MARC21.pm +++ /dev/null @@ -1,41 +0,0 @@ -package KohaTest::Heading::MARC21; -use base qw( KohaTest::Heading ); - -use strict; -use warnings; - -use Test::More; - -use C4::Heading; -use C4::Heading::MARC21; - -use MARC::Field; - -sub testing_class { 'C4::Heading::MARC21' }; - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new - valid_bib_heading_tag - parse_heading - _get_subject_thesaurus - _get_search_heading - _get_display_heading - ); - - can_ok( $self->testing_class, @methods ); -} - -sub bug2315 : Test( 1 ) { - - my $subject_heading = MARC::Field->new(650, ' ', '0', - a => "Dalziel, Andrew (Fictitious character", - ')' => "Fiction." - ); - my $display_form = C4::Heading::MARC21::_get_display_heading($subject_heading, 'a'); - is($display_form, "Dalziel, Andrew (Fictitious character", "bug 2315: no crash if heading subfield has metacharacter"); - -} - -1; diff --git a/t/lib/KohaTest/ImportBatch.pm b/t/lib/KohaTest/ImportBatch.pm deleted file mode 100644 index a8fefaac9b..0000000000 --- a/t/lib/KohaTest/ImportBatch.pm +++ /dev/null @@ -1,130 +0,0 @@ -package KohaTest::ImportBatch; -use base qw(KohaTest); - -use strict; -use warnings; - -use Test::More; - -use C4::ImportBatch; -use C4::Matcher; -sub testing_class { 'C4::ImportBatch' }; - - -sub routines : Test( 1 ) { - my $self = shift; - my @routines = qw( - GetZ3950BatchId - GetImportRecordMarc - AddImportBatch - GetImportBatch - AddBiblioToBatch - ModBiblioInBatch - BatchStageMarcRecords - AddItemsToImportBiblio - BatchFindBibDuplicates - BatchCommitBibRecords - BatchCommitItems - BatchRevertBibRecords - BatchRevertItems - CleanBatch - GetAllImportBatches - GetImportBatchRangeDesc - GetItemNumbersFromImportBatch - GetNumberOfNonZ3950ImportBatches - GetImportBibliosRange - GetBestRecordMatch - GetImportBatchStatus - SetImportBatchStatus - GetImportBatchOverlayAction - SetImportBatchOverlayAction - GetImportBatchNoMatchAction - SetImportBatchNoMatchAction - GetImportBatchItemAction - SetImportBatchItemAction - GetImportBatchItemAction - SetImportBatchItemAction - GetImportBatchMatcher - SetImportBatchMatcher - GetImportRecordOverlayStatus - SetImportRecordOverlayStatus - GetImportRecordStatus - SetImportRecordStatus - GetImportRecordMatches - SetImportRecordMatches - _create_import_record - _update_import_record_marc - _add_biblio_fields - _update_biblio_fields - _parse_biblio_fields - _update_batch_record_counts - _get_commit_action - _get_revert_action - ); - - can_ok($self->testing_class, @routines); -} - -sub startup_50_add_matcher : Test( startup => 1 ) { - my $self = shift; - # create test MARC21 ISBN matcher - my $matcher = C4::Matcher->new('biblio'); - $matcher->threshold(1000); - $matcher->code('TESTISBN'); - $matcher->description('test MARC21 ISBN matcher'); - $matcher->add_simple_matchpoint('isbn', 1000, '020', 'a', -1, 0, ''); - my $matcher_id = $matcher->store(); - like($matcher_id, qr/^\d+$/, "store new matcher and get back ID"); - - $self->{'matcher_id'} = $matcher_id; -} - -sub shutdown_50_remove_matcher : Test( shutdown => 6) { - my $self = shift; - my @matchers = C4::Matcher::GetMatcherList(); - cmp_ok(scalar(@matchers), ">=", 1, "at least one matcher present"); - my $matcher_id; - my $testisbn_count = 0; - # look for TESTISBN - foreach my $matcher (@matchers) { - if ($matcher->{'code'} eq 'TESTISBN') { - $testisbn_count++; - $matcher_id = $matcher->{'matcher_id'}; - } - } - ok($testisbn_count == 1, "only one TESTISBN matcher"); - like($matcher_id, qr/^\d+$/, "matcher ID is valid"); - my $matcher = C4::Matcher->fetch($matcher_id); - ok(defined($matcher), "got back a matcher"); - ok($matcher_id == $matcher->{'id'}, "got back the correct matcher"); - C4::Matcher->delete($matcher_id); - my $matcher2 = C4::Matcher->fetch($matcher_id); - ok(not(defined($matcher2)), "matcher removed"); - - delete $self->{'matcher_id'}; -} - -=head2 UTILITY METHODS - -=cut - -sub add_import_batch { - my $self = shift; - my $test_batch = shift - || { - overlay_action => 'create_new', - import_status => 'staging', - batch_type => 'batch', - file_name => 'foo', - comments => 'inserted during automated testing', - }; - my $batch_id = AddImportBatch( $test_batch->{'overlay_action'}, - $test_batch->{'import_status'}, - $test_batch->{'batch_type'}, - $test_batch->{'file_name'}, - $test_batch->{'comments'}, ); - return $batch_id; -} - - -1; diff --git a/t/lib/KohaTest/ImportBatch/AddImportBatch.pm b/t/lib/KohaTest/ImportBatch/AddImportBatch.pm deleted file mode 100644 index 7b97e72537..0000000000 --- a/t/lib/KohaTest/ImportBatch/AddImportBatch.pm +++ /dev/null @@ -1,31 +0,0 @@ -package KohaTest::ImportBatch::AddImportBatch; -use base qw( KohaTest::ImportBatch ); - -use strict; -use warnings; - -use Test::More; - -use C4::ImportBatch; -use C4::Matcher; -use C4::Biblio; - - -=head3 add_one - -=cut - -sub add_one : Test( 1 ) { - my $self = shift; - - my $batch_id = AddImportBatch( - 'create_new', #overlay_action - 'staging', # import_status - 'batch', # batc_type - 'foo', # file_name - 'inserted during automated testing', # comments - ); - ok( $batch_id, "successfully inserted batch: $batch_id" ); -} - -1; diff --git a/t/lib/KohaTest/ImportBatch/AddItemsToImportBiblio.pm b/t/lib/KohaTest/ImportBatch/AddItemsToImportBiblio.pm deleted file mode 100644 index 39d36df7d6..0000000000 --- a/t/lib/KohaTest/ImportBatch/AddItemsToImportBiblio.pm +++ /dev/null @@ -1,29 +0,0 @@ -package KohaTest::ImportBatch::getImportBatch; -use base qw( KohaTest::ImportBatch ); - -use strict; -use warnings; - -use Test::More; - -use C4::ImportBatch; -use C4::Matcher; -use C4::Biblio; - - -sub something : Test( 2 ) { - my $self = shift; - - my $batch_id = $self->add_import_batch(); - ok( $batch_id, 'we have a batch_id' ); - - my $import_record_id = 0; - - my $marc_record = MARC::Record->new(); - - my @import_item_ids = C4::ImportBatch::AddItemsToImportBiblio( $batch_id, $import_record_id, $marc_record ); - is( scalar( @import_item_ids ), 0, 'none inserted' ); - -} - -1; diff --git a/t/lib/KohaTest/ImportBatch/BatchStageCommitRevert.pm b/t/lib/KohaTest/ImportBatch/BatchStageCommitRevert.pm deleted file mode 100644 index 94f811528c..0000000000 --- a/t/lib/KohaTest/ImportBatch/BatchStageCommitRevert.pm +++ /dev/null @@ -1,252 +0,0 @@ -package KohaTest::ImportBatch::BatchStageCommitRevert; -use base qw( KohaTest::ImportBatch ); - -use strict; -use warnings; - -use Test::More; - -use C4::ImportBatch; -use C4::Matcher; -use C4::Biblio; - -# define test records for various batches -sub startup_60_make_test_records : Test( startup ) { - my $self = shift; - $self->{'batches'} = { - 'batch1' => { - marc => _make_marc_batch([ - ['isbn001', 'title 1', ['batch-item-1'] ], - ['isbn002', 'title 2', [] ], - ['isbn003', 'title 3', ['batch-item-2','batch-item-3'] ], - ['isbn004', 'title 4', [ 'batch-item-4' ] ], - ['isbn005', 'title 5', [ 'batch-item-5', 'batch-item-6', 'batch-item-7' ] ], - ]), - args => { - parse_items => 1, - overlay_action => 'create_new', - nomatch_action => 'create_new', - item_action => 'always_add', - }, - results => { - num_bibs => 5, - num_items => 7, - num_invalid => 0, - num_matches => 0, - num_added => 5, - num_updated => 0, - num_items_added => 7, - num_items_errored => 0, - num_ignored => 0, - }, - }, - 'batch2' => { - marc => _make_marc_batch([ - ['isbn001', 'overlay title 1', ['batch-item-8'] ], - ['isbn002', 'overlay title 2', ['batch-item-9'] ], - ['isbn006', 'title 6', ['batch-item-10'] ], - ]), - args => { - parse_items => 1, - overlay_action => 'replace', - nomatch_action => 'create_new', - item_action => 'always_add', - }, - results => { - num_bibs => 3, - num_items => 3, - num_invalid => 0, - num_matches => 2, - num_added => 1, - num_updated => 2, - num_items_added => 3, - num_items_errored => 0, - num_ignored => 0, - }, - }, - 'batch3' => { - marc => _make_marc_batch([ - ['isbn007', 'title 7', ['batch-item-11'] ], - ['isbn006', 'overlay title 6', ['batch-item-12'] ], - ]), - args => { - parse_items => 1, - overlay_action => 'ignore', - nomatch_action => 'ignore', - item_action => 'always_add', - }, - results => { - num_bibs => 2, - num_items => 2, - num_invalid => 0, - num_matches => 1, - num_added => 0, - num_updated => 0, - num_items_added => 1, - num_items_errored => 0, - num_ignored => 2, - }, - }, - 'batch4' => { - marc => _make_marc_batch([ - ['isbn008', 'title 8', ['batch-item-13'] ], # not loading this item - ]), - args => { - parse_items => 0, - overlay_action => undef, - nomatch_action => 'create_new', - item_action => 'ignore', - }, - results => { - num_bibs => 1, - num_items => 0, - num_invalid => 0, - num_matches => 0, - num_added => 1, - num_updated => 0, - num_items_added => 0, - num_items_errored => 0, - num_ignored => 0, - }, - }, - 'batch5' => { - marc => _make_marc_batch([ - ['isbn009', 'title 9', ['batch-item-1'] ], # trigger dup barcode error - 'junkjunkjunkjunk', # trigger invalid bib - ]), - args => { - parse_items => 1, - overlay_action => undef, - nomatch_action => undef, - item_action => undef, - }, - results => { - num_bibs => 1, - num_items => 1, - num_invalid => 1, - num_matches => 0, - num_added => 1, - num_updated => 0, - num_items_added => 0, - num_items_errored => 1, - num_ignored => 0, - }, - }, - 'batch6' => { - marc => _make_marc_batch([ - ['isbn001', 'match title 1', ['batch-item-14', 'batch-item-15'] ], - ['isbn010', 'title 10', ['batch-item-16', 'batch-item-17'] ], - ]), - args => { - parse_items => 1, - overlay_action => 'ignore', - nomatch_action => 'create_new', - item_action => 'always_add', - }, - results => { - num_bibs => 2, - num_items => 4, - num_invalid => 0, - num_matches => 1, - num_added => 1, - num_updated => 0, - num_items_added => 4, - num_items_errored => 0, - num_ignored => 1, - }, - }, - }; - -} - -sub _make_marc_batch { - my $defs = shift; - my @marc = (); - foreach my $rec (@$defs) { - if (ref($rec) eq 'ARRAY') { - my $isbn = $rec->[0]; - my $title = $rec->[1]; - my $items = $rec->[2]; - my $bib = MARC::Record->new(); - $bib->leader(' nam a22 7a 4500'); - $bib->append_fields(MARC::Field->new('020', ' ', ' ', a => $isbn), - MARC::Field->new('245', ' ', ' ', a => $title)); - foreach my $barcode (@$items) { - my ($itemtag, $toss, $barcodesf, $branchsf); - ($itemtag, $toss) = GetMarcFromKohaField('items.itemnumber', ''); - ($toss, $barcodesf) = GetMarcFromKohaField('items.barcode', ''); - ($toss, $branchsf) = GetMarcFromKohaField('items.homebranch', ''); - $bib->append_fields(MARC::Field->new($itemtag, ' ', ' ', $barcodesf => $barcode, $branchsf => 'CPL')); - # FIXME: define branch in KohaTest - } - push @marc, $bib->as_usmarc(); - } else { - push @marc, $rec; - } - } - return join('', @marc); -} - -sub stage_commit_batches : Test( 75 ) { - my $self = shift; - - my $matcher = C4::Matcher->fetch($self->{'matcher_id'}); - ok(ref($matcher) eq 'C4::Matcher', "retrieved matcher"); - - for my $batch_key (sort keys %{ $self->{'batches'} }) { - my $batch = $self->{'batches'}->{$batch_key}; - my $args = $batch->{'args'}; - my $results = $batch->{'results'}; - my ($batch_id, $num_bibs, $num_items, @invalid) = - BatchStageMarcRecords('MARC21', $batch->{marc}, "$batch_key.mrc", "$batch_key comments", - '', $args->{'parse_items'}, 0); - like($batch_id, qr/^\d+$/, "staged $batch_key"); - cmp_ok($num_bibs, "==", $results->{'num_bibs'}, "$batch_key: correct number of bibs"); - cmp_ok($num_items, "==", $results->{'num_items'}, "$batch_key: correct number of items"); - cmp_ok(scalar(@invalid), "==", $results->{'num_invalid'}, "$batch_key: correct number of invalid bibs"); - - my $num_matches = BatchFindBibDuplicates($batch_id, $matcher, 10); - cmp_ok($num_matches, "==", $results->{'num_matches'}, "$batch_key: correct number of bib matches"); - - if (defined $args->{'overlay_action'}) { - if ($args->{'overlay_action'} eq 'create_new') { - cmp_ok(GetImportBatchOverlayAction($batch_id), "eq", 'create_new', "$batch_key: verify default overlay action"); - } else { - SetImportBatchOverlayAction($batch_id, $args->{'overlay_action'}); - cmp_ok(GetImportBatchOverlayAction($batch_id), "eq", $args->{'overlay_action'}, - "$batch_key: changed overlay action"); - } - } - if (defined $args->{'nomatch_action'}) { - if ($args->{'nomatch_action'} eq 'create_new') { - cmp_ok(GetImportBatchNoMatchAction($batch_id), "eq", 'create_new', "$batch_key: verify default nomatch action"); - } else { - SetImportBatchNoMatchAction($batch_id, $args->{'nomatch_action'}); - cmp_ok(GetImportBatchNoMatchAction($batch_id), "eq", $args->{'nomatch_action'}, - "$batch_key: changed nomatch action"); - } - } - if (defined $args->{'item_action'}) { - if ($args->{'item_action'} eq 'create_new') { - cmp_ok(GetImportBatchItemAction($batch_id), "eq", 'always_add', "$batch_key: verify default item action"); - } else { - SetImportBatchItemAction($batch_id, $args->{'item_action'}); - cmp_ok(GetImportBatchItemAction($batch_id), "eq", $args->{'item_action'}, - "$batch_key: changed item action"); - } - } - - my ($num_added, $num_updated, $num_items_added, - $num_items_errored, $num_ignored) = BatchCommitBibRecords($batch_id); - cmp_ok($num_added, "==", $results->{'num_added'}, "$batch_key: added correct number of bibs"); - cmp_ok($num_updated, "==", $results->{'num_updated'}, "$batch_key: updated correct number of bibs"); - cmp_ok($num_items_added, "==", $results->{'num_items_added'}, "$batch_key: added correct number of items"); - cmp_ok($num_items_errored, "==", $results->{'num_items_errored'}, "$batch_key: correct number of item add errors"); - cmp_ok($num_ignored, "==", $results->{'num_ignored'}, "$batch_key: ignored correct number of bibs"); - - $self->reindex_marc(); - } - -} - -1; diff --git a/t/lib/KohaTest/ImportBatch/GetImportBatch.pm b/t/lib/KohaTest/ImportBatch/GetImportBatch.pm deleted file mode 100644 index 0b01707df1..0000000000 --- a/t/lib/KohaTest/ImportBatch/GetImportBatch.pm +++ /dev/null @@ -1,45 +0,0 @@ -package KohaTest::ImportBatch::getImportBatch; -use base qw( KohaTest::ImportBatch ); - -use strict; -use warnings; - -use Test::More; - -use C4::ImportBatch; -use C4::Matcher; -use C4::Biblio; - - -=head3 add_one_and_find_it - -=cut - -sub add_one_and_find_it : Test( 7 ) { - my $self = shift; - - my $batch = { - overlay_action => 'create_new', - import_status => 'staging', - batch_type => 'batch', - file_name => 'foo', - comments => 'inserted during automated testing', - }; - my $batch_id = AddImportBatch( - $batch->{'overlay_action'}, - $batch->{'import_status'}, - $batch->{'batch_type'}, - $batch->{'file_name'}, - $batch->{'comments'}, - ); - ok( $batch_id, "successfully inserted batch: $batch_id" ); - - my $retrieved = GetImportBatch( $batch_id ); - - foreach my $key ( keys %$batch ) { - is( $retrieved->{$key}, $batch->{$key}, "both objects agree on $key" ); - } - is( $retrieved->{'import_batch_id'}, $batch_id, 'batch_id' ); -} - -1; diff --git a/t/lib/KohaTest/ImportBatch/GetImportRecordMarc.pm b/t/lib/KohaTest/ImportBatch/GetImportRecordMarc.pm deleted file mode 100644 index b933b35bec..0000000000 --- a/t/lib/KohaTest/ImportBatch/GetImportRecordMarc.pm +++ /dev/null @@ -1,51 +0,0 @@ -package KohaTest::ImportBatch::GetImportRecordMarc; -use base qw( KohaTest::ImportBatch ); - -use strict; -use warnings; - -use Test::More; - -use C4::ImportBatch; -use C4::Matcher; -use C4::Biblio; - - -=head3 record_does_not_exist - -=cut - -sub record_does_not_exist : Test( 1 ) { - my $self = shift; - - my $id = '999999999999'; - my $marc = GetImportRecordMarc( $id ); - ok( ! defined( $marc ), 'this marc is undefined' ); - -} - -sub record_does_exist : Test( 4 ) { - my $self = shift; - - # we need an import_batch, so let GetZ3950BatchId create one: - my $new_batch_id = GetZ3950BatchId('foo'); - ok( $new_batch_id, "got a new batch ID: $new_batch_id" ); - - my $sth = C4::Context->dbh->prepare( - "INSERT INTO import_records (import_batch_id, marc, marcxml) - VALUES (?, ?, ?)" - ); - my $execute = $sth->execute( - $new_batch_id, # batch_id - 'marc', # marc - 'marcxml', # marcxml - ); - ok( $execute, 'succesfully executed' ); - my $import_record_id = C4::Context->dbh->{'mysql_insertid'}; - ok( $import_record_id, 'we got an import_record_id' ); - - my $marc = GetImportRecordMarc($import_record_id); - ok( defined($marc), 'this marc is defined' ); -} - -1; diff --git a/t/lib/KohaTest/ImportBatch/GetZ3950BatchId.pm b/t/lib/KohaTest/ImportBatch/GetZ3950BatchId.pm deleted file mode 100644 index f3f5d9cdb2..0000000000 --- a/t/lib/KohaTest/ImportBatch/GetZ3950BatchId.pm +++ /dev/null @@ -1,42 +0,0 @@ -package KohaTest::ImportBatch::GetZ3950BatchId; -use base qw( KohaTest::ImportBatch ); - -use strict; -use warnings; - -use Test::More; - -use C4::ImportBatch; -use C4::Matcher; -use C4::Biblio; - - -=head3 batch_does_not_exist - -=cut - -sub batch_does_not_exist : Test( 5 ) { - my $self = shift; - - my $file_name = 'testing batch'; - - # lets make sure it doesn't exist first - my $sth = C4::Context->dbh->prepare('SELECT import_batch_id FROM import_batches - WHERE batch_type = ? - AND file_name = ?'); - ok( $sth->execute( 'z3950', $file_name, ), 'execute' ); - my $rowref = $sth->fetchrow_arrayref(); - ok( !defined( $rowref ), 'this batch does not exist' ); - - # now let GetZ3950BatchId create one - my $new_batch_id = GetZ3950BatchId( $file_name ); - ok( $new_batch_id, "got a new batch ID: $new_batch_id" ); - - # now search for the one that was just created - my $second_batch_id = GetZ3950BatchId( $file_name ); - ok( $second_batch_id, "got a second batch ID: $second_batch_id" ); - is( $second_batch_id, $new_batch_id, 'we got the same batch both times.' ); -} - - -1; diff --git a/t/lib/KohaTest/Installer.pm b/t/lib/KohaTest/Installer.pm deleted file mode 100644 index 2a0f9f93d8..0000000000 --- a/t/lib/KohaTest/Installer.pm +++ /dev/null @@ -1,42 +0,0 @@ -package KohaTest::Installer; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; -use C4::Languages; -use C4::Installer; - -sub SKIP_CLASS : Expensive { } - -sub testing_class { 'C4::Installer' }; - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new - marcflavour_list - marc_framework_sql_list - sample_data_sql_list - sql_file_list - load_db_schema - load_sql_in_order - set_marcflavour_syspref - set_indexing_engine - set_version_syspref - load_sql - ); - can_ok( $self->testing_class, @methods ); -} - -# ensure that we have a fresh, empty database -# after running through the installer tests -sub shutdown_50_init_db : Tests( shutdown ) { - my $self = shift; - - KohaTest::clear_test_database(); - KohaTest::create_test_database(); -} - -1; diff --git a/t/lib/KohaTest/Installer/SqlScripts.pm b/t/lib/KohaTest/Installer/SqlScripts.pm deleted file mode 100644 index 510c574b21..0000000000 --- a/t/lib/KohaTest/Installer/SqlScripts.pm +++ /dev/null @@ -1,83 +0,0 @@ -package KohaTest::Installer::SqlScripts; -use base qw( KohaTest::Installer ); - -use strict; -use warnings; - -use Test::More; -use C4::Languages; -use C4::Installer; - -sub startup_50_get_installer : Test( startup => 1 ) { - my $self = shift; - my $installer = C4::Installer->new(); - is(ref($installer), "C4::Installer", "created installer"); - $self->{installer} = $installer; -} - -sub installer_all_sample_data : Tests { - my $self = shift; - - skip "did not create installer" unless ref($self->{installer}) eq 'C4::Installer'; - - my $all_languages = getAllLanguages(); - # find the available directory names - my $dir=C4::Context->config('intranetdir')."/installer/data/" . - (C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql") . "/"; - opendir (MYDIR,$dir); - my @languages = grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR); - closedir MYDIR; - - cmp_ok(scalar(@languages), '>', 0, "at least one framework language defined"); - - foreach my $lang_code (@languages) { - SKIP: { - my $marc_flavours = $self->{installer}->marcflavour_list($lang_code); - ok(defined($marc_flavours), "at least one MARC flavour for $lang_code"); - skip "no MARC flavours for $lang_code" unless defined($marc_flavours); - - foreach my $flavour (@$marc_flavours) { - SKIP: { - $self->clear_test_database(); - my $schema_error = $self->{installer}->load_db_schema(); - is($schema_error, "", "no errors during schema load"); - skip "error during schema load" if $schema_error ne ""; - - my $list = $self->{installer}->sql_file_list($lang_code, $flavour, { optional => 1, mandatory => 1 }); - my $sql_count = scalar(@$list); - cmp_ok($sql_count, '>', 0, "at least one SQL init file for $lang_code, $flavour"); - skip "no SQL init files defined for $lang_code, $flavour" unless $sql_count > 0; - - my ($fwk_language, $installed_list) = $self->{installer}->load_sql_in_order($all_languages, @$list); - - # extract list of files - my $level; - my @file_list = map { - map { $_->{level} = $level; $_ } @{ $level = $_->{level}; $_->{fwklist} } - } @$installed_list; - my $num_processed = scalar(@file_list); - cmp_ok($num_processed, '==', $sql_count, "processed all sql scripts for $lang_code, $flavour"); - - my %sql_to_load = map { my $file = $_; - my @file = split qr(\/|\\), $file; - join("\t", $file[-2], $file[-1]) => 1 - } @$list; - foreach my $sql (@file_list) { - ok(exists($sql_to_load{ "$sql->{level}\t$sql->{fwkname}" }), - "SQL script $sql->{level}/$sql->{fwkname} is on list"); - delete $sql_to_load{ "$sql->{level}\t$sql->{fwkname}" }; - is($sql->{error}, "", "no errors when loading $sql->{fwkname}"); - } - ok(not(%sql_to_load), "no SQL scripts for $lang_code, $flavour left unloaded"); - } - } - } - } -} - -sub shutdown_50_clear_installer : Tests( shutdown ) { - my $self = shift; - delete $self->{installer}; -} - -1; diff --git a/t/lib/KohaTest/Installer/get_file_path_from_name.pm b/t/lib/KohaTest/Installer/get_file_path_from_name.pm deleted file mode 100644 index 40962a7209..0000000000 --- a/t/lib/KohaTest/Installer/get_file_path_from_name.pm +++ /dev/null @@ -1,36 +0,0 @@ -package KohaTest::Installer::get_file_path_from_name; -use base qw( KohaTest::Installer ); - -use strict; -use warnings; - -use Test::More; -use C4::Languages; -use C4::Installer; - -sub startup_50_get_installer : Test( startup => 1 ) { - my $self = shift; - my $installer = C4::Installer->new(); - is(ref($installer), "C4::Installer", "created installer"); - $self->{installer} = $installer; -} - -sub search_for_known_scripts : Tests( 2 ) { - my $self = shift; - - skip "did not create installer" unless ref($self->{installer}) eq 'C4::Installer'; - - foreach my $script ( 'installer/data/mysql/en/mandatory/message_transport_types.sql', - 'installer/data/mysql/en/optional/sample_notices_message_attributes.sql', ) { - - ok( $self->{'installer'}->get_file_path_from_name( $script ), "found $script" ); - } - -} - -sub shutdown_50_clear_installer : Tests( shutdown ) { - my $self = shift; - delete $self->{installer}; -} - -1; diff --git a/t/lib/KohaTest/ItemCirculationAlertPreference.pm b/t/lib/KohaTest/ItemCirculationAlertPreference.pm deleted file mode 100644 index 3094b335a5..0000000000 --- a/t/lib/KohaTest/ItemCirculationAlertPreference.pm +++ /dev/null @@ -1,27 +0,0 @@ -package KohaTest::ItemCirculationAlertPreference; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::ItemCirculationAlertPreference; -sub testing_class { 'C4::ItemCirculationAlertPreference' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new - create - delete - is_enabled_for - find - grid - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/ItemType.pm b/t/lib/KohaTest/ItemType.pm deleted file mode 100644 index 2474ce3298..0000000000 --- a/t/lib/KohaTest/ItemType.pm +++ /dev/null @@ -1,23 +0,0 @@ -package KohaTest::ItemType; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::ItemType; -sub testing_class { 'C4::ItemType' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new - all - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Items.pm b/t/lib/KohaTest/Items.pm deleted file mode 100644 index 7dcd9ab9ef..0000000000 --- a/t/lib/KohaTest/Items.pm +++ /dev/null @@ -1,60 +0,0 @@ -package KohaTest::Items; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Items; -sub testing_class { 'C4::Items' } - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - - GetItem - AddItemFromMarc - AddItem - AddItemBatchFromMarc - ModItemFromMarc - ModItem - ModItemTransfer - ModDateLastSeen - DelItem - CheckItemPreSave - GetItemStatus - GetItemLocation - GetLostItems - GetItemsForInventory - GetItemsCount - GetItemInfosOf - GetItemsByBiblioitemnumber - GetItemsInfo - get_itemnumbers_of - GetItemnumberFromBarcode - get_item_authorised_values - get_authorised_value_images - GetMarcItem - _set_derived_columns_for_add - _set_derived_columns_for_mod - _do_column_fixes_for_mod - _get_single_item_column - _calc_items_cn_sort - _set_defaults_for_add - _koha_new_item - _koha_modify_item - _koha_delete_item - _marc_from_item_hash - _add_item_field_to_biblio - _replace_item_field_in_biblio - _repack_item_errors - _get_unlinked_item_subfields - _get_unlinked_subfields_xml - _parse_unlinked_item_subfields_from_xml - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Items/ColumnFixes.pm b/t/lib/KohaTest/Items/ColumnFixes.pm deleted file mode 100644 index aca4f73425..0000000000 --- a/t/lib/KohaTest/Items/ColumnFixes.pm +++ /dev/null @@ -1,77 +0,0 @@ -package KohaTest::Items::ColumnFixes; -use base qw( KohaTest::Items ); - -use strict; -use warnings; - -use Test::More; - -use C4::Items; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head2 TEST METHODS - -standard test methods - -=head3 not_defined - - -=cut - -sub not_defined : Test( 4 ) { - - my $item_mod_fixes_1 = { - notforloan => undef, - damaged => undef, - wthdrawn => undef, - itemlost => undef, - }; - - C4::Items::_do_column_fixes_for_mod($item_mod_fixes_1); - is( $item_mod_fixes_1->{'notforloan'}, 0, 'null notforloan fixed during mod' ); - is( $item_mod_fixes_1->{'damaged'}, 0, 'null damaged fixed during mod' ); - is( $item_mod_fixes_1->{'wthdrawn'}, 0, 'null wthdrawn fixed during mod' ); - is( $item_mod_fixes_1->{'itemlost'}, 0, 'null itemlost fixed during mod' ); - -} - -sub empty : Test( 4 ) { - - my $item_mod_fixes_2 = { - notforloan => '', - damaged => '', - wthdrawn => '', - itemlost => '', - }; - - C4::Items::_do_column_fixes_for_mod($item_mod_fixes_2); - is( $item_mod_fixes_2->{'notforloan'}, 0, 'empty notforloan fixed during mod' ); - is( $item_mod_fixes_2->{'damaged'}, 0, 'empty damaged fixed during mod' ); - is( $item_mod_fixes_2->{'wthdrawn'}, 0, 'empty wthdrawn fixed during mod' ); - is( $item_mod_fixes_2->{'itemlost'}, 0, 'empty itemlost fixed during mod' ); - -} - -sub not_clobbered : Test( 4 ) { - - my $item_mod_fixes_3 = { - notforloan => 1, - damaged => 2, - wthdrawn => 3, - itemlost => 4, - }; - - C4::Items::_do_column_fixes_for_mod($item_mod_fixes_3); - is( $item_mod_fixes_3->{'notforloan'}, 1, 'do not clobber notforloan during mod' ); - is( $item_mod_fixes_3->{'damaged'}, 2, 'do not clobber damaged during mod' ); - is( $item_mod_fixes_3->{'wthdrawn'}, 3, 'do not clobber wthdrawn during mod' ); - is( $item_mod_fixes_3->{'itemlost'}, 4, 'do not clobber itemlost during mod' ); - -} - -1; diff --git a/t/lib/KohaTest/Items/GetItemsForInventory.pm b/t/lib/KohaTest/Items/GetItemsForInventory.pm deleted file mode 100644 index a56057ec23..0000000000 --- a/t/lib/KohaTest/Items/GetItemsForInventory.pm +++ /dev/null @@ -1,123 +0,0 @@ -package KohaTest::Items::GetItemsForInventory; -use base qw( KohaTest::Items ); - -use strict; -use warnings; - -use Test::More; - -use C4::Items; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head2 startup_90_add_item_get_callnumber - -=cut - -sub startup_90_add_item_get_callnumber : Test( startup => 13 ) { - my $self = shift; - - $self->add_biblios( add_items => 1 ); - - ok( $self->{'items'}, 'An item has been aded' ) - or diag( Data::Dumper->Dump( [ $self->{'items'} ], ['items'] ) ); - - my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $self->{'items'}[0]{'biblionumber'} ); - ok( $biblioitems[0]->{'biblioitemnumber'}, '...and it has a biblioitemnumber' ) - or diag( Data::Dumper->Dump( [ \@biblioitems ], ['biblioitems'] ) ); - - my $items_info = GetItemsByBiblioitemnumber( $biblioitems[0]->{'biblioitemnumber'} ); - isa_ok( $items_info, 'ARRAY', '...and we can search with that biblioitemnumber' ) - or diag( Data::Dumper->Dump( [$items_info], ['items_info'] ) ); - cmp_ok( scalar @$items_info, '>', 0, '...and we can find at least one item with that biblioitemnumber' ); - - my $item_info = $items_info->[0]; - ok( $item_info->{'itemcallnumber'}, '...and the item we found has a call number: ' . $item_info->{'itemcallnumber'} ) - or diag( Data::Dumper->Dump( [$item_info], ['item_info'] ) ); - - $self->{'callnumber'} = $item_info->{'itemcallnumber'}; -} - - -=head2 TEST METHODS - -standard test methods - -=head3 missing_parameters - -the minlocation and maxlocation parameters are required. If they are -not provided, this method should somehow complain, such as returning -undef or emitina warning or something. - -=cut - -sub missing_parameters : Test( 1 ) { - my $self = shift; - local $TODO = 'GetItemsForInventory should fail when missing required parameters'; - - my $items = C4::Items::GetItemsForInventory(); - ok( ! defined $items, 'GetItemsForInventory fails when parameters are missing' ) - or diag( Data::Dumper->Dump( [ $items ], [ 'items' ] ) ); -} - -=head3 basic_usage - - -=cut - -sub basic_usage : Test( 4 ) { - my $self = shift; - - ok( $self->{'callnumber'}, 'we have a call number to search for: ' . $self->{'callnumber'} ); - my $items = C4::Items::GetItemsForInventory( $self->{'callnumber'}, $self->{'callnumber'} ); - isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' ); - is( scalar @$items, 1, '...and we found only one item' ); - my $our_item = $items->[0]; - is( $our_item->{'itemnumber'}, $self->{'items'}[0]{'itemnumber'}, '...and the item we found has the right itemnumber' ); - - # diag( Data::Dumper->Dump( [$items], ['items'] ) ); -} - -=head3 date_last_seen - - -=cut - -sub date_last_seen : Test( 6 ) { - my $self = shift; - - ok( $self->{'callnumber'}, 'we have a call number to search for: ' . $self->{'callnumber'} ); - - my $items = C4::Items::GetItemsForInventory( - $self->{'callnumber'}, # minlocation - $self->{'callnumber'}, # maxlocation - undef, # location - undef, # itemtype - C4::Dates->new( $self->tomorrow(), 'iso' )->output, # datelastseen - ); - - isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' ); - is( scalar @$items, 1, '...and we found only one item' ); - my $our_item = $items->[0]; - is( $our_item->{'itemnumber'}, $self->{'items'}[0]{'itemnumber'}, '...and the item we found has the right itemnumber' ); - - # give a datelastseen of yesterday, and we should not get our item. - $items = C4::Items::GetItemsForInventory( - $self->{'callnumber'}, # minlocation - $self->{'callnumber'}, # maxlocation - undef, # location - undef, # itemtype - C4::Dates->new( $self->yesterday(), 'iso' )->output, # datelastseen - ); - - isa_ok( $items, 'ARRAY', 'We were able to call GetItemsForInventory with our call number' ); - is( scalar @$items, 0, '...and we found no items' ); - -} - - -1; diff --git a/t/lib/KohaTest/Items/ModItemsFromMarc.pm b/t/lib/KohaTest/Items/ModItemsFromMarc.pm deleted file mode 100644 index d0522ee6cb..0000000000 --- a/t/lib/KohaTest/Items/ModItemsFromMarc.pm +++ /dev/null @@ -1,91 +0,0 @@ -package KohaTest::Items::ModItemsFromMarc; -use base qw( KohaTest::Items ); - -use strict; -use warnings; - -use Test::More; - -use C4::Context; -use C4::Biblio; -use C4::Items; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head2 startup_90_add_item_get_callnumber - -=cut - -sub startup_90_add_item_get_callnumber : Test( startup => 13 ) { - my $self = shift; - - $self->add_biblios( count => 1, add_items => 1 ); - - ok( $self->{'items'}, 'An item has been aded' ) - or diag( Data::Dumper->Dump( [ $self->{'items'} ], ['items'] ) ); - - my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $self->{'items'}[0]{'biblionumber'} ); - ok( $biblioitems[0]->{'biblioitemnumber'}, '...and it has a biblioitemnumber' ) - or diag( Data::Dumper->Dump( [ \@biblioitems ], ['biblioitems'] ) ); - - my $items_info = GetItemsByBiblioitemnumber( $biblioitems[0]->{'biblioitemnumber'} ); - isa_ok( $items_info, 'ARRAY', '...and we can search with that biblioitemnumber' ) - or diag( Data::Dumper->Dump( [$items_info], ['items_info'] ) ); - cmp_ok( scalar @$items_info, '>', 0, '...and we can find at least one item with that biblioitemnumber' ); - - my $item_info = $items_info->[0]; - ok( $item_info->{'itemcallnumber'}, '...and the item we found has a call number: ' . $item_info->{'itemcallnumber'} ) - or diag( Data::Dumper->Dump( [$item_info], ['item_info'] ) ); - - $self->{itemnumber} = $item_info->{itemnumber}; -} - - -=head2 TEST METHODS - -standard test methods - -=head3 bug2466 - -Regression test for bug 2466 (when clearing an item field -via the cataloging or serials item editor, corresponding -column is not cleared). - -=cut - -sub bug2466 : Test( 8 ) { - my $self = shift; - - my $item = C4::Items::GetItem($self->{itemnumber}); - isa_ok($item, 'HASH', "item $self->{itemnumber} exists"); - - my $item_marc = C4::Items::GetMarcItem($item->{biblionumber}, $self->{itemnumber}); - isa_ok($item_marc, 'MARC::Record', "retrieved item MARC"); - - cmp_ok($item->{itemcallnumber}, 'ne', '', "item call number is not blank"); - - my ($callnum_tag, $callnum_subfield) = C4::Biblio::GetMarcFromKohaField('items.itemcallnumber', ''); - cmp_ok($callnum_tag, '>', 0, "found tag for itemcallnumber"); - - my $item_field = $item_marc->field($callnum_tag); - ok(defined($item_field), "retrieved MARC field for item"); - - $item_field->delete_subfield(code => $callnum_subfield); - - my $dbh = C4::Context->dbh; - my $item_from_marc = C4::Biblio::TransformMarcToKoha($dbh, $item_marc, '', 'items'); - ok(not(exists($item_from_marc->{itemcallnumber})), "itemcallnumber subfield removed"); - - C4::Items::ModItemFromMarc($item_marc, $item->{biblionumber}, $self->{itemnumber}); - - my $modified_item = C4::Items::GetItem($self->{itemnumber}); - isa_ok($modified_item, 'HASH', "retrieved modified item"); - - ok(not(defined($modified_item->{itemcallnumber})), "itemcallnumber is now undef"); -} - -1; diff --git a/t/lib/KohaTest/Items/SetDefaults.pm b/t/lib/KohaTest/Items/SetDefaults.pm deleted file mode 100644 index fd622a7402..0000000000 --- a/t/lib/KohaTest/Items/SetDefaults.pm +++ /dev/null @@ -1,86 +0,0 @@ -package KohaTest::Items::SetDefaults; -use base qw( KohaTest::Items ); - -use strict; -use warnings; - -use Test::More; - -use C4::Items; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head2 TEST METHODS - -standard test methods - -=head3 - - -=cut - -sub add_some_items : Test( 3 ) { - - my $item_to_add_1 = { itemnotes => 'newitem', }; - - C4::Items::_set_defaults_for_add($item_to_add_1); - ok( exists $item_to_add_1->{'dateaccessioned'}, 'dateaccessioned added to new item' ); - like( $item_to_add_1->{'dateaccessioned'}, qr/^\d\d\d\d-\d\d-\d\d$/, 'new dateaccessioned is dddd-dd-dd' ); - is( $item_to_add_1->{'itemnotes'}, 'newitem', 'itemnotes not clobbered' ); - -} - -sub undefined : Test( 4 ) { - my $item_add_fixes_1 = { - notforloan => undef, - damaged => undef, - wthdrawn => undef, - itemlost => undef, - }; - - C4::Items::_set_defaults_for_add($item_add_fixes_1); - is( $item_add_fixes_1->{'notforloan'}, 0, 'null notforloan fixed during add' ); - is( $item_add_fixes_1->{'damaged'}, 0, 'null damaged fixed during add' ); - is( $item_add_fixes_1->{'wthdrawn'}, 0, 'null wthdrawn fixed during add' ); - is( $item_add_fixes_1->{'itemlost'}, 0, 'null itemlost fixed during add' ); -} - -sub empty_gets_fixed : Test( 4 ) { - - my $item_add_fixes_2 = { - notforloan => '', - damaged => '', - wthdrawn => '', - itemlost => '', - }; - - C4::Items::_set_defaults_for_add($item_add_fixes_2); - is( $item_add_fixes_2->{'notforloan'}, 0, 'empty notforloan fixed during add' ); - is( $item_add_fixes_2->{'damaged'}, 0, 'empty damaged fixed during add' ); - is( $item_add_fixes_2->{'wthdrawn'}, 0, 'empty wthdrawn fixed during add' ); - is( $item_add_fixes_2->{'itemlost'}, 0, 'empty itemlost fixed during add' ); - -} - -sub do_not_clobber : Test( 4 ) { - - my $item_add_fixes_3 = { - notforloan => 1, - damaged => 2, - wthdrawn => 3, - itemlost => 4, - }; - - C4::Items::_set_defaults_for_add($item_add_fixes_3); - is( $item_add_fixes_3->{'notforloan'}, 1, 'do not clobber notforloan during mod' ); - is( $item_add_fixes_3->{'damaged'}, 2, 'do not clobber damaged during mod' ); - is( $item_add_fixes_3->{'wthdrawn'}, 3, 'do not clobber wthdrawn during mod' ); - is( $item_add_fixes_3->{'itemlost'}, 4, 'do not clobber itemlost during mod' ); - -} - -1; diff --git a/t/lib/KohaTest/Koha.pm b/t/lib/KohaTest/Koha.pm deleted file mode 100644 index 13a145a10c..0000000000 --- a/t/lib/KohaTest/Koha.pm +++ /dev/null @@ -1,49 +0,0 @@ -package KohaTest::Koha; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Koha; -sub testing_class { 'C4::Koha' } - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( slashifyDate - DisplayISBN - subfield_is_koha_internal_p - GetItemTypes - get_itemtypeinfos_of - GetCcodes - getauthtypes - getauthtype - getframeworks - getframeworkinfo - getitemtypeinfo - getitemtypeimagedir - getitemtypeimagesrc - getitemtypeimagelocation - _getImagesFromDirectory - _getSubdirectoryNames - getImageSets - GetPrinters - GetPrinter - getnbpages - getallthemes - getFacets - get_infos_of - get_notforloan_label_of - displayServers - GetAuthValCode - GetAuthorisedValues - GetAuthorisedValueCategories - GetKohaAuthorisedValues - display_marc_indicators - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Koha/displayServers.pm b/t/lib/KohaTest/Koha/displayServers.pm deleted file mode 100644 index 7794268e99..0000000000 --- a/t/lib/KohaTest/Koha/displayServers.pm +++ /dev/null @@ -1,192 +0,0 @@ -package KohaTest::Koha::displayServers; -use base qw( KohaTest::Koha ); - -use strict; -use warnings; - -use Test::More; - -use C4::Koha; - -=head2 basic_usage - -call displayServers with no parameters and investigate the things that -it returns. This depends on there being at least one server defined, -as do some other tests in this module. - -=cut - -sub basic_usage : Test( 12 ) { - my $self = shift; - - my $servers = C4::Koha::displayServers(); - isa_ok( $servers, 'ARRAY' ); - my $firstserver = $servers->[0]; - isa_ok( $firstserver, 'HASH' ); - - my @keys = qw( opensearch icon value name checked zed label id encoding ); - is( scalar keys %$firstserver, scalar @keys, 'the hash has the right number of keys' ); - foreach my $key ( @keys ) { - ok( exists $firstserver->{$key}, "There is a $key key" ); - } - - # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); -} - -=head2 position_does_not_exist - -call displayServers with a position that does not exist and make sure -that we get none back. - -=cut - -sub position_does_not_exist : Test( 2 ) { - my $self = shift; - - my $servers = C4::Koha::displayServers( 'this does not exist' ); - isa_ok( $servers, 'ARRAY' ); - is( scalar @$servers, 0, 'received no servers' ); - - # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); -} - -=head2 position_does_exist - -call displayServers with a position that does exist and make sure that -we get at least one back. - -=cut - -sub position_does_exist : Test( 3 ) { - my $self = shift; - - my $position = $self->_get_a_position(); - ok( $position, 'We have a position that exists' ); - - my $servers = C4::Koha::displayServers( $position ); - isa_ok( $servers, 'ARRAY' ); - ok( scalar @$servers, 'received at least one server' ); - - # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); -} - -=head2 type_does_not_exist - -call displayServers with a type that does not exist and make sure -that we get none back. - -=cut - -sub type_does_not_exist : Test( 2 ) { - my $self = shift; - - my $servers = C4::Koha::displayServers( undef, 'this does not exist' ); - isa_ok( $servers, 'ARRAY' ); - is( scalar @$servers, 0, 'received no servers' ); - - # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); -} - -=head2 type_does_exist - -call displayServers with a type that does exist and make sure -that we get at least one back. - -=cut - -sub type_does_exist : Test( 3 ) { - my $self = shift; - - my $type = $self->_get_a_type(); - ok( $type, 'We have a type that exists' ); - - my $servers = C4::Koha::displayServers( undef, $type ); - isa_ok( $servers, 'ARRAY' ); - ok( scalar @$servers, 'received at least one server' ); - - # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); -} - -=head2 position_and_type - -call displayServers with a variety of both positions and types and -verify that we get either something or nothing back. - - -=cut - -sub position_and_type : Test( 8 ) { - my $self = shift; - - my ( $position, $type ) = $self->_get_a_position_and_type(); - ok( $position, 'We have a type that exists' ); - ok( $type, 'We have a type that exists' ); - - my $servers = C4::Koha::displayServers( $position, 'type does not exist' ); - isa_ok( $servers, 'ARRAY' ); - is( scalar @$servers, 0, 'received no servers' ); - - $servers = C4::Koha::displayServers( 'position does not exist', $type ); - isa_ok( $servers, 'ARRAY' ); - is( scalar @$servers, 0, 'received no servers' ); - - $servers = C4::Koha::displayServers( $position, $type ); - isa_ok( $servers, 'ARRAY' ); - ok( scalar @$servers, 'received at least one server' ); - - # diag( Data::Dumper->Dump( [ $servers ], [ 'servers' ] ) ); -} - -=head1 INTERNAL METHODS - -these are not test methods, but they help me write them. - -=head2 _get_a_position - -returns a position value for which at least one server exists - -=cut - -sub _get_a_position { - my $self = shift; - - my ( $position, $type ) = $self->_get_a_position_and_type(); - return $position; - -} - -=head2 _get_a_type - -returns a type value for which at least one server exists - -=cut - -sub _get_a_type { - my $self = shift; - - my ( $position, $type ) = $self->_get_a_position_and_type(); - return $type; - -} - -=head2 _get_a_position_and_type - -returns a position and type for a server - -=cut - -sub _get_a_position_and_type { - my $self = shift; - - my $dbh = C4::Context->dbh; - my $sql = 'SELECT position, type FROM z3950servers'; - my $sth = $dbh->prepare($sql) or return; - $sth->execute or return; - - my @row = $sth->fetchrow_array; - return ( $row[0], $row[1] ); - -} - - -1; diff --git a/t/lib/KohaTest/Koha/get_itemtypeinfos_of.pm b/t/lib/KohaTest/Koha/get_itemtypeinfos_of.pm deleted file mode 100644 index 9845e90576..0000000000 --- a/t/lib/KohaTest/Koha/get_itemtypeinfos_of.pm +++ /dev/null @@ -1,59 +0,0 @@ -package KohaTest::Koha::get_itemtypeinfos_of; -use base qw( KohaTest::Koha ); - -use strict; -use warnings; - -use Test::More; - -use C4::Koha; - -=head2 get_one - -calls get_itemtypeinfos_of on one item type and checks that it gets -back something sane. - -=cut - -sub get_one : Test( 8 ) { - my $self = shift; - - my $itemtype_info = C4::Koha::get_itemtypeinfos_of( 'BK' ); - ok( $itemtype_info, 'we got back something from get_itemtypeinfos_of' ); - isa_ok( $itemtype_info, 'HASH', '...and it' ); - ok( exists $itemtype_info->{'BK'}, '...and it has a BK key' ) - or diag( Data::Dumper->Dump( [ $itemtype_info ], [ 'itemtype_info' ] ) ); - is( scalar keys %$itemtype_info, 1, '...and it has 1 key' ); - foreach my $key ( qw( imageurl itemtype notforloan description ) ) { - ok( exists $itemtype_info->{'BK'}{$key}, "...and the BK info has a $key key" ); - } - -} - -=head2 get_two - -calls get_itemtypeinfos_of on a list of item types and verifies the -results. - -=cut - -sub get_two : Test( 13 ) { - my $self = shift; - - my @itemtypes = qw( BK MU ); - my $itemtype_info = C4::Koha::get_itemtypeinfos_of( @itemtypes ); - ok( $itemtype_info, 'we got back something from get_itemtypeinfos_of' ); - isa_ok( $itemtype_info, 'HASH', '...and it' ); - is( scalar keys %$itemtype_info, scalar @itemtypes, '...and it has ' . scalar @itemtypes . ' keys' ); - foreach my $it ( @itemtypes ) { - ok( exists $itemtype_info->{$it}, "...and it has a $it key" ) - or diag( Data::Dumper->Dump( [ $itemtype_info ], [ 'itemtype_info' ] ) ); - foreach my $key ( qw( imageurl itemtype notforloan description ) ) { - ok( exists $itemtype_info->{$it}{$key}, "...and the $it info has a $key key" ); - } - } - -} - - -1; diff --git a/t/lib/KohaTest/Koha/getitemtypeimagedir.pm b/t/lib/KohaTest/Koha/getitemtypeimagedir.pm deleted file mode 100644 index ea8b034a39..0000000000 --- a/t/lib/KohaTest/Koha/getitemtypeimagedir.pm +++ /dev/null @@ -1,27 +0,0 @@ -package KohaTest::Koha::getitemtypeimagedir; -use base qw( KohaTest::Koha ); - -use strict; -use warnings; - -use Test::More; - -use C4::Koha; - -sub check_default : Test( 5 ) { - my $self = shift; - - my $opac_directory = C4::Koha::getitemtypeimagedir('opac'); - my $default_directory = C4::Koha::getitemtypeimagedir('opac'); - my $intranet_directory = C4::Koha::getitemtypeimagedir('intranet'); - - ok( $opac_directory, 'the opac directory is defined' ); - ok( $default_directory, 'the default directory is defined' ); - ok( $intranet_directory, 'the intranet directory is defined' ); - - is( $opac_directory, $default_directory, 'the opac directory is returned as the default' ); - isnt( $intranet_directory, $default_directory, 'the intranet directory is not the same as the default' ); - -} - -1; diff --git a/t/lib/KohaTest/Letters.pm b/t/lib/KohaTest/Letters.pm deleted file mode 100644 index 97d58fbed7..0000000000 --- a/t/lib/KohaTest/Letters.pm +++ /dev/null @@ -1,28 +0,0 @@ -package KohaTest::Letters; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members; -sub testing_class { 'C4::Letters' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( getletter - addalert - delalert - getalert - findrelatedto - SendAlerts - parseletter - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Letters/GetLetter.pm b/t/lib/KohaTest/Letters/GetLetter.pm deleted file mode 100644 index 76b6ab4e81..0000000000 --- a/t/lib/KohaTest/Letters/GetLetter.pm +++ /dev/null @@ -1,33 +0,0 @@ -package KohaTest::Letters::GetLetter; -use base qw( KohaTest::Letters ); - -use strict; -use warnings; - -use C4::Letters; -use Test::More; - -sub GetLetter : Test( 6 ) { - my $self = shift; - - my $letter = getletter( 'circulation', 'ODUE' ); - - isa_ok( $letter, 'HASH' ) - or diag( Data::Dumper->Dump( [ $letter ], [ 'letter' ] ) ); - - is( $letter->{'code'}, 'ODUE', 'code' ); - is( $letter->{'module'}, 'circulation', 'module' ); - ok( exists $letter->{'content'}, 'content' ); - ok( exists $letter->{'name'}, 'name' ); - ok( exists $letter->{'title'}, 'title' ); - - -} - -1; - - - - - - diff --git a/t/lib/KohaTest/Letters/GetLetters.pm b/t/lib/KohaTest/Letters/GetLetters.pm deleted file mode 100644 index 576b3bf4c2..0000000000 --- a/t/lib/KohaTest/Letters/GetLetters.pm +++ /dev/null @@ -1,30 +0,0 @@ -package KohaTest::Letters::GetLetters; -use base qw( KohaTest::Letters ); - -use strict; -use warnings; - -use C4::Letters; -use Test::More; - -sub GetDefaultLetters : Test( 2 ) { - my $self = shift; - - my $letters = GetLetters(); - - # the default install includes several entries in the letter table. - isa_ok( $letters, 'HASH' ) - or diag( Data::Dumper->Dump( [ $letters ], [ 'letters' ] ) ); - - ok( scalar keys( %$letters ) > 0, 'we got some letters' ); - - -} - -1; - - - - - - diff --git a/t/lib/KohaTest/Log.pm b/t/lib/KohaTest/Log.pm deleted file mode 100644 index dc7b26eef4..0000000000 --- a/t/lib/KohaTest/Log.pm +++ /dev/null @@ -1,25 +0,0 @@ -package KohaTest::Log; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Log; -sub testing_class { 'C4::Log' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( logaction - GetLogStatus - displaylog - GetLogs - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Members.pm b/t/lib/KohaTest/Members.pm deleted file mode 100644 index ff18869bc9..0000000000 --- a/t/lib/KohaTest/Members.pm +++ /dev/null @@ -1,61 +0,0 @@ -package KohaTest::Members; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members; -sub testing_class { 'C4::Members' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( SearchMember - GetMemberDetails - patronflags - GetMember - GetMemberIssuesAndFines - ModMember - AddMember - Check_Userid - changepassword - fixup_cardnumber - GetGuarantees - UpdateGuarantees - GetPendingIssues - GetAllIssues - GetMemberAccountRecords - GetBorNotifyAcctRecord - checkuniquemember - checkcardnumber - getzipnamecity - getidcity - GetExpiryDate - checkuserpassword - GetborCatFromCatType - GetBorrowercategory - ethnicitycategories - fixEthnicity - GetAge - get_institutions - add_member_orgs - MoveMemberToDeleted - DelMember - ExtendMemberSubscriptionTo - GetTitles - GetPatronImage - PutPatronImage - RmPatronImage - GetBorrowersWhoHaveNotBorrowedSince - GetBorrowersWhoHaveNeverBorrowed - GetBorrowersWithIssuesHistoryOlderThan - GetBorrowersNamesAndLatestIssue - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Members/AttributeTypes.pm b/t/lib/KohaTest/Members/AttributeTypes.pm deleted file mode 100644 index 652526705e..0000000000 --- a/t/lib/KohaTest/Members/AttributeTypes.pm +++ /dev/null @@ -1,119 +0,0 @@ -package KohaTest::Members::AttributeTypes; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members::AttributeTypes; -sub testing_class { 'C4::Members::AttributeTypes' }; - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new - fetch - GetAttributeTypes - code - description - repeatable - unique_id - opac_display - password_allowed - staff_searchable - authorised_value_category - store - delete - ); - - can_ok( $self->testing_class, @methods ); -} - -sub startup_50_create_types : Test( startup => 28 ) { - my $self = shift; - - my $type1 = C4::Members::AttributeTypes->new('CAMPUSID', 'institution ID'); - isa_ok($type1, 'C4::Members::AttributeTypes'); - is($type1->code(), 'CAMPUSID', "set code in constructor"); - is($type1->description(), 'institution ID', "set description in constructor"); - ok(!$type1->repeatable(), "repeatable defaults to false"); - ok(!$type1->unique_id(), "unique_id defaults to false"); - ok(!$type1->opac_display(), "opac_display defaults to false"); - ok(!$type1->password_allowed(), "password_allowed defaults to false"); - ok(!$type1->staff_searchable(), "staff_searchable defaults to false"); - is($type1->authorised_value_category(), '', "authorised_value_category defaults to ''"); - - $type1->repeatable('foobar'); - ok($type1->repeatable(), "repeatable now true"); - cmp_ok($type1->repeatable(), '==', 1, "repeatable not set to 'foobar'"); - $type1->repeatable(0); - ok(!$type1->repeatable(), "repeatable now false"); - - $type1->unique_id('foobar'); - ok($type1->unique_id(), "unique_id now true"); - cmp_ok($type1->unique_id(), '==', 1, "unique_id not set to 'foobar'"); - $type1->unique_id(0); - ok(!$type1->unique_id(), "unique_id now false"); - - $type1->opac_display('foobar'); - ok($type1->opac_display(), "opac_display now true"); - cmp_ok($type1->opac_display(), '==', 1, "opac_display not set to 'foobar'"); - $type1->opac_display(0); - ok(!$type1->opac_display(), "opac_display now false"); - - $type1->password_allowed('foobar'); - ok($type1->password_allowed(), "password_allowed now true"); - cmp_ok($type1->password_allowed(), '==', 1, "password_allowed not set to 'foobar'"); - $type1->password_allowed(0); - ok(!$type1->password_allowed(), "password_allowed now false"); - - $type1->staff_searchable('foobar'); - ok($type1->staff_searchable(), "staff_searchable now true"); - cmp_ok($type1->staff_searchable(), '==', 1, "staff_searchable not set to 'foobar'"); - $type1->staff_searchable(0); - ok(!$type1->staff_searchable(), "staff_searchable now false"); - - $type1->code('INSTID'); - is($type1->code(), 'CAMPUSID', 'code() allows retrieving but not setting'); - $type1->description('student ID'); - is($type1->description(), 'student ID', 'set description'); - $type1->authorised_value_category('CAT'); - is($type1->authorised_value_category(), 'CAT', 'set authorised_value_category'); - - $type1->repeatable(1); - $type1->staff_searchable(1); - $type1->store(); - is($type1->num_patrons(), 0, 'no patrons using the new attribute type yet'); - - my $type2 = C4::Members::AttributeTypes->new('ABC', 'ABC ID'); - $type2->store(); -} - -sub shutdown_50_list_and_remove_types : Test( shutdown => 11 ) { - my $self = shift; - - my @list = C4::Members::AttributeTypes::GetAttributeTypes(); - is_deeply(\@list, [ { code => 'ABC', description => 'ABC ID' }, - { code => 'CAMPUSID', description => 'student ID' } ], "retrieved list of types"); - - my $type1 = C4::Members::AttributeTypes->fetch($list[1]->{code}); - isa_ok($type1, 'C4::Members::AttributeTypes'); - is($type1->code(), 'CAMPUSID', 'fetched code'); - is($type1->description(), 'student ID', 'fetched description'); - is($type1->authorised_value_category(), 'CAT', 'fetched authorised_value_category'); - ok($type1->repeatable(), "fetched repeatable"); - ok(!$type1->unique_id(), "fetched unique_id"); - ok(!$type1->opac_display(), "fetched opac_display"); - ok(!$type1->password_allowed(), "fetched password_allowed"); - ok($type1->staff_searchable(), "fetched staff_searchable"); - - $type1->delete(); - C4::Members::AttributeTypes->delete('ABC'); - - my @newlist = C4::Members::AttributeTypes::GetAttributeTypes(); - is(scalar(@newlist), 0, "no types left after deletion"); - -} - -1; diff --git a/t/lib/KohaTest/Members/DebarMember.pm b/t/lib/KohaTest/Members/DebarMember.pm deleted file mode 100644 index 9e27d6647a..0000000000 --- a/t/lib/KohaTest/Members/DebarMember.pm +++ /dev/null @@ -1,44 +0,0 @@ -package KohaTest::Members::DebarMember; -use base qw( KohaTest::Members ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members; -sub testing_class { 'C4::Members' }; - - -sub simple_usage : Test( 6 ) { - my $self = shift; - - ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); - - my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - ok( exists $details->{'flags'}, 'member details has a "flags" attribute'); - isa_ok( $details->{'flags'}, 'HASH', 'the "flags" attribute is a hashref'); - ok( ! $details->{'flags'}->{'DBARRED'}, 'this member is NOT debarred' ); - - # Now, let's debar this member and see what happens - my $success = C4::Members::DebarMember( $self->{'memberid'} ); - - ok( $success, 'we were able to debar the member' ); - - $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - ok( $details->{'flags'}->{'DBARRED'}, 'this member is debarred now' ) - or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) ); -} - -sub incorrect_usage : Test( 2 ) { - my $self = shift; - - my $result = C4::Members::DebarMember(); - ok( ! defined $result, 'DebarMember returns undef when passed no parameters' ); - - $result = C4::Members::DebarMember( 'this is not a borrowernumber' ); - ok( ! defined $result, 'DebarMember returns undef when not passed a numeric argument' ); - -} - -1; diff --git a/t/lib/KohaTest/Members/GetMember.pm b/t/lib/KohaTest/Members/GetMember.pm deleted file mode 100644 index 51870ad6ff..0000000000 --- a/t/lib/KohaTest/Members/GetMember.pm +++ /dev/null @@ -1,197 +0,0 @@ -package KohaTest::Members::GetMember; -use base qw( KohaTest::Members ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members; - -sub testing_class { 'C4::Members' } - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=head3 startup_create_borrower - -Creates a new borrower to use for these tests. Class variables that are -used to search by are stored for easy access by the methods. - -=cut - -sub startup_create_borrower : Test( startup => 1 ) { - my $self = shift; - - my $memberinfo = { - surname => 'surname' . $self->random_string(), - firstname => 'firstname' . $self->random_string(), - address => 'address' . $self->random_string(), - city => 'city' . $self->random_string(), - cardnumber => 'card' . $self->random_string(), - branchcode => 'U1BCG', - categorycode => 'D', # B => Board - dateexpiry => '2020-01-01', - password => 'testpassword', - userid => 'testuser', - dateofbirth => $self->random_date(), - }; - - my $borrowernumber = AddMember( %$memberinfo ); - ok( $borrowernumber, "created member: $borrowernumber" ); - $self->{get_new_borrowernumber} = $borrowernumber; - $self->{get_new_cardnumber} = $memberinfo->{cardnumber}; - $self->{get_new_firstname} = $memberinfo->{firstname}; - $self->{get_new_userid} = $memberinfo->{userid}; - - return; -} - -=head2 TESTING METHODS - -Standard test methods - -=head3 borrowernumber_get - -Validates that GetMember can search by borrowernumber - -=cut - -sub borrowernumber_get : Test( 6 ) { - my $self = shift; - - ok( $self->{get_new_borrowernumber}, - "we have a valid memberid $self->{get_new_borrowernumber} to test with" ); - - #search by borrowernumber - my $results = - C4::Members::GetMember( borrowernumber=>$self->{get_new_borrowernumber}); - ok( $results, 'we successfully called GetMember searching by borrowernumber' ); - - ok( exists $results->{borrowernumber}, - 'member details has a "borrowernumber" attribute' ); - is( $results->{borrowernumber}, - $self->{get_new_borrowernumber}, - '...and it matches the created borrowernumber' - ); - - ok( exists $results->{'category_type'}, "categories in the join returned values" ); - ok( $results->{description}, "...and description is valid: $results->{description}" ); -} - -=head3 cardnumber_get - -Validates that GetMember can search by cardnumber - -=cut - -sub cardnumber_get : Test( 6 ) { - my $self = shift; - - ok( $self->{get_new_cardnumber}, - "we have a valid cardnumber $self->{get_new_cardnumber} to test with" ); - - #search by cardnumber - my $results = C4::Members::GetMember( 'cardnumber'=>$self->{get_new_cardnumber} ); - ok( $results, 'we successfully called GetMember searching by cardnumber' ); - - ok( exists $results->{cardnumber}, 'member details has a "cardnumber" attribute' ); - is( $results->{cardnumber}, - $self->{get_new_cardnumber}, - '..and it matches the created cardnumber' - ); - - ok( exists $results->{'category_type'}, "categories in the join returned values" ); - ok( $results->{description}, "...and description is valid: $results->{description}" ); -} - -=head3 firstname_get - -Validates that GetMember can search by firstname. -Note that only the first result is used. - -=cut - -sub firstname_get : Test( 6 ) { - my $self = shift; - - ok( $self->{get_new_firstname}, - "we have a valid firstname $self->{get_new_firstname} to test with" ); - - ##search by firstname - my $results = C4::Members::GetMember( 'firstname'=>$self->{get_new_firstname} ); - ok( $results, 'we successfully called GetMember searching by firstname' ); - - ok( exists $results->{firstname}, 'member details has a "firstname" attribute' ); - is( $results->{'firstname'}, - $self->{get_new_firstname}, - '..and it matches the created firstname' - ); - - ok( exists $results->{'category_type'}, "categories in the join returned values" ); - ok( $results->{description}, "...and description is valid: $results->{description}" ); -} - -=head3 userid_get - -Validates that GetMember can search by userid. - -=cut - -sub userid_get : Test( 6 ) { - my $self = shift; - - ok( $self->{get_new_userid}, - "we have a valid userid $self->{get_new_userid} to test with" ); - - #search by userid - my $results = C4::Members::GetMember( 'userid'=>$self->{get_new_userid} ); - ok( $results, 'we successfully called GetMember searching by userid' ); - - ok( exists $results->{'userid'}, 'member details has a "userid" attribute' ); - is( $results->{userid}, - $self->{get_new_userid}, - '..and it matches the created userid' - ); - - ok( exists $results->{'category_type'}, "categories in the join returned values" ); - ok( $results->{description}, "...and description is valid: $results->{description}" ); -} - -=head3 missing_params - -Validates that GetMember returns undef when no parameters are passed to it - -=cut - -sub missing_params : Test( 1 ) { - my $self = shift; - - my $results = C4::Members::GetMember(); - - ok( !defined $results, 'returned undef when no parameters passed' ); - -} - -=head2 SHUTDOWN METHODS - -These get run once, after the main test methods in this module - -=head3 shutdown_remove_borrower - -Remove the new borrower information that was created in the startup method - -=cut - -sub shutdown_remove_borrower : Test( shutdown => 0 ) { - my $self = shift; - - delete $self->{get_new_borrowernumber}; - delete $self->{get_new_cardnumber}; - delete $self->{get_new_firstname}; - delete $self->{get_new_userid}; - -} - -1; diff --git a/t/lib/KohaTest/Members/GetMemberDetails.pm b/t/lib/KohaTest/Members/GetMemberDetails.pm deleted file mode 100644 index e93742bf69..0000000000 --- a/t/lib/KohaTest/Members/GetMemberDetails.pm +++ /dev/null @@ -1,150 +0,0 @@ -package KohaTest::Members::GetMemberDetails; -use base qw( KohaTest::Members ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members; - -sub testing_class { 'C4::Members' } - -=head3 STARTUP METHODS - -These are run once, before the main test methods in this module. - -=head2 startup_create_detailed_borrower - -Creates a new borrower to be used by the testing methods. Also -populates the class hash with values to be compared from the database -retrieval. - -=cut - -sub startup_create_detailed_borrower : Test( startup => 2 ) { - my $self = shift; - my ( $description, $type, $amount, $user ); - - my $memberinfo = { - surname => 'surname' . $self->random_string(), - firstname => 'firstname' . $self->random_string(), - address => 'address' . $self->random_string(), - city => 'city' . $self->random_string(), - cardnumber => 'card' . $self->random_string(), - branchcode => 'CPL', - categorycode => 'B', - dateexpiry => '2020-01-01', - password => 'testpassword', - userid => 'testuser', - flags => '0', - dateofbirth => $self->random_date(), - }; - - my $borrowernumber = AddMember( %$memberinfo ); - ok( $borrowernumber, "created member: $borrowernumber" ); - $self->{detail_borrowernumber} = $borrowernumber; - $self->{detail_cardnumber} = $memberinfo->{cardnumber}; - - #values for adding a record to accounts - $description = 'Test account'; - $type = 'M'; - $amount = 5.00; - $user = ''; - - my $acct_added = - C4::Accounts::manualinvoice( $borrowernumber, undef, $description, $type, $amount, - $user ); - - ok( $acct_added == 0, 'added account for borrower' ); - - $self->{amountoutstanding} = $amount; - - return; -} - -=head2 TESTING METHODS - -=head3 borrower_detail_get - -Tests the functionality of the GetMemberDetails method in C4::Members. -Validates the join on categories table works as well as the extra fields -the method gets from outside of either the borrowers and categories table like -amountoutstanding and user flags. - -=cut - -sub borrower_detail_get : Test( 8 ) { - my $self = shift; - - ok( $self->{detail_borrowernumber}, - 'we have a valid detailed borrower to test with' ); - - my $details = C4::Members::GetMemberDetails( $self->{detail_borrowernumber} ); - ok( $details, 'we successfully called GetMemberDetails' ); - ok( exists $details->{categorycode}, - 'member details has a "categorycode" attribute' ); - ok( $details->{categorycode}, '...and it is set to something' ); - - ok( exists $details->{category_type}, "categories in the join returned values" ); - - ok( $details->{category_type}, '...and category_type is valid' ); - - ok( $details->{amountoutstanding}, 'an amountoutstanding exists' ); - is( $details->{amountoutstanding}, - $self->{amountoutstanding}, - '...and matches inserted account record' - ); - -} - -=head3 cardnumber_detail_get - -This method tests the capability of GetMemberDetails to search on cardnumber. There doesn't seem to be any -current calls to GetMemberDetail using cardnumber though, so this test may not be necessary. - -=cut - -sub cardnumber_detail_get : Test( 8 ) { - my $self = shift; - - ok( $self->{detail_cardnumber}, - "we have a valid detailed borrower to test with $self->{detail_cardnumber}" ); - - my $details = C4::Members::GetMemberDetails( undef, $self->{detail_cardnumber} ); - ok( $details, 'we successfully called GetMemberDetails' ); - ok( exists $details->{categorycode}, - "member details has a 'categorycode' attribute $details->{categorycode}" ); - ok( $details->{categorycode}, '...and it is set to something' ); - - ok( exists $details->{category_type}, "categories in the join returned values" ); - - ok( $details->{category_type}, '...and category_type is valid' ); - -#FIXME These 2 methods will fail as borrowernumber is not set in GetMemberDetails when cardnumber is used instead. -#ok( $details->{amountoutstanding}, 'an amountoutstanding exists' ); -#is( $details->{amountoutstanding}, $self->{amountoutstanding}, '...and matches inserted account record' ); -} - -=head2 SHUTDOWN METHDOS - -These get run once, after the main test methods in this module. - -=head3 shutdown_remove_new_borrower - -Removes references in the Class to the new borrower created -in the startup methods. - -=cut - -sub shutdown_remove_new_borrower : Test( shutdown => 0 ) { - my $self = shift; - - delete $self->{detail_borrowernumber}; - delete $self->{detail_cardnumber}; - delete $self->{amountoutstanding}; - - return; -} - -1; diff --git a/t/lib/KohaTest/Members/ModMember.pm b/t/lib/KohaTest/Members/ModMember.pm deleted file mode 100644 index 876677fd5e..0000000000 --- a/t/lib/KohaTest/Members/ModMember.pm +++ /dev/null @@ -1,103 +0,0 @@ -package KohaTest::Members::ModMember; -use base qw( KohaTest::Members ); - -use strict; -use warnings; - -use Test::More; - -use C4::Members; -sub testing_class { 'C4::Members' }; - - -sub a_simple_usage : Test( 7 ) { - my $self = shift; - - ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); - - my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - ok( exists $details->{'dateofbirth'}, 'member details has a "dateofbirth" attribute'); - ok( $details->{'dateofbirth'}, '...and it is set to something' ); - - my $new_date_of_birth = $self->random_date(); - like( $new_date_of_birth, qr(^\d\d\d\d-\d\d-\d\d$), 'The new date of birth is a yyyy-mm-dd' ); - - my $success = C4::Members::ModMember( - borrowernumber => $self->{'memberid'}, - dateofbirth => $new_date_of_birth - ); - - ok( $success, 'we successfully called ModMember' ); - - $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - ok( exists $details->{'dateofbirth'}, 'member details still has a "dateofbirth" attribute'); - is( $details->{'dateofbirth'}, $new_date_of_birth, '...and it is set to the new_date_of_birth' ); - -} - -sub incorrect_usage : Test( 1 ) { - my $self = shift; - - local $TODO = 'ModMember does not fail gracefully yet'; - - my $result = C4::Members::ModMember(); - ok( ! defined $result, 'ModMember returns false when passed no parameters' ); - -} - -=head2 preserve_dates - -In bug 2284, it was determined that a Member's dateofbirth could be -erased by a call to ModMember if no date_of_birth was passed in. Three -date fields (dateofbirth, dateexpiry ,and dateenrolled) are treated -differently than other fields by ModMember. This test method calls -ModMember with none of the date fields set to ensure that they are not -overwritten. - -=cut - - -sub preserve_dates : Test( 18 ) { - my $self = shift; - - ok( $self->{'memberid'}, 'we have a valid memberid to test with' ); - - my %date_fields = ( - dateofbirth => $self->random_date(), - dateexpiry => $self->random_date(), - dateenrolled => $self->random_date(), - ); - - # stage our member with valid dates in all of the date fields - my $success = C4::Members::ModMember( - borrowernumber => $self->{'memberid'}, - %date_fields, - ); - ok( $success, 'succefully set the date fields.' ); - - # make sure that we successfully set the date fields. They're not undef. - my $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - foreach my $date_field ( keys %date_fields ) { - ok( exists $details->{$date_field}, qq(member details has a "$date_field" attribute) ); - ok( $details->{$date_field}, '...and it is set to something true' ); - is( $details->{$date_field}, $date_fields{$date_field}, '...and it is set to what we set it' ); - } - - # call ModMember to update the firstname. Notice that we're not - # updating any date fields. - $success = C4::Members::ModMember( - borrowernumber => $self->{'memberid'}, - firstname => $self->random_string, - ); - ok( $success, 'we successfully called ModMember' ); - - # make sure that none of the date fields have been molested by our call to ModMember. - $details = C4::Members::GetMemberDetails( $self->{'memberid'} ); - foreach my $date_field ( keys %date_fields ) { - ok( exists $details->{$date_field}, qq(member details still has a "$date_field" attribute) ); - is( $details->{$date_field}, $date_fields{$date_field}, '...and it is set to the expected value' ); - } - -} - -1; diff --git a/t/lib/KohaTest/Message.pm b/t/lib/KohaTest/Message.pm deleted file mode 100644 index d1d822f2ee..0000000000 --- a/t/lib/KohaTest/Message.pm +++ /dev/null @@ -1,52 +0,0 @@ -package KohaTest::Message; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Message; -sub testing_class { 'C4::Message' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - new - find - find_last_message - enqueue - update - metadata - render_metadata - append - ); - - can_ok( $self->testing_class, @methods ); -} - -sub test_metadata : Test( 1 ) { - my $self = shift; - my $message = C4::Message->new; - $message->metadata({ - header => "Header", - body => [], - footer => "Footer", - }); - like($message->{metadata}, qr{^---}, "The metadata attribute should be serialized as YAML."); -} - -sub test_append : Test( 1 ) { - my $self = shift; - my $message = C4::Message->new; - $message->metadata({ - header => "Header", - body => [], - footer => "Footer", - }); - $message->append("foo"); - is($message->metadata->{body}->[0], "foo", "Appending a string should add an element to metadata.body."); -} - -1; diff --git a/t/lib/KohaTest/NewsChannels.pm b/t/lib/KohaTest/NewsChannels.pm deleted file mode 100644 index 507677e35e..0000000000 --- a/t/lib/KohaTest/NewsChannels.pm +++ /dev/null @@ -1,28 +0,0 @@ -package KohaTest::NewsChannels; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::NewsChannels; -sub testing_class { 'C4::NewsChannels' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - add_opac_new - upd_opac_new - del_opac_new - get_opac_new - get_opac_news - GetNewsToDisplay - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Overdues.pm b/t/lib/KohaTest/Overdues.pm deleted file mode 100644 index 949c670961..0000000000 --- a/t/lib/KohaTest/Overdues.pm +++ /dev/null @@ -1,50 +0,0 @@ -package KohaTest::Overdues; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Overdues; -sub testing_class { 'C4::Overdues' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( Getoverdues - checkoverdues - CalcFine - GetSpecialHolidays - GetRepeatableHolidays - GetWdayFromItemnumber - GetIssuesIteminfo - UpdateFine - BorType - ReplacementCost - GetFine - GetIssuingRules - ReplacementCost2 - GetNextIdNotify - NumberNotifyId - AmountNotify - UpdateAccountLines - GetItems - GetOverdueDelays - CheckAccountLineLevelInfo - GetOverduerules - CheckBorrowerDebarred - UpdateBorrowerDebarred - CheckExistantNotifyid - CheckAccountLineItemInfo - CheckItemNotify - GetOverduesForBranch - AddNotifyLine - RemoveNotifyLine - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm b/t/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm deleted file mode 100644 index 4ff8db4916..0000000000 --- a/t/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm +++ /dev/null @@ -1,59 +0,0 @@ -package KohaTest::Overdues::GetBranchcodesWithOverdueRules; -use base qw( KohaTest::Overdues ); - -use strict; -use warnings; - -use C4::Overdues; -use Test::More; - -sub my_branch_has_no_rules : Tests( 2 ) { - my $self = shift; - - ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); - - my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; - my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; - is( scalar @found_branches, 0, '...and it is not in the list of branches') - -} - -sub my_branch_has_overdue_rules : Tests( 3 ) { - my $self = shift; - - ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); - - my $dbh = C4::Context->dbh(); - my $sql = <<'END_SQL'; -INSERT INTO overduerules -(branchcode, categorycode, -delay1, letter1, debarred1, -delay2, letter2, debarred2, -delay3, letter3, debarred3) -VALUES -( ?, ?, -?, ?, ?, -?, ?, ?, -?, ?, ?) -END_SQL - - my $sth = $dbh->prepare($sql); - my $success = $sth->execute( $self->{'branchcode'}, $self->random_string(2), - 1, $self->random_string(), 0, - 5, $self->random_string(), 0, - 9, $self->random_string(), 1, ); - ok( $success, '...and we have successfully given it an overdue rule' ); - - my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; - my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; - is( scalar @found_branches, 1, '...and it IS in the list of branches.') - -} - -1; - - - - - - diff --git a/t/lib/KohaTest/Overdues/GetOverdues.pm b/t/lib/KohaTest/Overdues/GetOverdues.pm deleted file mode 100644 index 3cfc4386bc..0000000000 --- a/t/lib/KohaTest/Overdues/GetOverdues.pm +++ /dev/null @@ -1,126 +0,0 @@ -package KohaTest::Overdues::GetOverdues; -use base qw( KohaTest::Overdues ); - -use strict; -use warnings; - -use C4::Overdues; -use Test::More; - -=head3 create_overdue_item - -=cut - -sub startup_60_create_overdue_item : Test( startup => 17 ) { - my $self = shift; - - $self->add_biblios( add_items => 1 ); - - my $biblionumber = $self->{'biblios'}[0]; - ok( $biblionumber, 'biblionumber' ); - my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $biblionumber ); - ok( scalar @biblioitems > 0, 'there is at least one biblioitem' ); - my $biblioitemnumber = $biblioitems[0]->{'biblioitemnumber'}; - ok( $biblioitemnumber, 'got a biblioitemnumber' ); - - my $items = C4::Items::GetItemsByBiblioitemnumber( $biblioitemnumber); - - my $item = $items->[0]; - ok( $item->{'itemnumber'}, 'item number' ); - $self->{'overdueitemnumber'} = $item->{'itemnumber'}; - - # let's use the database to do date math for us. - # This is a US date, but that's how C4::Dates likes it, apparently. - my $dbh = C4::Context->dbh(); - my $date_list = $dbh->selectcol_arrayref( q( select DATE_FORMAT( FROM_DAYS( TO_DAYS( NOW() ) - 6 ), '%m/%d/%Y' ) ) ); - my $six_days_ago = shift( @$date_list ); - - my $duedate = C4::Dates->new( $six_days_ago ); - # diag( Data::Dumper->Dump( [ $duedate ], [ 'duedate' ] ) ); - - ok( $item->{'barcode'}, 'barcode' ) - or diag( Data::Dumper->Dump( [ $item ], [ 'item' ] ) ); - # my $item_from_barcode = C4::Items::GetItem( undef, $item->{'barcode'} ); - # diag( Data::Dumper->Dump( [ $item_from_barcode ], [ 'item_from_barcode' ] ) ); - - ok( $self->{'memberid'}, 'memberid' ); - my $borrower = C4::Members::GetMember( borrowernumber=>$self->{'memberid'} ); - ok( $borrower->{'borrowernumber'}, 'borrowernumber' ); - - my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $item->{'barcode'}, $duedate, 0 ); - # diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); - is( keys %$issuingimpossible, 0, 'issuing is not impossible' ); - is( keys %$needsconfirmation, 0, 'issuing needs no confirmation' ); - - C4::Circulation::AddIssue( $borrower, $item->{'barcode'}, $duedate ); -} - -sub basic_usage : Test( 2 ) { - my $self = shift; - - my $overdues = C4::Overdues::Getoverdues(); - isa_ok( $overdues, 'ARRAY' ); - is( scalar @$overdues, 1, 'found our one overdue book' ); -} - -sub limit_minimum_and_maximum : Test( 2 ) { - my $self = shift; - - my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 100 } ); - isa_ok( $overdues, 'ARRAY' ); - is( scalar @$overdues, 1, 'found our one overdue book' ); -} - -sub limit_and_do_not_find_it : Test( 2 ) { - my $self = shift; - - my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 2 } ); - isa_ok( $overdues, 'ARRAY' ); - is( scalar @$overdues, 0, 'there are no overdue books in that range.' ); -} - -=pod - -sub run_overduenotices_script : Test( 1 ) { - my $self = shift; - - # make sure member wants alerts - C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'}, - { code => 'PREDEmail', - value => '1' } ); - - # we're screwing with C4::Circulation::GetUpcomingIssues by passing in a negative number. - C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'}, - { code => 'PREDDAYS', - value => '-6' } ); - - - my $before_count = $self->count_message_queue(); - - my $output = qx( ../misc/cronjobs/advance_notices.pl -c ); - - my $after_count = $self->count_message_queue(); - is( $after_count, $before_count + 1, 'there is one more message in the queue than there used to be.' ) - or diag $output; - -} - - -=cut - -sub count_message_queue { - my $self = shift; - - my $dbh = C4::Context->dbh(); - my $statement = q( select count(0) from message_queue where status = 'pending' ); - my $countlist = $dbh->selectcol_arrayref( $statement ); - return $countlist->[0]; -} - -1; - - - - - - diff --git a/t/lib/KohaTest/Print.pm b/t/lib/KohaTest/Print.pm deleted file mode 100644 index 02fd5fb894..0000000000 --- a/t/lib/KohaTest/Print.pm +++ /dev/null @@ -1,24 +0,0 @@ -package KohaTest::Print; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Print; -sub testing_class { 'C4::Print' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( remoteprint - printreserve - printslip - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Reserves.pm b/t/lib/KohaTest/Reserves.pm deleted file mode 100644 index 5317029c75..0000000000 --- a/t/lib/KohaTest/Reserves.pm +++ /dev/null @@ -1,41 +0,0 @@ -package KohaTest::Reserves; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Reserves; -sub testing_class { 'C4::Reserves' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( AddReserve - GetReservesFromBiblionumber - GetReservesFromItemnumber - GetReservesFromBorrowernumber - GetReserveCount - GetOtherReserves - GetReserveFee - GetReservesToBranch - GetReservesForBranch - CheckReserves - CancelReserve - ModReserve - ModReserveFill - ModReserveStatus - ModReserveAffect - ModReserveCancelAll - ModReserveMinusPriority - GetReserveInfo - _FixPriority - _Findgroupreserve - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/SMS.pm b/t/lib/KohaTest/SMS.pm deleted file mode 100644 index 00af101538..0000000000 --- a/t/lib/KohaTest/SMS.pm +++ /dev/null @@ -1,23 +0,0 @@ -package KohaTest::SMS; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::SMS; -sub testing_class { 'C4::SMS' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( send_sms - driver - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/SMS/send_sms.pm b/t/lib/KohaTest/SMS/send_sms.pm deleted file mode 100644 index d6bbb64c5b..0000000000 --- a/t/lib/KohaTest/SMS/send_sms.pm +++ /dev/null @@ -1,25 +0,0 @@ -package KohaTest::SMS::send_sms; -use base qw( KohaTest::SMS ); - -use strict; -use warnings; - -use Test::More; - -use C4::SMS; -sub testing_class { 'C4::SMS' }; - - -sub send_a_message : Test( 1 ) { - my $self = shift; - - my $success = C4::SMS->send_sms( { destination => '+1 212-555-1111', - message => 'This is the message', - driver => 'Test' } ); - - ok( $success, "send_sms returned a true: $success" ); - -} - - -1; diff --git a/t/lib/KohaTest/Scripts.pm b/t/lib/KohaTest/Scripts.pm deleted file mode 100644 index f44274dd15..0000000000 --- a/t/lib/KohaTest/Scripts.pm +++ /dev/null @@ -1,18 +0,0 @@ -package KohaTest::Scripts; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Search; -sub testing_class { return; }; - -# Since this is an abstract base class, this prevents these tests from -# being run directly unless we're testing a subclass. It just makes -# things faster. -__PACKAGE__->SKIP_CLASS( 1 ); - - -1; diff --git a/t/lib/KohaTest/Scripts/longoverdue.pm b/t/lib/KohaTest/Scripts/longoverdue.pm deleted file mode 100644 index e00fb0c9e8..0000000000 --- a/t/lib/KohaTest/Scripts/longoverdue.pm +++ /dev/null @@ -1,97 +0,0 @@ -package KohaTest::Scripts::longoverdue; -use base qw( KohaTest::Scripts ); - -use strict; -use warnings; - -use Test::More; -use Time::localtime; - - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=head3 create_overdue_item - -=cut - -sub create_overdue_item : Test( startup => 12 ) { - my $self = shift; - - $self->add_biblios( add_items => 1 ); - - my $biblionumber = $self->{'biblios'}[0]; - ok( $biblionumber, 'biblionumber' ); - my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $biblionumber ); - ok( scalar @biblioitems > 0, 'there is at least one biblioitem' ); - my $biblioitemnumber = $biblioitems[0]->{'biblioitemnumber'}; - ok( $biblioitemnumber, 'got a biblioitemnumber' ); - - my $items = C4::Items::GetItemsByBiblioitemnumber( $biblioitemnumber); - - my $itemnumber = $items->[0]->{'itemnumber'}; - ok( $items->[0]->{'itemnumber'}, 'item number' ); - - $self->{'overdueitemnumber'} = $itemnumber; - -} - -sub set_overdue_item_lost : Test( 13 ) { - my $self = shift; - - my $item = C4::Items::GetItem( $self->{'overdueitemnumber'} ); - is( $item->{'itemnumber'}, $self->{'overdueitemnumber'}, 'itemnumber' ); - - ok( exists $item->{'itemlost'}, 'itemlost exists' ); - ok( ! $item->{'itemlost'}, 'item is not lost' ); - - # This is a US date, but that's how C4::Dates likes it, apparently. - my $duedatestring = sprintf( '%02d/%02d/%04d', - localtime->mon() + 1, - localtime->mday(), - localtime->year() + 1900 - 1, # it was due a year ago. - ); - my $duedate = C4::Dates->new( $duedatestring ); - # diag( Data::Dumper->Dump( [ $duedate ], [ 'duedate' ] ) ); - - ok( $item->{'barcode'}, 'barcode' ) - or diag( Data::Dumper->Dump( [ $item ], [ 'item' ] ) ); - # my $item_from_barcode = C4::Items::GetItem( undef, $item->{'barcode'} ); - # diag( Data::Dumper->Dump( [ $item_from_barcode ], [ 'item_from_barcode' ] ) ); - - my $borrower = C4::Members::GetMember( borrowernumber => $self->{'memberid'} ); - ok( $borrower->{'borrowernumber'}, 'borrowernumber' ); - - my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $item->{'barcode'}, $duedate, 0 ); - # diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) ); - is( keys %$issuingimpossible, 0, 'issuing is not impossible' ); - is( keys %$needsconfirmation, 0, 'issuing needs no confirmation' ); - - my $issue_due_date = C4::Circulation::AddIssue( $borrower, $item->{'barcode'}, $duedate ); - ok( $issue_due_date, 'due date' ); - is( $issue_due_date, $duedate, 'AddIssue returned the same date we passed to it' ); - - # I have to make this in a different format since that's how the database holds it. - my $duedateyyyymmdd = sprintf( '%04d-%02d-%02d', - localtime->year() + 1900 - 1, # it was due a year ago. - localtime->mon() + 1, - localtime->mday(), - ); - - my $issued_item = C4::Items::GetItem( $self->{'overdueitemnumber'} ); - is( $issued_item->{'onloan'}, $duedateyyyymmdd, "the item is checked out and due $duedatestring" ); - is( $issued_item->{'itemlost'}, 0, 'the item is not lost' ); - # diag( Data::Dumper->Dump( [ $issued_item ], [ 'issued_item' ] ) ); - - qx( ../misc/cronjobs/longoverdue.pl --lost 90=2 --confirm ); - - my $lost_item = C4::Items::GetItem( $self->{'overdueitemnumber'} ); - is( $lost_item->{'onloan'}, $duedateyyyymmdd, "the item is checked out and due $duedatestring" ); - is( $lost_item->{'itemlost'}, 2, 'the item is lost' ); - # diag( Data::Dumper->Dump( [ $lost_item ], [ 'lost_item' ] ) ); - -} - - -1; diff --git a/t/lib/KohaTest/Search.pm b/t/lib/KohaTest/Search.pm deleted file mode 100644 index 4ad190b0b8..0000000000 --- a/t/lib/KohaTest/Search.pm +++ /dev/null @@ -1,37 +0,0 @@ -package KohaTest::Search; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Search; -sub testing_class { 'C4::Search' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( - FindDuplicate - SimpleSearch - getRecords - pazGetRecords - _remove_stopwords - _detect_truncation - _build_stemmed_operand - _build_weighted_query - buildQuery - searchResults - NZgetRecords - NZanalyse - NZoperatorAND - NZoperatorOR - NZoperatorNOT - NZorder - ); - - can_ok( $self->testing_class, @methods ); -} - -1; diff --git a/t/lib/KohaTest/Search/NoZebra.pm b/t/lib/KohaTest/Search/NoZebra.pm deleted file mode 100644 index ade916a561..0000000000 --- a/t/lib/KohaTest/Search/NoZebra.pm +++ /dev/null @@ -1,235 +0,0 @@ -package KohaTest::Search::NoZebra; -use base qw( KohaTest::Search ); - -use strict; -use warnings; - -use Test::More; - -use MARC::Record; - -use C4::Search; -use C4::Biblio; -use C4::Context; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=cut - -=head3 startup_50_init_nozebra - -Turn on NoZebra mode, for now, assumes and requires -that the test database has started out using Zebra. - -=cut - -sub startup_50_init_nozebra : Test( startup => 3 ) { - my $using_nozebra = C4::Context->preference('NoZebra'); - ok(!$using_nozebra, "starting out using Zebra"); - my $dbh = C4::Context->dbh; - $dbh->do("UPDATE systempreferences SET value=1 WHERE variable='NoZebra'"); - $dbh->do("UPDATE systempreferences SET value=0 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')"); - C4::Context->clear_syspref_cache(); - $using_nozebra = C4::Context->preference('NoZebra'); - ok($using_nozebra, "switched to NoZebra"); - - my $sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); - $sth->execute; - my ($count) = $sth->fetchrow_array; - $sth->finish; - cmp_ok($count, '==', 0, "NoZebra index starts off empty"); -} - -sub startup_51_add_bibs : Test( startup => 2 ) { - my $self = shift; - - my $bib1 = MARC::Record->new(); - $bib1->leader(' nam a22 7a 4500'); - $bib1->append_fields( - MARC::Field->new('010', ' ', ' ', a => 'lccn001'), - MARC::Field->new('020', ' ', ' ', a => 'isbn001'), - MARC::Field->new('022', ' ', ' ', a => 'issn001'), - MARC::Field->new('100', ' ', ' ', a => 'Cat, Felix T.'), - MARC::Field->new('245', ' ', ' ', a => 'Of mice and men :', b=> 'a history'), - ); - my $bib2 = MARC::Record->new(); - $bib2->leader(' nam a22 7a 4500'); - $bib2->append_fields( - MARC::Field->new('010', ' ', ' ', a => 'lccn002'), - MARC::Field->new('020', ' ', ' ', a => 'isbn002'), - MARC::Field->new('022', ' ', ' ', a => 'issn002'), - MARC::Field->new('100', ' ', ' ', a => 'Dog, Rover T.'), - MARC::Field->new('245', ' ', ' ', a => 'Of mice and men :', b=> 'a digression'), - ); - - my $dbh = C4::Context->dbh; - my $count_sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); - my $count; - my ($bib1_bibnum, $bib1_bibitemnum) = AddBiblio($bib1, ''); - $count_sth->execute; - ($count) = $count_sth->fetchrow_array; - cmp_ok($count, '==', 14, "correct number of new words indexed"); # tokens + biblionumber + __RAW__ - - my ($bib2_bibnum, $bib2_bibitemnum) = AddBiblio($bib2, ''); - $count_sth->execute; - ($count) = $count_sth->fetchrow_array; - cmp_ok($count, '==', 22, "correct number of new words indexed"); # tokens + biblionumber + __RAW__ - - push @{ $self->{nozebra_test_bibs} }, $bib1_bibnum, $bib2_bibnum; -} - -=head2 TEST METHODS - -Standard test methods - -=cut - -sub basic_searches_via_nzanalyze : Test( 28 ) { - my $self = shift; - my ($bib1_bibnum, $bib2_bibnum) = @{ $self->{nozebra_test_bibs} }; - - my $results = C4::Search::NZanalyse('foobar'); - ok(!defined($results), "no hits on 'foobar'"); - - $results = C4::Search::NZanalyse('dog'); - my ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 1, "one hit on 'dog'"); - is($bib2_bibnum, $bibnumbers[0], "correct hit on 'dog'"); - - $results = C4::Search::NZanalyse('au=dog'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 1, "one hit on 'au=dog'"); - is($bib2_bibnum, $bibnumbers[0], "correct hit on 'au=dog'"); - - $results = C4::Search::NZanalyse('isbn=dog'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 0, "zero hits on 'isbn=dog'"); - - $results = C4::Search::NZanalyse('cat'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 1, "one hit on 'cat'"); - is($bib1_bibnum, $bibnumbers[0], "correct hit on 'cat'"); - - $results = C4::Search::NZanalyse('cat and dog'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 0, "zero hits on 'cat and dog'"); - - $results = C4::Search::NZanalyse('cat or dog'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 2, "two hits on 'cat or dog'"); - is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'cat or dog'"); - - $results = C4::Search::NZanalyse('mice and men'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 2, "two hits on 'mice and men'"); - is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'mice and men'"); - - $results = C4::Search::NZanalyse('title=digression or issn=issn001'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 2, "two hits on 'title=digression or issn=issn001'"); - is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'title=digression or issn=issn001'"); - - $results = C4::Search::NZanalyse('title=digression and issn=issn002'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 1, "two hits on 'title=digression and issn=issn002'"); - is($bib2_bibnum, $bibnumbers[0], "correct hit on 'title=digression and issn=issn002'"); - - $results = C4::Search::NZanalyse('mice not men'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 0, "zero hits on 'mice not men'"); - - $results = C4::Search::NZanalyse('mice not dog'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 1, "one hit on 'mice not dog'"); - is($bib1_bibnum, $bibnumbers[0], "correct hit on 'mice not dog'"); - - $results = C4::Search::NZanalyse('isbn > a'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 2, "two hits on 'isbn > a'"); - is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'isbn > a'"); - - $results = C4::Search::NZanalyse('isbn < z'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 2, "two hits on 'isbn < z'"); - is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'isbn < z'"); - - $results = C4::Search::NZanalyse('isbn > isbn001'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 1, "one hit on 'isbn > isbn001'"); - is($bib2_bibnum, $bibnumbers[0], "correct hit on 'isbn > isbn001'"); - - $results = C4::Search::NZanalyse('isbn>=isbn001'); - ($hits, @bibnumbers) = parse_nzanalyse($results); - cmp_ok($hits, '==', 2, "two hits on 'isbn>=isbn001'"); - is_deeply([ sort @bibnumbers ], [ sort($bib1_bibnum, $bib2_bibnum) ], "correct hits on 'isbn>=isbn001'"); -} - -sub parse_nzanalyse { - my $results = shift; - my @bibnumbers = (); - if (defined $results) { - # NZanalyze currently has a funky way of returning results - - # it does not guarantee that a biblionumber occurs only - # once in the results string. Hence we must remove - # duplicates, like NZorder (inefficently) does - my %hash; - @bibnumbers = grep { ++$hash{$_} == 1 } map { my @f = split /,/, $_; $f[0]; } split /;/, $results; - } - return scalar(@bibnumbers), @bibnumbers; -} - -=head2 SHUTDOWN METHODS - -These get run once, after all of the main tests methods in this module - -=cut - -sub shutdown_49_remove_bibs : Test( shutdown => 4 ) { - my $self = shift; - my ($bib1_bibnum, $bib2_bibnum) = @{ $self->{nozebra_test_bibs} }; - - my $dbh = C4::Context->dbh; - my $count_sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); - my $count; - - my $error = DelBiblio($bib2_bibnum); - ok(!defined($error), "deleted bib $bib2_bibnum"); - $count_sth->execute; - ($count) = $count_sth->fetchrow_array; - TODO: { local $TODO = 'nothing actually gets deleted from nozebra currently'; - cmp_ok($count, '==', 14, "correct number of words indexed after bib $bib2_bibnum deleted"); - } - - $error = DelBiblio($bib1_bibnum); - ok(!defined($error), "deleted bib $bib1_bibnum"); - $count_sth->execute; - ($count) = $count_sth->fetchrow_array; - TODO: { local $TODO = 'nothing actually gets deleted from nozebra currently'; - cmp_ok($count, '==', 0, "no entries left in nozebra after bib $bib1_bibnum deleted"); - } - - delete $self->{nozebra_test_bibs}; -} - -sub shutdown_50_init_nozebra : Test( shutdown => 3 ) { - my $using_nozebra = C4::Context->preference('NoZebra'); - ok($using_nozebra, "still in NoZebra mode"); - my $dbh = C4::Context->dbh; - $dbh->do("UPDATE systempreferences SET value=0 WHERE variable='NoZebra'"); - $dbh->do("UPDATE systempreferences SET value=1 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')"); - C4::Context->clear_syspref_cache(); - $using_nozebra = C4::Context->preference('NoZebra'); - ok(!$using_nozebra, "switched to Zebra"); - - # FIXME - $dbh->do("DELETE FROM nozebra"); - my $sth = $dbh->prepare("SELECT COUNT(*) FROM nozebra"); - $sth->execute; - my ($count) = $sth->fetchrow_array; - $sth->finish; - cmp_ok($count, '==', 0, "NoZebra index finishes up empty"); -} - -1; diff --git a/t/lib/KohaTest/Search/SimpleSearch.pm b/t/lib/KohaTest/Search/SimpleSearch.pm deleted file mode 100644 index 95324f2441..0000000000 --- a/t/lib/KohaTest/Search/SimpleSearch.pm +++ /dev/null @@ -1,140 +0,0 @@ -package KohaTest::Search::SimpleSearch; -use base qw( KohaTest::Search ); - -use strict; -use warnings; - -use Test::More; - -use C4::Search; -use C4::Biblio; - -=head2 STARTUP METHODS - -These get run once, before the main test methods in this module - -=head3 insert_test_data - -=cut - -sub insert_test_data : Test( startup => 71 ) { - my $self = shift; - - # get original 'Finn Test' count - my $query = 'Finn Test'; - my ( $error, $results ) = SimpleSearch( $query ); - $self->{'orig_finn_test_hits'} = scalar(@$results); - - # I'm going to add a bunch of biblios so that I can search for them. - $self->add_biblios( count => 10, - add_items => 1 ); - -} - -=head2 STARTUP METHODS - -standard test methods - -=head3 basic_test - -basic usage. - -=cut - -sub basic_test : Test( 2 ) { - my $self = shift; - - my $query = 'test'; - - my ( $error, $results ) = SimpleSearch( $query ); - ok( ! defined $error, 'no error found during search' ); - like( $results->[0], qr/$query/i, 'the result seems to match the query' ) - or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); - -} - -=head3 basic_test_with_server - -Test the usage where we specify no limits, but we do specify a server. - -=cut - -sub basic_test_with_server : Test( 2 ) { - my $self = shift; - - my $query = 'test'; - - my ( $error, $results ) = SimpleSearch( $query, undef, undef, [ 'biblioserver' ] ); - ok( ! defined $error, 'no error found during search' ); - like( $results->[0], qr/$query/i, 'the result seems to match the query' ) - or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); - -} - - -=head3 basic_test_no_results - -Make sure we get back an empty listref when there are no results. - -=cut - -sub basic_test_no_results : Test( 3 ) { - my $self = shift; - - my $query = 'This string is almost guaranteed to not match anything.'; - - my ( $error, $results ) = SimpleSearch( $query ); - ok( ! defined $error, 'no error found during search' ); - isa_ok( $results, 'ARRAY' ); - is( scalar( @$results ), 0, 'an empty list was returned.' ) - or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); -} - -=head3 limits - -check that the SimpleTest method limits the number of results returned. - -=cut - -sub limits : Test( 8 ) { - my $self = shift; - - my $query = 'Finn Test'; - - { - my ( $error, $results ) = SimpleSearch( $query ); - ok( ! defined $error, 'no error found during search' ); - my $expected_hits = 10 + $self->{'orig_finn_test_hits'}; - is( scalar @$results, $expected_hits, "found all $expected_hits results." ) - or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); - } - - my $offset = 4; - { - my ( $error, $results ) = SimpleSearch( $query, $offset ); - ok( ! defined $error, 'no error found during search' ); - my $expected_hits = 6 + $self->{'orig_finn_test_hits'}; - is( scalar @$results, $expected_hits, "found $expected_hits results." ) - or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); - } - - my $max_results = 2; - { - my ( $error, $results ) = SimpleSearch( $query, $offset, $max_results ); - ok( ! defined $error, 'no error found during search' ); - is( scalar @$results, $max_results, "found $max_results results." ) - or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); - } - - { - my ( $error, $results ) = SimpleSearch( $query, 0, $max_results ); - ok( ! defined $error, 'no error found during search' ); - is( scalar @$results, $max_results, "found $max_results results." ) - or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) ); - } - - -} - - -1; diff --git a/t/lib/KohaTest/Serials.pm b/t/lib/KohaTest/Serials.pm deleted file mode 100644 index e7bb2497cb..0000000000 --- a/t/lib/KohaTest/Serials.pm +++ /dev/null @@ -1,65 +0,0 @@ -package KohaTest::Serials; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Serials; -sub testing_class { 'C4::Serials' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( GetSuppliersWithLateIssues - GetLateIssues - GetSubscriptionHistoryFromSubscriptionId - GetSerialStatusFromSerialId - GetSerialInformation - AddItem2Serial - UpdateClaimdateIssues - GetSubscription - GetFullSubscription - PrepareSerialsData - GetSubscriptionsFromBiblionumber - GetFullSubscriptionsFromBiblionumber - GetSubscriptions - GetSerials - GetSerials2 - GetLatestSerials - GetNextSeq - GetSeq - GetExpirationDate - CountSubscriptionFromBiblionumber - ModSubscriptionHistory - ModSerialStatus - ModSubscription - NewSubscription - ReNewSubscription - NewIssue - ItemizeSerials - HasSubscriptionExpired - DelSubscription - DelIssue - GetLateOrMissingIssues - removeMissingIssue - updateClaim - getsupplierbyserialid - check_routing - addroutingmember - reorder_members - delroutingmember - getroutinglist - countissuesfrom - abouttoexpire - in_array - GetNextDate - itemdata - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Suggestions.pm b/t/lib/KohaTest/Suggestions.pm deleted file mode 100644 index 0c74717a0f..0000000000 --- a/t/lib/KohaTest/Suggestions.pm +++ /dev/null @@ -1,30 +0,0 @@ -package KohaTest::Suggestions; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Suggestions; -sub testing_class { 'C4::Suggestions' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( SearchSuggestion - GetSuggestion - GetSuggestionFromBiblionumber - GetSuggestionByStatus - CountSuggestion - NewSuggestion - ModStatus - ConnectSuggestionAndBiblio - DelSuggestion - ); - - can_ok( $self->testing_class, @methods ); -} - -1; - diff --git a/t/lib/KohaTest/Z3950.pm b/t/lib/KohaTest/Z3950.pm deleted file mode 100644 index 3d94cff151..0000000000 --- a/t/lib/KohaTest/Z3950.pm +++ /dev/null @@ -1,25 +0,0 @@ -package KohaTest::Z3950; -use base qw( KohaTest ); - -use strict; -use warnings; - -use Test::More; - -use C4::Z3950; -sub testing_class { 'C4::Z3950' }; - - -sub methods : Test( 1 ) { - my $self = shift; - my @methods = qw( getz3950servers - z3950servername - addz3950queue - checkz3950searchdone - ); - - can_ok( $self->testing_class, @methods ); -} - -1; -