10 ### after: push @INC, qw(@RT_LIB_PATH@);
16 RT::Shredder test suite utilities
20 Since RT:Shredder 0.01_03 we have a test suite. You
21 can run tests and see if everything works as expected
22 before you try shredder on your actual data.
23 Tests also help in the development process.
25 The test suite uses SQLite databases to store data in individual files,
26 so you could sun tests on your production servers without risking
27 damage to your production data.
29 You'll want to run the test suite almost every time you install or update
30 the shredder distribution, especialy if you have local customizations of
31 the DB schema and/or RT code.
33 Tests are one thing you can write even if you don't know much perl,
34 but want to learn more about RT's internals. New tests are very welcome.
38 The shredder distribution has several files to help write new tests.
40 t/shredder/utils.pl - this file, utilities
41 t/00skeleton.t - skeleteton .t file for new tests
43 All tests follow this algorithm:
45 require "t/shredder/utils.pl"; # plug in utilities
46 init_db(); # create new tmp RT DB and init RT API
47 # create RT data you want to be always in the RT DB
49 create_savepoint('mysp'); # create DB savepoint
50 # create data you want delete with shredder
52 # run shredder on the objects you've created
54 # check that shredder deletes things you want
55 # this command will compare savepoint DB with current
56 cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
57 # then you can create another object and delete it, then check again
59 Savepoints are named and you can create two or more savepoints.
65 =head3 rewrite_rtconfig
67 Call this sub after C<RT::LoadConfig>. It changes the RT config
68 options necessary to switch to a local SQLite database.
75 config_set( '$DatabaseType' , 'SQLite' );
76 config_set( '$DatabaseHost' , 'localhost' );
77 config_set( '$DatabaseRTHost' , 'localhost' );
78 config_set( '$DatabasePort' , '' );
79 config_set( '$DatabaseUser' , 'rt_user' );
80 config_set( '$DatabasePassword' , 'rt_pass' );
81 config_set( '$DatabaseRequireSSL' , undef );
83 config_set( '$DatabaseName' , db_name() );
86 config_set( '$LogToSyslog' , undef );
87 config_set( '$LogToScreen' , 'error' );
88 config_set( '$LogStackTraces' , 'crit' );
89 # logging to standalone file
90 config_set( '$LogToFile' , 'debug' );
91 my $fname = File::Spec->catfile(RT::Test->temp_directory(), test_name() .".log");
92 config_set( '$LogToFileNamed' , $fname );
93 config_set('@LexiconLanguages', qw(en));
98 This sub is a helper used by C<rewrite_rtconfig>. You shouldn't
99 need to use it elsewhere unless you need to change other RT
100 configuration variables.
106 $opt =~ s/^[\$\%\@]//;
107 RT->Config->Set($opt, @_)
114 Creates a new RT DB with initial data in a new test tmp dir.
115 Also runs RT::Init() and RT::InitLogging().
117 This is all you need to call to setup a testing environment
124 RT::Test->bootstrap_tempdir() unless RT::Test->temp_directory();
132 $SIG{__WARN__} = sub { $RT::Logger->warning( @_ ); warn @_ };
133 $SIG{__DIE__} = sub { $RT::Logger->crit( @_ ) unless $^S; die @_ };
141 foreach ( qw(Type Host Port Name User Password) ) {
142 $ENV{ "RT_DB_". uc $_ } = RT->Config->Get("Database$_");
144 my $rt_setup_database = RT::Test::get_relocatable_file(
145 'rt-setup-database', (File::Spec->updir(), File::Spec->updir(), 'sbin'));
146 my $cmd = "$^X $rt_setup_database --action init 2>&1";
148 my ($child_out, $child_in);
149 my $pid = open2($child_out, $child_in, $cmd);
151 my $result = do { local $/; <$child_out> };
157 Returns the absolute file path to the current DB.
158 It is <<RT::Test->temp_directory . test_name() .'.db'>>.
160 See also the C<test_name> function.
164 sub db_name { return File::Spec->catfile(RT::Test->temp_directory(), test_name() .".db") }
166 =head3 connect_sqlite
168 Returns connected DBI DB handle.
170 Takes path to sqlite db.
176 return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
183 Creates and returns a new RT::Shredder object.
189 my $obj = RT::Shredder->new;
191 my $file = File::Spec->catfile( RT::Test->temp_directory, test_name() .'.XXXX.sql' );
192 $obj->AddDumpPlugin( Arguments => {
205 Returns name of the test file running now with file extension and
206 directory names stripped.
208 For example, it returns '00load' for the test file 't/00load.t'.
215 $name =~ s/^.*[\\\/]//;
222 =head3 savepoint_name
224 Returns the absolute path to the named savepoint DB file.
225 Takes one argument - savepoint name, by default C<sp>.
231 my $name = shift || 'sp';
232 return File::Spec->catfile( RT::Test->temp_directory, test_name() .".$name.db" );
235 =head3 create_savepoint
237 Creates savepoint DB from the current DB.
238 Takes name of the savepoint as argument.
240 =head3 restore_savepoint
242 Restores current DB to savepoint state.
243 Takes name of the savepoint as argument.
247 sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
248 sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
251 my( $orig, $dest ) = @_;
252 RT::Test::__disconnect_rt();
253 File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
254 RT::Test::__reconnect_rt();
263 Returns DB dump as a complex hash structure:
272 Takes named argument C<CleanDates>. If true, clean all date fields from
273 dump. True by default.
280 my %args = ( CleanDates => 1, @_ );
282 my $old_fhkn = $dbh->{'FetchHashKeyName'};
283 $dbh->{'FetchHashKeyName'} = 'NAME_lc';
285 my $sth = $dbh->table_info( '', '%', '%', 'TABLE' ) || die $DBI::err;
286 my @tables = keys %{$sth->fetchall_hashref( 'table_name' )};
289 foreach my $t( @tables ) {
290 next if lc($t) eq 'sessions';
291 $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t".dump_sqlite_exceptions($t), 'id');
292 clean_dates( $res->{$t} ) if $args{'CleanDates'};
293 die $DBI::err if $DBI::err;
296 $dbh->{'FetchHashKeyName'} = $old_fhkn;
300 =head3 dump_sqlite_exceptions
302 If there are parts of the DB which can change from creating and deleting
303 a queue, skip them when doing the comparison. One example is the global
304 queue cache attribute on RT::System which will be updated on Queue creation
305 and can't be rolled back by the shredder. It may actually make sense for
306 Shredder to be updating this at some point in the future.
310 sub dump_sqlite_exceptions {
313 my $special_wheres = {
314 attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
317 return $special_wheres->{lc $table}||'';
321 =head3 dump_current_and_savepoint
323 Returns dump of the current DB and of the named savepoint.
324 Takes one argument - savepoint name.
328 sub dump_current_and_savepoint
330 my $orig = savepoint_name( shift );
331 die "Couldn't find savepoint file" unless -f $orig && -r _;
332 my $odbh = connect_sqlite( $orig );
333 return ( dump_sqlite( $RT::Handle->dbh, @_ ), dump_sqlite( $odbh, @_ ) );
336 =head3 dump_savepoint_and_current
338 Returns the same data as C<dump_current_and_savepoint> function,
339 but in reversed order.
343 sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
348 my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
349 foreach my $id ( keys %{ $h } ) {
350 next unless $h->{ $id };
351 foreach ( keys %{ $h->{ $id } } ) {
352 delete $h->{$id}{$_} if $h->{$id}{$_} &&
353 $h->{$id}{$_} =~ /$date_re/;
360 Function that returns debug notes.
364 Returns a note about debug info that you can display if tests fail.
370 my $name = test_name();
371 my $tmpdir = RT::Test->temp_directory();
373 Some tests in '$0' file failed.
374 You can find debug info in '$tmpdir' dir.
376 $name.log - RT debug log file
377 $name.db - latest RT DB used while testing
378 $name.*.db - savepoint databases
379 See also perldoc t/shredder/utils.pl for how to use this info.
384 if ( ! RT::Test->builder->is_passing ) {
385 diag( note_on_fail() );