+++ /dev/null
-
-use strict;
-use warnings;
-
-require File::Copy;
-require Cwd;
-require RT::Test;
-
-BEGIN {
-### after: push @INC, qw(@RT_LIB_PATH@);
-
- use RT;
- RT->LoadConfig;
- RT->InitPluginPaths;
- RT->InitClasses;
-}
-
-require RT::Shredder;
-
-=head1 DESCRIPTION
-
-RT::Shredder test suite utilities
-
-=head1 TESTING
-
-Since RT:Shredder 0.01_03 we have a test suite. You
-can run tests and see if everything works as expected
-before you try shredder on your actual data.
-Tests also help in the development process.
-
-The test suite uses SQLite databases to store data in individual files,
-so you could sun tests on your production servers without risking
-damage to your production data.
-
-You'll want to run the test suite almost every time you install or update
-the shredder distribution, especialy if you have local customizations of
-the DB schema and/or RT code.
-
-Tests are one thing you can write even if you don't know much perl,
-but want to learn more about RT's internals. New tests are very welcome.
-
-=head2 WRITING TESTS
-
-The shredder distribution has several files to help write new tests.
-
- t/shredder/utils.pl - this file, utilities
- t/00skeleton.t - skeleteton .t file for new tests
-
-All tests follow this algorithm:
-
- require "t/shredder/utils.pl"; # plug in utilities
- init_db(); # create new tmp RT DB and init RT API
- # create RT data you want to be always in the RT DB
- # ...
- create_savepoint('mysp'); # create DB savepoint
- # create data you want delete with shredder
- # ...
- # run shredder on the objects you've created
- # ...
- # check that shredder deletes things you want
- # this command will compare savepoint DB with current
- cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
- # then you can create another object and delete it, then check again
-
-Savepoints are named and you can create two or more savepoints.
-
-=head1 FUNCTIONS
-
-=head2 RT CONFIG
-
-=head3 rewrite_rtconfig
-
-Call this sub after C<RT::LoadConfig>. It changes the RT config
-options necessary to switch to a local SQLite database.
-
-=cut
-
-sub rewrite_rtconfig
-{
- # database
- config_set( '$DatabaseType' , 'SQLite' );
- config_set( '$DatabaseHost' , 'localhost' );
- config_set( '$DatabaseRTHost' , 'localhost' );
- config_set( '$DatabasePort' , '' );
- config_set( '$DatabaseUser' , 'rt_user' );
- config_set( '$DatabasePassword' , 'rt_pass' );
- config_set( '$DatabaseRequireSSL' , undef );
- # database file name
- config_set( '$DatabaseName' , db_name() );
-
- # generic logging
- config_set( '$LogToSyslog' , undef );
- config_set( '$LogToScreen' , 'error' );
- config_set( '$LogStackTraces' , 'crit' );
- # logging to standalone file
- config_set( '$LogToFile' , 'debug' );
- my $fname = File::Spec->catfile(RT::Test->temp_directory(), test_name() .".log");
- config_set( '$LogToFileNamed' , $fname );
- config_set('@LexiconLanguages', qw(en));
-}
-
-=head3 config_set
-
-This sub is a helper used by C<rewrite_rtconfig>. You shouldn't
-need to use it elsewhere unless you need to change other RT
-configuration variables.
-
-=cut
-
-sub config_set {
- my $opt = shift;
- $opt =~ s/^[\$\%\@]//;
- RT->Config->Set($opt, @_)
-}
-
-=head2 DATABASES
-
-=head3 init_db
-
-Creates a new RT DB with initial data in a new test tmp dir.
-Also runs RT::Init() and RT::InitLogging().
-
-This is all you need to call to setup a testing environment
-in most situations.
-
-=cut
-
-sub init_db
-{
- RT::Test->bootstrap_tempdir() unless RT::Test->temp_directory();
- RT::LoadConfig();
- rewrite_rtconfig();
- RT::InitLogging();
-
- _init_db();
-
- RT::Init();
- $SIG{__WARN__} = sub { $RT::Logger->warning( @_ ); warn @_ };
- $SIG{__DIE__} = sub { $RT::Logger->crit( @_ ) unless $^S; die @_ };
-}
-
-use IPC::Open2;
-sub _init_db
-{
-
-
- foreach ( qw(Type Host Port Name User Password) ) {
- $ENV{ "RT_DB_". uc $_ } = RT->Config->Get("Database$_");
- }
- my $rt_setup_database = RT::Test::get_relocatable_file(
- 'rt-setup-database', (File::Spec->updir(), File::Spec->updir(), 'sbin'));
- my $cmd = "$^X $rt_setup_database --action init 2>&1";
-
- my ($child_out, $child_in);
- my $pid = open2($child_out, $child_in, $cmd);
- close $child_in;
- my $result = do { local $/; <$child_out> };
- return $result;
-}
-
-=head3 db_name
-
-Returns the absolute file path to the current DB.
-It is <<RT::Test->temp_directory . test_name() .'.db'>>.
-
-See also the C<test_name> function.
-
-=cut
-
-sub db_name { return File::Spec->catfile(RT::Test->temp_directory(), test_name() .".db") }
-
-=head3 connect_sqlite
-
-Returns connected DBI DB handle.
-
-Takes path to sqlite db.
-
-=cut
-
-sub connect_sqlite
-{
- return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
-}
-
-=head2 SHREDDER
-
-=head3 shredder_new
-
-Creates and returns a new RT::Shredder object.
-
-=cut
-
-sub shredder_new
-{
- my $obj = RT::Shredder->new;
-
- my $file = File::Spec->catfile( RT::Test->temp_directory, test_name() .'.XXXX.sql' );
- $obj->AddDumpPlugin( Arguments => {
- file_name => $file,
- from_storage => 0,
- } );
-
- return $obj;
-}
-
-
-=head2 TEST FILES
-
-=head3 test_name
-
-Returns name of the test file running now with file extension and
-directory names stripped.
-
-For example, it returns '00load' for the test file 't/00load.t'.
-
-=cut
-
-sub test_name
-{
- my $name = $0;
- $name =~ s/^.*[\\\/]//;
- $name =~ s/\..*$//;
- return $name;
-}
-
-=head2 SAVEPOINTS
-
-=head3 savepoint_name
-
-Returns the absolute path to the named savepoint DB file.
-Takes one argument - savepoint name, by default C<sp>.
-
-=cut
-
-sub savepoint_name
-{
- my $name = shift || 'sp';
- return File::Spec->catfile( RT::Test->temp_directory, test_name() .".$name.db" );
-}
-
-=head3 create_savepoint
-
-Creates savepoint DB from the current DB.
-Takes name of the savepoint as argument.
-
-=head3 restore_savepoint
-
-Restores current DB to savepoint state.
-Takes name of the savepoint as argument.
-
-=cut
-
-sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
-sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
-sub __cp_db
-{
- my( $orig, $dest ) = @_;
- RT::Test::__disconnect_rt();
- File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
- RT::Test::__reconnect_rt();
- return;
-}
-
-
-=head2 DUMPS
-
-=head3 dump_sqlite
-
-Returns DB dump as a complex hash structure:
- {
- TableName => {
- #id => {
- lc_field => 'value',
- }
- }
- }
-
-Takes named argument C<CleanDates>. If true, clean all date fields from
-dump. True by default.
-
-=cut
-
-sub dump_sqlite
-{
- my $dbh = shift;
- my %args = ( CleanDates => 1, @_ );
-
- my $old_fhkn = $dbh->{'FetchHashKeyName'};
- $dbh->{'FetchHashKeyName'} = 'NAME_lc';
-
- my @tables = $RT::Handle->_TableNames( $dbh );
-
- my $res = {};
- foreach my $t( @tables ) {
- next if lc($t) eq 'sessions';
- $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t".dump_sqlite_exceptions($t), 'id');
- clean_dates( $res->{$t} ) if $args{'CleanDates'};
- die $DBI::err if $DBI::err;
- }
-
- $dbh->{'FetchHashKeyName'} = $old_fhkn;
- return $res;
-}
-
-=head3 dump_sqlite_exceptions
-
-If there are parts of the DB which can change from creating and deleting
-a queue, skip them when doing the comparison. One example is the global
-queue cache attribute on RT::System which will be updated on Queue creation
-and can't be rolled back by the shredder. It may actually make sense for
-Shredder to be updating this at some point in the future.
-
-=cut
-
-sub dump_sqlite_exceptions {
- my $table = shift;
-
- my $special_wheres = {
- attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
- };
-
- return $special_wheres->{lc $table}||'';
-
-}
-
-=head3 dump_current_and_savepoint
-
-Returns dump of the current DB and of the named savepoint.
-Takes one argument - savepoint name.
-
-=cut
-
-sub dump_current_and_savepoint
-{
- my $orig = savepoint_name( shift );
- die "Couldn't find savepoint file" unless -f $orig && -r _;
- my $odbh = connect_sqlite( $orig );
- return ( dump_sqlite( $RT::Handle->dbh, @_ ), dump_sqlite( $odbh, @_ ) );
-}
-
-=head3 dump_savepoint_and_current
-
-Returns the same data as C<dump_current_and_savepoint> function,
-but in reversed order.
-
-=cut
-
-sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
-
-sub clean_dates
-{
- my $h = shift;
- my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
- foreach my $id ( keys %{ $h } ) {
- next unless $h->{ $id };
- foreach ( keys %{ $h->{ $id } } ) {
- delete $h->{$id}{$_} if $h->{$id}{$_} &&
- $h->{$id}{$_} =~ /$date_re/;
- }
- }
-}
-
-=head2 NOTES
-
-Function that returns debug notes.
-
-=head3 note_on_fail
-
-Returns a note about debug info that you can display if tests fail.
-
-=cut
-
-sub note_on_fail
-{
- my $name = test_name();
- my $tmpdir = RT::Test->temp_directory();
- return <<END;
-Some tests in '$0' file failed.
-You can find debug info in '$tmpdir' dir.
-There should be:
- $name.log - RT debug log file
- $name.db - latest RT DB used while testing
- $name.*.db - savepoint databases
-See also perldoc t/shredder/utils.pl for how to use this info.
-END
-}
-
-END {
- if ( ! RT::Test->builder->is_passing ) {
- diag( note_on_fail() );
- }
-}
-
-1;
projects / freeside.git / blobdiff