+++ /dev/null
-#!/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();
-
--- /dev/null
+#!/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();
+
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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 = <<END_SQL;
+SELECT barcode
+ FROM items
+ WHERE itemnumber = ?
+END_SQL
+ my $dbh = C4::Context->dbh() or return;
+ my $sth = $dbh->prepare($sql) or return;
+ $sth->execute($itemnumber) or return;
+ my ($barcode) = $sth->fetchrow_array;
+ return $barcode;
+}
+
+1;
+
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
+
+
+
+
+
+
--- /dev/null
+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;
+
+
+
+
+
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
+
+
+
+
+
--- /dev/null
+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;
+
+
+
+
+
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
+++ /dev/null
-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 = <<END_SQL;
-SELECT barcode
- FROM items
- WHERE itemnumber = ?
-END_SQL
- my $dbh = C4::Context->dbh() or return;
- my $sth = $dbh->prepare($sql) or return;
- $sth->execute($itemnumber) or return;
- my ($barcode) = $sth->fetchrow_array;
- return $barcode;
-}
-
-1;
-
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
-
-
-
-
-
+++ /dev/null
-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;
-
-
-
-
-
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
-
-
-
-
-
+++ /dev/null
-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;
-
-
-
-
-
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
+++ /dev/null
-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;
-
projects / koha-ffzg.git / commitdiff