7 use File::Temp 0.19 ();
13 ### after: push @INC, qw(@RT_LIB_PATH@);
14 push @INC, qw(/opt/rt3/local/lib /opt/rt3/lib);
18 # where to keep temporary generated test data
23 RT::Shredder test suite utilities
27 Since RT:Shredder 0.01_03 we have a test suite. You
28 can run tests and see if everything works as expected
29 before you try shredder on your actual data.
30 Tests also help in the development process.
32 The test suite uses SQLite databases to store data in individual files,
33 so you could sun tests on your production servers without risking
34 damage to your production data.
36 You'll want to run the test suite almost every time you install or update
37 the shredder distribution, especialy if you have local customizations of
38 the DB schema and/or RT code.
40 Tests are one thing you can write even if you don't know much perl,
41 but want to learn more about RT's internals. New tests are very welcome.
45 The shredder distribution has several files to help write new tests.
47 t/shredder/utils.pl - this file, utilities
48 t/00skeleton.t - skeleteton .t file for new tests
50 All tests follow this algorithm:
52 require "t/shredder/utils.pl"; # plug in utilities
53 init_db(); # create new tmp RT DB and init RT API
54 # create RT data you want to be always in the RT DB
56 create_savepoint('mysp'); # create DB savepoint
57 # create data you want delete with shredder
59 # run shredder on the objects you've created
61 # check that shredder deletes things you want
62 # this command will compare savepoint DB with current
63 cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
64 # then you can create another object and delete it, then check again
66 Savepoints are named and you can create two or more savepoints.
72 =head3 rewrite_rtconfig
74 Call this sub after C<RT::LoadConfig>. It changes the RT config
75 options necessary to switch to a local SQLite database.
82 config_set( '$DatabaseType' , 'SQLite' );
83 config_set( '$DatabaseHost' , 'localhost' );
84 config_set( '$DatabaseRTHost' , 'localhost' );
85 config_set( '$DatabasePort' , '' );
86 config_set( '$DatabaseUser' , 'rt_user' );
87 config_set( '$DatabasePassword' , 'rt_pass' );
88 config_set( '$DatabaseRequireSSL' , undef );
90 config_set( '$DatabaseName' , db_name() );
93 config_set( '$LogToSyslog' , undef );
94 config_set( '$LogToScreen' , 'error' );
95 config_set( '$LogStackTraces' , 'crit' );
96 # logging to standalone file
97 config_set( '$LogToFile' , 'debug' );
98 my $fname = File::Spec->catfile(create_tmpdir(), test_name() .".log");
99 config_set( '$LogToFileNamed' , $fname );
104 This sub is a helper used by C<rewrite_rtconfig>. You shouldn't
105 need to use it elsewhere unless you need to change other RT
106 configuration variables.
112 $opt =~ s/^[\$\%\@]//;
113 RT->Config->Set($opt, @_)
120 Creates a new RT DB with initial data in a new test tmp dir.
121 Also runs RT::Init() and RT::InitLogging().
123 This is all you need to call to setup a testing environment
138 $SIG{__WARN__} = sub { $RT::Logger->warning( @_ ); warn @_ };
139 $SIG{__DIE__} = sub { $RT::Logger->crit( @_ ) unless $^S; die @_ };
147 foreach ( qw(Type Host Port Name User Password) ) {
148 $ENV{ "RT_DB_". uc $_ } = RT->Config->Get("Database$_");
150 my $rt_setup_database = RT::Test::get_relocatable_file(
151 'rt-setup-database', (File::Spec->updir(), File::Spec->updir(), 'sbin'));
152 my $cmd = "$^X $rt_setup_database --action init 2>&1";
154 my ($child_out, $child_in);
155 my $pid = open2($child_out, $child_in, $cmd);
157 my $result = do { local $/; <$child_out> };
163 Returns the absolute file path to the current DB.
164 It is <$tmpdir . test_name() .'.db'>.
166 See also the C<test_name> function.
170 sub db_name { return File::Spec->catfile(create_tmpdir(), test_name() .".db") }
172 =head3 connect_sqlite
174 Returns connected DBI DB handle.
176 Takes path to sqlite db.
182 return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
189 Creates and returns a new RT::Shredder object.
195 my $obj = new RT::Shredder;
197 my $file = File::Spec->catfile( create_tmpdir(), test_name() .'.XXXX.sql' );
198 $obj->AddDumpPlugin( Arguments => {
211 Returns name of the test file running now with file extension and
212 directory names stripped.
214 For example, it returns '00load' for the test file 't/00load.t'.
221 $name =~ s/^.*[\\\/]//;
226 =head2 TEMPORARY DIRECTORY
230 Returns the absolute path to a tmp dir used in tests.
238 $tmpdir = File::Temp->newdir(TEMPLATE => 'shredderXXXXX', CLEANUP => 0);
245 Creates a tmp dir if one doesn't exist already. Returns tmpdir path.
249 sub create_tmpdir { my $n = tmpdir(); File::Path::mkpath( [$n] ); return $n }
253 Deletes all the tmp dir used in the tests.
254 See also the C<test_name> function.
260 my $dir = File::Spec->catdir(tmpdir(), test_name());
261 return File::Path::rmtree( File::Spec->catdir( tmpdir(), test_name() ));
266 =head3 savepoint_name
268 Returns the absolute path to the named savepoint DB file.
269 Takes one argument - savepoint name, by default C<sp>.
275 my $name = shift || 'sp';
276 return File::Spec->catfile( create_tmpdir(), test_name() .".$name.db" );
279 =head3 create_savepoint
281 Creates savepoint DB from the current DB.
282 Takes name of the savepoint as argument.
284 =head3 restore_savepoint
286 Restores current DB to savepoint state.
287 Takes name of the savepoint as argument.
291 sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
292 sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
295 my( $orig, $dest ) = @_;
296 $RT::Handle->dbh->disconnect;
297 # DIRTY HACK: undef Handles to force reconnect
299 %DBIx::SearchBuilder::DBIHandle = ();
300 $DBIx::SearchBuilder::PrevHandle = undef;
302 File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
303 RT::ConnectToDatabase();
312 Returns DB dump as a complex hash structure:
321 Takes named argument C<CleanDates>. If true, clean all date fields from
322 dump. True by default.
329 my %args = ( CleanDates => 1, @_ );
331 my $old_fhkn = $dbh->{'FetchHashKeyName'};
332 $dbh->{'FetchHashKeyName'} = 'NAME_lc';
334 my $sth = $dbh->table_info( '', '', '%', 'TABLE' ) || die $DBI::err;
335 my @tables = keys %{$sth->fetchall_hashref( 'table_name' )};
338 foreach my $t( @tables ) {
339 next if lc($t) eq 'sessions';
340 $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t", 'id');
341 clean_dates( $res->{$t} ) if $args{'CleanDates'};
342 die $DBI::err if $DBI::err;
345 $dbh->{'FetchHashKeyName'} = $old_fhkn;
349 =head3 dump_current_and_savepoint
351 Returns dump of the current DB and of the named savepoint.
352 Takes one argument - savepoint name.
356 sub dump_current_and_savepoint
358 my $orig = savepoint_name( shift );
359 die "Couldn't find savepoint file" unless -f $orig && -r _;
360 my $odbh = connect_sqlite( $orig );
361 return ( dump_sqlite( $RT::Handle->dbh, @_ ), dump_sqlite( $odbh, @_ ) );
364 =head3 dump_savepoint_and_current
366 Returns the same data as C<dump_current_and_savepoint> function,
367 but in reversed order.
371 sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
376 my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
377 foreach my $id ( keys %{ $h } ) {
378 next unless $h->{ $id };
379 foreach ( keys %{ $h->{ $id } } ) {
380 delete $h->{$id}{$_} if $h->{$id}{$_} &&
381 $h->{$id}{$_} =~ /$date_re/;
388 Function that returns debug notes.
392 Returns a note about debug info that you can display if tests fail.
398 my $name = test_name();
399 my $tmpdir = tmpdir();
401 Some tests in '$0' file failed.
402 You can find debug info in '$tmpdir' dir.
404 $name.log - RT debug log file
405 $name.db - latest RT DB used while testing
406 $name.*.db - savepoint databases
407 See also perldoc t/shredder/utils.pl for how to use this info.
413 =head3 all_were_successful
415 Returns true if all tests that have already run were successful.
419 sub all_were_successful
422 my $Test = Test::Builder->new;
423 return grep( !$_, $Test->summary )? 0: 1;
427 return unless -e tmpdir();
428 if ( all_were_successful() ) {
431 diag( note_on_fail() );