use C4::Items;
use C4::Members;
use C4::Search;
+use C4::Installer;
+use C4::Languages;
use File::Temp qw/ tempdir /;
+use CGI;
# 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 single-test 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
return;
}
+=head2 startup_24_add_branch
+
+=cut
+
+sub startup_24_add_branch : Test(startup => 1) {
+ my $self = shift;
+
+ my $branch_info = {
+ add => 1,
+ branchcode => $self->random_string(3),
+ branchname => $self->random_string(),
+ branchaddress1 => $self->random_string(),
+ branchaddress2 => $self->random_string(),
+ branchaddress3 => $self->random_string(),
+ branchphone => $self->random_phone(),
+ branchfax => $self->random_phone(),
+ brancemail => $self->random_email(),
+ branchip => $self->random_ip(),
+ branchprinter => $self->random_string(),
+ };
+ C4::Branch::ModBranch($branch_info);
+ $self->{'branchcode'} = $branch_info->{'branchcode'};
+ ok( $self->{'branchcode'}, "created branch: $self->{'branchcode'}" );
+
+}
+
=head2 startup_24_add_member
Add a patron/member for the tests to use
categorycode => 'PT', # PT => PaTron
dateexpiry => '2010-01-01',
password => 'testpassword',
+ dateofbirth => $self->random_date(),
};
my $borrowernumber = AddMember( %$memberinfo );
sub random_string {
my $self = shift;
- my $wordsize = 6; # how many letters in your string?
+ 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 );
}
+=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 add_biblios
$self->add_biblios( count => 10,
}
push @{$self->{'biblios'}}, $biblionumber;
}
-
+
+ $self->reindex_marc();
my $query = 'Finn Test';
-
- # XXX we're going to repeatedly try to fetch the marc records that
- # we inserted above. It may take a while before they all show
- # up. why?
- my $tries = 30;
- DELAY: foreach my $trial ( 1..$tries ) {
- diag "waiting for zebra indexing. Trial: $trial of $tries";
- my ( $error, $results ) = SimpleSearch( $query );
- if ( $param{'count'} <= scalar( @$results ) ) {
- ok( $tries, "found all $param{'count'} titles after $trial tries" );
- last DELAY;
- }
- sleep( 3 );
- } continue {
- if ( $trial == $tries ) {
- fail( "we never found all $param{'count'} titles even after $tries tries." );
- }
+ my ( $error, $results ) = SimpleSearch( $query );
+ if ( $param{'count'} <= scalar( @$results ) ) {
+ pass( "found all $param{'count'} titles" );
+ } else {
+ fail( "we never found all $param{'count'} titles" );
}
-
}
}
+
+=head3 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");
+ $id="";
+ }
+ }
+}
+
+sub drop_table {
+ my ($dbh, $table) = @_;
+ $dbh->do("DROP TABLE $table");
+}
+
+=head3 create_test_database
+
+ sets up the test database.
+
+=cut
+
+sub create_test_database {
+
+ diag 'creating testing database...';
+ my $installer = C4::Installer->new() or die 'unable to create new installer';
+ # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] );
+ my $all_languages = getAllLanguages();
+ my $error = $installer->load_db_schema();
+ die "unable to load_db_schema: $error" if ( $error );
+ my $list = $installer->sql_file_list('en', 'marc21', { optional => 1,
+ mandatory => 1 } );
+ my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list);
+ $installer->set_version_syspref();
+ $installer->set_marcflavour_syspref('MARC21');
+ $installer->set_indexing_engine(0);
+ diag 'database created.'
+}
+
+
+=head3 start_zebrasrv
+
+ This method deletes and reinitializes the zebra database directory,
+ and then spans off a zebra server.
+
+=cut
+
+sub start_zebrasrv {
+
+ stop_zebrasrv();
+ diag 'cleaning zebrasrv...';
+
+ foreach my $zebra_server ( qw( biblioserver authorityserver ) ) {
+ my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'};
+ my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'};
+ foreach my $zebra_db_name ( qw( biblios authorities ) ) {
+ my $command = "zebraidx -c $zebra_config -d $zebra_db_name init";
+ my $return = system( $command . ' > /dev/null 2>&1' );
+ if ( $return != 0 ) {
+ diag( "command '$command' died with value: " . $? >> 8 );
+ }
+
+ $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name";
+ diag $command;
+ $return = system( $command . ' > /dev/null 2>&1' );
+ if ( $return != 0 ) {
+ diag( "command '$command' died with value: " . $? >> 8 );
+ }
+ }
+ }
+
+ diag 'starting zebrasrv...';
+
+ my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
+ my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s',
+ $ENV{'KOHA_CONF'},
+ File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ),
+ $pidfile,
+ );
+ diag $command;
+ my $output = qx( $command );
+ if ( $output ) {
+ diag $output;
+ }
+ if ( -e $pidfile, 'pidfile exists' ) {
+ diag 'zebrasrv started.';
+ } else {
+ die 'unable to start zebrasrv';
+ }
+ return $output;
+}
+
+=head3 stop_zebrasrv
+
+ using the PID file for the zebra server, send it a TERM signal with
+ "kill". We can't tell if the process actually dies or not.
+
+=cut
+
+sub stop_zebrasrv {
+
+ my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
+ if ( -e $pidfile ) {
+ open( my $pidh, '<', $pidfile )
+ or return;
+ if ( defined $pidh ) {
+ my ( $pid ) = <$pidh> or return;
+ close $pidh;
+ my $killed = kill 15, $pid; # 15 is TERM
+ if ( $killed != 1 ) {
+ warn "unable to kill zebrasrv with pid: $pid";
+ }
+ }
+ }
+}
+
+
+=head3 start_zebraqueue_daemon
+
+ kick off a zebraqueue_daemon.pl process.
+
+=cut
+
+sub start_zebraqueue_daemon {
+
+ my $command = q(run/bin/koha-zebraqueue-ctl.sh start);
+ diag $command;
+ my $started = system( $command );
+ diag "started: $started";
+
+}
+
+=head3 stop_zebraqueue_daemon
+
+
+=cut
+
+sub stop_zebraqueue_daemon {
+
+ my $command = q(run/bin/koha-zebraqueue-ctl.sh stop);
+ diag $command;
+ my $started = system( $command );
+ diag "started: $started";
+
+}
+
1;
projects / koha.git / blobdiff