+++ /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 qw( AddBookseller );
-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
-# 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
- matchchecks
- notifys
- 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.
-
-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;
-}
-
-=cut
-
-=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, undef ) = SimpleSearch( $query );
- if ( !defined $error && $param{'count'} <= @{$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.
-
-=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");
-
- 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 my $out, '>:encoding(UTF-8)', "$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');
- 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-index-daemon-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-index-daemon-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
- 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::Budgets;
-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
- GetOrder
- NewOrder
- ModOrder
- 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 $rand = int(rand(10000));
- my $basketno = NewBasket( $self->{'booksellerid'}, $param{'authorizedby'}, "Basket $rand");
-# $basketnote, $basketbooksellernote, $basketcontractnumber );
-# The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
- my $budget_id = AddBudget( { budget_name => "Budget $rand" } );
- my ( undef, $ordernumber ) = NewOrder( {
- basketno => $basketno,
- budget_id => $budget_id,
- biblionumber => $self->{'biblios'}[0],
- quantity => 1,
- bookfundid => $self->{'bookfundid'},
- rrp => 1,
- ecost => 1,
- booksellerinvoicenumber => $param{'invoice'},
- } );
- 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 = 'IndependentBranches') );
- 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 = 'IndependentBranches') );
- 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
-
-my $INVOICE = "1234-56 AB";
-sub one_order : Test( 55 ) {
- my $self = shift;
-
- my ( $basketno, $ordernumber ) = $self->create_new_basket(invoice => $INVOICE);
- ok( $basketno, "basketno is $basketno" );
- ok( $ordernumber, "ordernumber is $ordernumber" );
-
- # No arguments fetches no history.
- {
- my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = eval { GetHistory() };
- # diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
-
- is( $order_loop, undef, 'order_loop is empty' );
- }
-
- 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( title => $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 isbn
- {
- my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( isbn => $bibliodata->{'isbn'} );
- # 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 isbn' );
- is( $total_qty, 1, 'total_qty searched by isbn' );
- is( $total_price, 1, 'total_price searched by isbn' );
- is( $total_qtyreceived, 0, 'total_qtyreceived searched by isbn' );
-
- # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
- }
-
- # searching by ean
- {
- my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( ean => $bibliodata->{'ean'} );
- # 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 ean' );
- is( $total_qty, 1, 'total_qty searched by ean' );
- is( $total_price, 1, 'total_price searched by ean' );
- is( $total_qtyreceived, 0, 'total_qtyreceived searched by ean' );
-
- # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
- }
-
-
- # searching by basket number
- {
- my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( basket => $basketno );
- # 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 basket no' );
- is( $total_qty, 1, 'total_qty searched by basket no' );
- is( $total_price, 1, 'total_price searched by basket no' );
- is( $total_qtyreceived, 0, 'total_qtyreceived searched by basket no' );
-
- # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
- }
-
- # searching by invoice number
- {
- my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( booksellerinvoicenumber => $INVOICE );
- # 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 invoice no' );
- is( $total_qty, 1, 'total_qty searched by invoice no' );
- is( $total_price, 1, 'total_price searched by invoice no' );
- is( $total_qtyreceived, 0, 'total_qtyreceived searched by invoice no' );
-
- # diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
- }
-
- # searching by author
- {
- my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( author => $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( name => $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( to_placed_on => $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( from_placed_on => $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 IndependentBranches
- $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( title => $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 IndependentBranches
- $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,
- undef, # $ecost,
- $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,
- undef, # $ecost,
- $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
- 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
- TransformHtmlToXml
- TransformHtmlToMarc
- TransformMarcToKoha
- _get_inverted_marc_field_map
- _disambiguate
- get_koha_field_from_marc
- TransformMarcToKohaOneField
- ModZebra
- _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
- get_biblio_authorised_values
- );
-
- can_ok( $self->testing_class, @methods );
-}
-
-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
- 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
- ReturnLostItem
- ProcessOfflinePayment
- );
-
- 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 );
- return $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);
- 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_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
- PrepareItemrecordDisplay
- );
-
- 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( addalert
- delalert
- getalert
- findrelatedto
- SendAlerts
- GetPreparedLetter
- );
-
- 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( Search
- GetMemberDetails
- patronflags
- GetMember
- GetMemberIssuesAndFines
- ModMember
- AddMember
- Check_Userid
- changepassword
- fixup_cardnumber
- GetGuarantees
- UpdateGuarantees
- GetPendingIssues
- GetAllIssues
- GetMemberAccountRecords
- GetMemberAccountBalance
- GetBorNotifyAcctRecord
- checkuniquemember
- checkcardnumber
- getzipnamecity
- getidcity
- GetExpiryDate
- checkuserpassword
- GetborCatFromCatType
- GetBorrowercategory
- ethnicitycategories
- fixEthnicity
- GetAge
- get_institutions
- add_member_orgs
- MoveMemberToDeleted
- DelMember
- ExtendMemberSubscriptionTo
- GetTitles
- GetPatronImage
- PutPatronImage
- RmPatronImage
- GetBorrowersToExpunge
- GetBorrowersWhoHaveNeverBorrowed
- GetBorrowersWithIssuesHistoryOlderThan
- GetBorrowersNamesAndLatestIssue
- IssueSlip
- );
-
- 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'}, '2099-12-31' );
-
- 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
- GetFine
- NumberNotifyId
- AmountNotify
- GetItems
- CheckBorrowerDebarred
- 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( NetworkPrint );
-
- 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
- MoveReserve
- GetReserveInfo
- _FixPriority
- _Findgroupreserve
- ReserveSlip
- );
-
- 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
- );
-
- can_ok( $self->testing_class, @methods );
-}
-
-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;
-
projects / koha_ffzg / commitdiff