rt/t/shredder/utils.pl

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