10 ### after: push @INC, qw(@RT_LIB_PATH@);
22 RT::Shredder test suite utilities
26 Since RT:Shredder 0.01_03 we have a test suite. You
27 can run tests and see if everything works as expected
28 before you try shredder on your actual data.
29 Tests also help in the development process.
31 The test suite uses SQLite databases to store data in individual files,
32 so you could sun tests on your production servers without risking
33 damage to your production data.
35 You'll want to run the test suite almost every time you install or update
36 the shredder distribution, especialy if you have local customizations of
37 the DB schema and/or RT code.
39 Tests are one thing you can write even if you don't know much perl,
40 but want to learn more about RT's internals. New tests are very welcome.
44 The shredder distribution has several files to help write new tests.
46 t/shredder/utils.pl - this file, utilities
47 t/00skeleton.t - skeleteton .t file for new tests
49 All tests follow this algorithm:
51 require "t/shredder/utils.pl"; # plug in utilities
52 init_db(); # create new tmp RT DB and init RT API
53 # create RT data you want to be always in the RT DB
55 create_savepoint('mysp'); # create DB savepoint
56 # create data you want delete with shredder
58 # run shredder on the objects you've created
60 # check that shredder deletes things you want
61 # this command will compare savepoint DB with current
62 cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
63 # then you can create another object and delete it, then check again
65 Savepoints are named and you can create two or more savepoints.
71 =head3 rewrite_rtconfig
73 Call this sub after C<RT::LoadConfig>. It changes the RT config
74 options necessary to switch to a local SQLite database.
81 config_set( '$DatabaseType' , 'SQLite' );
82 config_set( '$DatabaseHost' , 'localhost' );
83 config_set( '$DatabaseRTHost' , 'localhost' );
84 config_set( '$DatabasePort' , '' );
85 config_set( '$DatabaseUser' , 'rt_user' );
86 config_set( '$DatabasePassword' , 'rt_pass' );
87 config_set( '$DatabaseRequireSSL' , undef );
89 config_set( '$DatabaseName' , db_name() );
92 config_set( '$LogToSyslog' , undef );
93 config_set( '$LogToScreen' , 'error' );
94 config_set( '$LogStackTraces' , 'crit' );
95 # logging to standalone file
96 config_set( '$LogToFile' , 'debug' );
97 my $fname = File::Spec->catfile(RT::Test->temp_directory(), test_name() .".log");
98 config_set( '$LogToFileNamed' , $fname );
99 config_set('@LexiconLanguages', qw(en));
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
130 RT::Test->bootstrap_tempdir() unless RT::Test->temp_directory();
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 <<RT::Test->temp_directory . test_name() .'.db'>>.
166 See also the C<test_name> function.
170 sub db_name { return File::Spec->catfile(RT::Test->temp_directory(), 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 = RT::Shredder->new;
197 my $file = File::Spec->catfile( RT::Test->temp_directory, 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/^.*[\\\/]//;
228 =head3 savepoint_name
230 Returns the absolute path to the named savepoint DB file.
231 Takes one argument - savepoint name, by default C<sp>.
237 my $name = shift || 'sp';
238 return File::Spec->catfile( RT::Test->temp_directory, test_name() .".$name.db" );
241 =head3 create_savepoint
243 Creates savepoint DB from the current DB.
244 Takes name of the savepoint as argument.
246 =head3 restore_savepoint
248 Restores current DB to savepoint state.
249 Takes name of the savepoint as argument.
253 sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
254 sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
257 my( $orig, $dest ) = @_;
258 RT::Test::__disconnect_rt();
259 File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
260 RT::Test::__reconnect_rt();
269 Returns DB dump as a complex hash structure:
278 Takes named argument C<CleanDates>. If true, clean all date fields from
279 dump. True by default.
286 my %args = ( CleanDates => 1, @_ );
288 my $old_fhkn = $dbh->{'FetchHashKeyName'};
289 $dbh->{'FetchHashKeyName'} = 'NAME_lc';
291 my @tables = $RT::Handle->_TableNames( $dbh );
294 foreach my $t( @tables ) {
295 next if lc($t) eq 'sessions';
296 $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t".dump_sqlite_exceptions($t), 'id');
297 clean_dates( $res->{$t} ) if $args{'CleanDates'};
298 die $DBI::err if $DBI::err;
301 $dbh->{'FetchHashKeyName'} = $old_fhkn;
305 =head3 dump_sqlite_exceptions
307 If there are parts of the DB which can change from creating and deleting
308 a queue, skip them when doing the comparison. One example is the global
309 queue cache attribute on RT::System which will be updated on Queue creation
310 and can't be rolled back by the shredder. It may actually make sense for
311 Shredder to be updating this at some point in the future.
315 sub dump_sqlite_exceptions {
318 my $special_wheres = {
319 attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
322 return $special_wheres->{lc $table}||'';
326 =head3 dump_current_and_savepoint
328 Returns dump of the current DB and of the named savepoint.
329 Takes one argument - savepoint name.
333 sub dump_current_and_savepoint
335 my $orig = savepoint_name( shift );
336 die "Couldn't find savepoint file" unless -f $orig && -r _;
337 my $odbh = connect_sqlite( $orig );
338 return ( dump_sqlite( $RT::Handle->dbh, @_ ), dump_sqlite( $odbh, @_ ) );
341 =head3 dump_savepoint_and_current
343 Returns the same data as C<dump_current_and_savepoint> function,
344 but in reversed order.
348 sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
353 my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
354 foreach my $id ( keys %{ $h } ) {
355 next unless $h->{ $id };
356 foreach ( keys %{ $h->{ $id } } ) {
357 delete $h->{$id}{$_} if $h->{$id}{$_} &&
358 $h->{$id}{$_} =~ /$date_re/;
365 Function that returns debug notes.
369 Returns a note about debug info that you can display if tests fail.
375 my $name = test_name();
376 my $tmpdir = RT::Test->temp_directory();
378 Some tests in '$0' file failed.
379 You can find debug info in '$tmpdir' dir.
381 $name.log - RT debug log file
382 $name.db - latest RT DB used while testing
383 $name.*.db - savepoint databases
384 See also perldoc t/shredder/utils.pl for how to use this info.
389 if ( ! RT::Test->builder->is_passing ) {
390 diag( note_on_fail() );