11 ### after: push @INC, qw(@RT_LIB_PATH@);
17 RT::Shredder test suite utilities
21 Since RT:Shredder 0.01_03 we have a test suite. You
22 can run tests and see if everything works as expected
23 before you try shredder on your actual data.
24 Tests also help in the development process.
26 The test suite uses SQLite databases to store data in individual files,
27 so you could sun tests on your production servers without risking
28 damage to your production data.
30 You'll want to run the test suite almost every time you install or update
31 the shredder distribution, especialy if you have local customizations of
32 the DB schema and/or RT code.
34 Tests are one thing you can write even if you don't know much perl,
35 but want to learn more about RT's internals. New tests are very welcome.
39 The shredder distribution has several files to help write new tests.
41 t/shredder/utils.pl - this file, utilities
42 t/00skeleton.t - skeleteton .t file for new tests
44 All tests follow this algorithm:
46 require "t/shredder/utils.pl"; # plug in utilities
47 init_db(); # create new tmp RT DB and init RT API
48 # create RT data you want to be always in the RT DB
50 create_savepoint('mysp'); # create DB savepoint
51 # create data you want delete with shredder
53 # run shredder on the objects you've created
55 # check that shredder deletes things you want
56 # this command will compare savepoint DB with current
57 cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
58 # then you can create another object and delete it, then check again
60 Savepoints are named and you can create two or more savepoints.
66 =head3 rewrite_rtconfig
68 Call this sub after C<RT::LoadConfig>. It changes the RT config
69 options necessary to switch to a local SQLite database.
76 config_set( '$DatabaseType' , 'SQLite' );
77 config_set( '$DatabaseHost' , 'localhost' );
78 config_set( '$DatabaseRTHost' , 'localhost' );
79 config_set( '$DatabasePort' , '' );
80 config_set( '$DatabaseUser' , 'rt_user' );
81 config_set( '$DatabasePassword' , 'rt_pass' );
82 config_set( '$DatabaseRequireSSL' , undef );
84 config_set( '$DatabaseName' , db_name() );
87 config_set( '$LogToSyslog' , undef );
88 config_set( '$LogToScreen' , 'error' );
89 config_set( '$LogStackTraces' , 'crit' );
90 # logging to standalone file
91 config_set( '$LogToFile' , 'debug' );
92 my $fname = File::Spec->catfile(RT::Test->temp_directory(), test_name() .".log");
93 config_set( '$LogToFileNamed' , $fname );
94 config_set('@LexiconLanguages', qw(en));
99 This sub is a helper used by C<rewrite_rtconfig>. You shouldn't
100 need to use it elsewhere unless you need to change other RT
101 configuration variables.
107 $opt =~ s/^[\$\%\@]//;
108 RT->Config->Set($opt, @_)
115 Creates a new RT DB with initial data in a new test tmp dir.
116 Also runs RT::Init() and RT::InitLogging().
118 This is all you need to call to setup a testing environment
125 RT::Test->bootstrap_tempdir() unless RT::Test->temp_directory();
133 $SIG{__WARN__} = sub { $RT::Logger->warning( @_ ); warn @_ };
134 $SIG{__DIE__} = sub { $RT::Logger->crit( @_ ) unless $^S; die @_ };
142 foreach ( qw(Type Host Port Name User Password) ) {
143 $ENV{ "RT_DB_". uc $_ } = RT->Config->Get("Database$_");
145 my $rt_setup_database = RT::Test::get_relocatable_file(
146 'rt-setup-database', (File::Spec->updir(), File::Spec->updir(), 'sbin'));
147 my $cmd = "$^X $rt_setup_database --action init 2>&1";
149 my ($child_out, $child_in);
150 my $pid = open2($child_out, $child_in, $cmd);
152 my $result = do { local $/; <$child_out> };
158 Returns the absolute file path to the current DB.
159 It is <<RT::Test->temp_directory . test_name() .'.db'>>.
161 See also the C<test_name> function.
165 sub db_name { return File::Spec->catfile(RT::Test->temp_directory(), test_name() .".db") }
167 =head3 connect_sqlite
169 Returns connected DBI DB handle.
171 Takes path to sqlite db.
177 return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
184 Creates and returns a new RT::Shredder object.
190 my $obj = RT::Shredder->new;
192 my $file = File::Spec->catfile( RT::Test->temp_directory, test_name() .'.XXXX.sql' );
193 $obj->AddDumpPlugin( Arguments => {
206 Returns name of the test file running now with file extension and
207 directory names stripped.
209 For example, it returns '00load' for the test file 't/00load.t'.
216 $name =~ s/^.*[\\\/]//;
223 =head3 savepoint_name
225 Returns the absolute path to the named savepoint DB file.
226 Takes one argument - savepoint name, by default C<sp>.
232 my $name = shift || 'sp';
233 return File::Spec->catfile( RT::Test->temp_directory, test_name() .".$name.db" );
236 =head3 create_savepoint
238 Creates savepoint DB from the current DB.
239 Takes name of the savepoint as argument.
241 =head3 restore_savepoint
243 Restores current DB to savepoint state.
244 Takes name of the savepoint as argument.
248 sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
249 sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
252 my( $orig, $dest ) = @_;
253 RT::Test::__disconnect_rt();
254 File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
255 RT::Test::__reconnect_rt();
264 Returns DB dump as a complex hash structure:
273 Takes named argument C<CleanDates>. If true, clean all date fields from
274 dump. True by default.
281 my %args = ( CleanDates => 1, @_ );
283 my $old_fhkn = $dbh->{'FetchHashKeyName'};
284 $dbh->{'FetchHashKeyName'} = 'NAME_lc';
286 my $sth = $dbh->table_info( '', '%', '%', 'TABLE' ) || die $DBI::err;
287 my @tables = keys %{$sth->fetchall_hashref( 'table_name' )};
290 foreach my $t( @tables ) {
291 next if lc($t) eq 'sessions';
292 $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t".dump_sqlite_exceptions($t), 'id');
293 clean_dates( $res->{$t} ) if $args{'CleanDates'};
294 die $DBI::err if $DBI::err;
297 $dbh->{'FetchHashKeyName'} = $old_fhkn;
301 =head3 dump_sqlite_exceptions
303 If there are parts of the DB which can change from creating and deleting
304 a queue, skip them when doing the comparison. One example is the global
305 queue cache attribute on RT::System which will be updated on Queue creation
306 and can't be rolled back by the shredder. It may actually make sense for
307 Shredder to be updating this at some point in the future.
311 sub dump_sqlite_exceptions {
314 my $special_wheres = {
315 attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
318 return $special_wheres->{lc $table}||'';
322 =head3 dump_current_and_savepoint
324 Returns dump of the current DB and of the named savepoint.
325 Takes one argument - savepoint name.
329 sub dump_current_and_savepoint
331 my $orig = savepoint_name( shift );
332 die "Couldn't find savepoint file" unless -f $orig && -r _;
333 my $odbh = connect_sqlite( $orig );
334 return ( dump_sqlite( $RT::Handle->dbh, @_ ), dump_sqlite( $odbh, @_ ) );
337 =head3 dump_savepoint_and_current
339 Returns the same data as C<dump_current_and_savepoint> function,
340 but in reversed order.
344 sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
349 my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
350 foreach my $id ( keys %{ $h } ) {
351 next unless $h->{ $id };
352 foreach ( keys %{ $h->{ $id } } ) {
353 delete $h->{$id}{$_} if $h->{$id}{$_} &&
354 $h->{$id}{$_} =~ /$date_re/;
361 Function that returns debug notes.
365 Returns a note about debug info that you can display if tests fail.
371 my $name = test_name();
372 my $tmpdir = RT::Test->temp_directory();
374 Some tests in '$0' file failed.
375 You can find debug info in '$tmpdir' dir.
377 $name.log - RT debug log file
378 $name.db - latest RT DB used while testing
379 $name.*.db - savepoint databases
380 See also perldoc t/shredder/utils.pl for how to use this info.
385 if ( ! RT::Test->builder->is_passing ) {
386 diag( note_on_fail() );