rt/t/shredder/utils.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require File::Copy;
   7 require Cwd;
   8 require RT::Test;
   9
  10 BEGIN {
  11 ### after:     push @INC, qw(@RT_LIB_PATH@);
  12 }
  13 use RT::Shredder;
  14
  15 =head1 DESCRIPTION
  16
  17 RT::Shredder test suite utilities
  18
  19 =head1 TESTING
  20
  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.
  25
  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.
  29
  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.
  33
  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.
  36
  37 =head2 WRITING TESTS
  38
  39 The shredder distribution has several files to help write new tests.
  40
  41   t/shredder/utils.pl - this file, utilities
  42   t/00skeleton.t - skeleteton .t file for new tests
  43
  44 All tests follow this algorithm:
  45
  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
  49   # ...
  50   create_savepoint('mysp'); # create DB savepoint
  51   # create data you want delete with shredder
  52   # ...
  53   # run shredder on the objects you've created
  54   # ...
  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
  59
  60 Savepoints are named and you can create two or more savepoints.
  61
  62 =head1 FUNCTIONS
  63
  64 =head2 RT CONFIG
  65
  66 =head3 rewrite_rtconfig
  67
  68 Call this sub after C<RT::LoadConfig>. It changes the RT config
  69 options necessary to switch to a local SQLite database.
  70
  71 =cut
  72
  73 sub rewrite_rtconfig
  74 {
  75     # 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 );
  83     # database file name
  84     config_set( '$DatabaseName'       , db_name() );
  85
  86     # generic logging
  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));
  95 }
  96
  97 =head3 config_set
  98
  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.
 102
 103 =cut
 104
 105 sub config_set {
 106     my $opt = shift;
 107     $opt =~ s/^[\$\%\@]//;
 108     RT->Config->Set($opt, @_)
 109 }
 110
 111 =head2 DATABASES
 112
 113 =head3 init_db
 114
 115 Creates a new RT DB with initial data in a new test tmp dir.
 116 Also runs RT::Init() and RT::InitLogging().
 117
 118 This is all you need to call to setup a testing environment
 119 in most situations.
 120
 121 =cut
 122
 123 sub init_db
 124 {
 125     RT::Test->bootstrap_tempdir() unless RT::Test->temp_directory();
 126     RT::LoadConfig();
 127     rewrite_rtconfig();
 128     RT::InitLogging();
 129
 130     _init_db();
 131
 132     RT::Init();
 133     $SIG{__WARN__} = sub { $RT::Logger->warning( @_ ); warn @_ };
 134     $SIG{__DIE__} = sub { $RT::Logger->crit( @_ ) unless $^S; die @_ };
 135 }
 136
 137 use IPC::Open2;
 138 sub _init_db
 139 {
 140
 141
 142     foreach ( qw(Type Host Port Name User Password) ) {
 143         $ENV{ "RT_DB_". uc $_ } = RT->Config->Get("Database$_");
 144     }
 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";
 148
 149     my ($child_out, $child_in);
 150     my $pid = open2($child_out, $child_in, $cmd);
 151     close $child_in;
 152     my $result = do { local $/; <$child_out> };
 153     return $result;
 154 }
 155
 156 =head3 db_name
 157
 158 Returns the absolute file path to the current DB.
 159 It is <<RT::Test->temp_directory . test_name() .'.db'>>.
 160
 161 See also the C<test_name> function.
 162
 163 =cut
 164
 165 sub db_name { return File::Spec->catfile(RT::Test->temp_directory(), test_name() .".db") }
 166
 167 =head3 connect_sqlite
 168
 169 Returns connected DBI DB handle.
 170
 171 Takes path to sqlite db.
 172
 173 =cut
 174
 175 sub connect_sqlite
 176 {
 177     return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
 178 }
 179
 180 =head2 SHREDDER
 181
 182 =head3 shredder_new
 183
 184 Creates and returns a new RT::Shredder object.
 185
 186 =cut
 187
 188 sub shredder_new
 189 {
 190     my $obj = RT::Shredder->new;
 191
 192     my $file = File::Spec->catfile( RT::Test->temp_directory, test_name() .'.XXXX.sql' );
 193     $obj->AddDumpPlugin( Arguments => {
 194         file_name    => $file,
 195         from_storage => 0,
 196     } );
 197
 198     return $obj;
 199 }
 200
 201
 202 =head2 TEST FILES
 203
 204 =head3 test_name
 205
 206 Returns name of the test file running now with file extension and
 207 directory names stripped.
 208
 209 For example, it returns '00load' for the test file 't/00load.t'.
 210
 211 =cut
 212
 213 sub test_name
 214 {
 215     my $name = $0;
 216     $name =~ s/^.*[\\\/]//;
 217     $name =~ s/\..*$//;
 218     return $name;
 219 }
 220
 221 =head2 SAVEPOINTS
 222
 223 =head3 savepoint_name
 224
 225 Returns the absolute path to the named savepoint DB file.
 226 Takes one argument - savepoint name, by default C<sp>.
 227
 228 =cut
 229
 230 sub savepoint_name
 231 {
 232     my $name = shift || 'sp';
 233     return File::Spec->catfile( RT::Test->temp_directory, test_name() .".$name.db" );
 234 }
 235
 236 =head3 create_savepoint
 237
 238 Creates savepoint DB from the current DB.
 239 Takes name of the savepoint as argument.
 240
 241 =head3 restore_savepoint
 242
 243 Restores current DB to savepoint state.
 244 Takes name of the savepoint as argument.
 245
 246 =cut
 247
 248 sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
 249 sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
 250 sub __cp_db
 251 {
 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();
 256     return;
 257 }
 258
 259
 260 =head2 DUMPS
 261
 262 =head3 dump_sqlite
 263
 264 Returns DB dump as a complex hash structure:
 265     {
 266     TableName => {
 267         #id => {
 268             lc_field => 'value',
 269         }
 270     }
 271     }
 272
 273 Takes named argument C<CleanDates>. If true, clean all date fields from
 274 dump. True by default.
 275
 276 =cut
 277
 278 sub dump_sqlite
 279 {
 280     my $dbh = shift;
 281     my %args = ( CleanDates => 1, @_ );
 282
 283     my $old_fhkn = $dbh->{'FetchHashKeyName'};
 284     $dbh->{'FetchHashKeyName'} = 'NAME_lc';
 285
 286     my $sth = $dbh->table_info( '', '%', '%', 'TABLE' ) || die $DBI::err;
 287     my @tables = keys %{$sth->fetchall_hashref( 'table_name' )};
 288
 289     my $res = {};
 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;
 295     }
 296
 297     $dbh->{'FetchHashKeyName'} = $old_fhkn;
 298     return $res;
 299 }
 300
 301 =head3 dump_sqlite_exceptions
 302
 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.
 308
 309 =cut
 310
 311 sub dump_sqlite_exceptions {
 312     my $table = shift;
 313
 314     my $special_wheres = {
 315         attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
 316     };
 317
 318     return $special_wheres->{lc $table}||'';
 319
 320 }
 321
 322 =head3 dump_current_and_savepoint
 323
 324 Returns dump of the current DB and of the named savepoint.
 325 Takes one argument - savepoint name.
 326
 327 =cut
 328
 329 sub dump_current_and_savepoint
 330 {
 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, @_ ) );
 335 }
 336
 337 =head3 dump_savepoint_and_current
 338
 339 Returns the same data as C<dump_current_and_savepoint> function,
 340 but in reversed order.
 341
 342 =cut
 343
 344 sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
 345
 346 sub clean_dates
 347 {
 348     my $h = shift;
 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/;
 355         }
 356     }
 357 }
 358
 359 =head2 NOTES
 360
 361 Function that returns debug notes.
 362
 363 =head3 note_on_fail
 364
 365 Returns a note about debug info that you can display if tests fail.
 366
 367 =cut
 368
 369 sub note_on_fail
 370 {
 371     my $name = test_name();
 372     my $tmpdir = RT::Test->temp_directory();
 373     return <<END;
 374 Some tests in '$0' file failed.
 375 You can find debug info in '$tmpdir' dir.
 376 There should be:
 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.
 381 END
 382 }
 383
 384 END {
 385     if ( ! RT::Test->builder->is_passing ) {
 386         diag( note_on_fail() );
 387     }
 388 }
 389
 390 1;