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