rt/t/shredder/utils.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::Spec;
   7 use File::Temp 0.19 ();
   8 require File::Path;
   9 require File::Copy;
  10 require Cwd;
  11
  12 BEGIN {
  13 ### after:     push @INC, qw(@RT_LIB_PATH@);
  14     push @INC, qw(/opt/rt3/local/lib /opt/rt3/lib);
  15 }
  16 use RT::Shredder;
  17
  18 # where to keep temporary generated test data
  19 my $tmpdir = '';
  20
  21 =head1 DESCRIPTION
  22
  23 RT::Shredder test suite utilities
  24
  25 =head1 TESTING
  26
  27 Since RT:Shredder 0.01_03 we have a test suite. You
  28 can run tests and see if everything works as expected
  29 before you try shredder on your actual data.
  30 Tests also help in the development process.
  31
  32 The test suite uses SQLite databases to store data in individual files,
  33 so you could sun tests on your production servers without risking
  34 damage to your production data.
  35
  36 You'll want to run the test suite almost every time you install or update
  37 the shredder distribution, especialy if you have local customizations of
  38 the DB schema and/or RT code.
  39
  40 Tests are one thing you can write even if you don't know much perl,
  41 but want to learn more about RT's internals. New tests are very welcome.
  42
  43 =head2 WRITING TESTS
  44
  45 The shredder distribution has several files to help write new tests.
  46
  47   t/shredder/utils.pl - this file, utilities
  48   t/00skeleton.t - skeleteton .t file for new tests
  49
  50 All tests follow this algorithm:
  51
  52   require "t/shredder/utils.pl"; # plug in utilities
  53   init_db(); # create new tmp RT DB and init RT API
  54   # create RT data you want to be always in the RT DB
  55   # ...
  56   create_savepoint('mysp'); # create DB savepoint
  57   # create data you want delete with shredder
  58   # ...
  59   # run shredder on the objects you've created
  60   # ...
  61   # check that shredder deletes things you want
  62   # this command will compare savepoint DB with current
  63   cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
  64   # then you can create another object and delete it, then check again
  65
  66 Savepoints are named and you can create two or more savepoints.
  67
  68 =head1 FUNCTIONS
  69
  70 =head2 RT CONFIG
  71
  72 =head3 rewrite_rtconfig
  73
  74 Call this sub after C<RT::LoadConfig>. It changes the RT config
  75 options necessary to switch to a local SQLite database.
  76
  77 =cut
  78
  79 sub rewrite_rtconfig
  80 {
  81     # database
  82     config_set( '$DatabaseType'       , 'SQLite' );
  83     config_set( '$DatabaseHost'       , 'localhost' );
  84     config_set( '$DatabaseRTHost'     , 'localhost' );
  85     config_set( '$DatabasePort'       , '' );
  86     config_set( '$DatabaseUser'       , 'rt_user' );
  87     config_set( '$DatabasePassword'   , 'rt_pass' );
  88     config_set( '$DatabaseRequireSSL' , undef );
  89     # database file name
  90     config_set( '$DatabaseName'       , db_name() );
  91
  92     # generic logging
  93     config_set( '$LogToSyslog'    , undef );
  94     config_set( '$LogToScreen'    , 'error' );
  95     config_set( '$LogStackTraces' , 'crit' );
  96     # logging to standalone file
  97     config_set( '$LogToFile'      , 'debug' );
  98     my $fname = File::Spec->catfile(create_tmpdir(), test_name() .".log");
  99     config_set( '$LogToFileNamed' , $fname );
 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     create_tmpdir();
 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 <$tmpdir . test_name() .'.db'>.
 165
 166 See also the C<test_name> function.
 167
 168 =cut
 169
 170 sub db_name { return File::Spec->catfile(create_tmpdir(), 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 = new RT::Shredder;
 196
 197     my $file = File::Spec->catfile( create_tmpdir(), 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 TEMPORARY DIRECTORY
 227
 228 =head3 tmpdir
 229
 230 Returns the absolute path to a tmp dir used in tests.
 231
 232 =cut
 233
 234 sub tmpdir {
 235     if (-d $tmpdir) {
 236         return $tmpdir;
 237     } else {
 238         $tmpdir = File::Temp->newdir(TEMPLATE => 'shredderXXXXX', CLEANUP => 0);
 239         return $tmpdir;
 240     }
 241 }
 242
 243 =head2 create_tmpdir
 244
 245 Creates a tmp dir if one doesn't exist already. Returns tmpdir path.
 246
 247 =cut
 248
 249 sub create_tmpdir { my $n = tmpdir(); File::Path::mkpath( [$n] ); return $n }
 250
 251 =head3 cleanup_tmp
 252
 253 Deletes all the tmp dir used in the tests.
 254 See also the C<test_name> function.
 255
 256 =cut
 257
 258 sub cleanup_tmp
 259 {
 260     my $dir = File::Spec->catdir(tmpdir(), test_name());
 261     return File::Path::rmtree( File::Spec->catdir( tmpdir(), test_name() ));
 262 }
 263
 264 =head2 SAVEPOINTS
 265
 266 =head3 savepoint_name
 267
 268 Returns the absolute path to the named savepoint DB file.
 269 Takes one argument - savepoint name, by default C<sp>.
 270
 271 =cut
 272
 273 sub savepoint_name
 274 {
 275     my $name = shift || 'sp';
 276     return File::Spec->catfile( create_tmpdir(), test_name() .".$name.db" );
 277 }
 278
 279 =head3 create_savepoint
 280
 281 Creates savepoint DB from the current DB.
 282 Takes name of the savepoint as argument.
 283
 284 =head3 restore_savepoint
 285
 286 Restores current DB to savepoint state.
 287 Takes name of the savepoint as argument.
 288
 289 =cut
 290
 291 sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
 292 sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
 293 sub __cp_db
 294 {
 295     my( $orig, $dest ) = @_;
 296     $RT::Handle->dbh->disconnect;
 297     # DIRTY HACK: undef Handles to force reconnect
 298     $RT::Handle = undef;
 299     %DBIx::SearchBuilder::DBIHandle = ();
 300     $DBIx::SearchBuilder::PrevHandle = undef;
 301
 302     File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
 303     RT::ConnectToDatabase();
 304     return;
 305 }
 306
 307
 308 =head2 DUMPS
 309
 310 =head3 dump_sqlite
 311
 312 Returns DB dump as a complex hash structure:
 313     {
 314     TableName => {
 315         #id => {
 316             lc_field => 'value',
 317         }
 318     }
 319     }
 320
 321 Takes named argument C<CleanDates>. If true, clean all date fields from
 322 dump. True by default.
 323
 324 =cut
 325
 326 sub dump_sqlite
 327 {
 328     my $dbh = shift;
 329     my %args = ( CleanDates => 1, @_ );
 330
 331     my $old_fhkn = $dbh->{'FetchHashKeyName'};
 332     $dbh->{'FetchHashKeyName'} = 'NAME_lc';
 333
 334     my $sth = $dbh->table_info( '', '', '%', 'TABLE' ) || die $DBI::err;
 335     my @tables = keys %{$sth->fetchall_hashref( 'table_name' )};
 336
 337     my $res = {};
 338     foreach my $t( @tables ) {
 339         next if lc($t) eq 'sessions';
 340         $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t", 'id');
 341         clean_dates( $res->{$t} ) if $args{'CleanDates'};
 342         die $DBI::err if $DBI::err;
 343     }
 344
 345     $dbh->{'FetchHashKeyName'} = $old_fhkn;
 346     return $res;
 347 }
 348
 349 =head3 dump_current_and_savepoint
 350
 351 Returns dump of the current DB and of the named savepoint.
 352 Takes one argument - savepoint name.
 353
 354 =cut
 355
 356 sub dump_current_and_savepoint
 357 {
 358     my $orig = savepoint_name( shift );
 359     die "Couldn't find savepoint file" unless -f $orig && -r _;
 360     my $odbh = connect_sqlite( $orig );
 361     return ( dump_sqlite( $RT::Handle->dbh, @_ ), dump_sqlite( $odbh, @_ ) );
 362 }
 363
 364 =head3 dump_savepoint_and_current
 365
 366 Returns the same data as C<dump_current_and_savepoint> function,
 367 but in reversed order.
 368
 369 =cut
 370
 371 sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
 372
 373 sub clean_dates
 374 {
 375     my $h = shift;
 376     my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
 377     foreach my $id ( keys %{ $h } ) {
 378         next unless $h->{ $id };
 379         foreach ( keys %{ $h->{ $id } } ) {
 380             delete $h->{$id}{$_} if $h->{$id}{$_} &&
 381               $h->{$id}{$_} =~ /$date_re/;
 382         }
 383     }
 384 }
 385
 386 =head2 NOTES
 387
 388 Function that returns debug notes.
 389
 390 =head3 note_on_fail
 391
 392 Returns a note about debug info that you can display if tests fail.
 393
 394 =cut
 395
 396 sub note_on_fail
 397 {
 398     my $name = test_name();
 399     my $tmpdir = tmpdir();
 400     return <<END;
 401 Some tests in '$0' file failed.
 402 You can find debug info in '$tmpdir' dir.
 403 There should be:
 404     $name.log - RT debug log file
 405     $name.db - latest RT DB used while testing
 406     $name.*.db - savepoint databases
 407 See also perldoc t/shredder/utils.pl for how to use this info.
 408 END
 409 }
 410
 411 =head2 OTHER
 412
 413 =head3 all_were_successful
 414
 415 Returns true if all tests that have already run were successful.
 416
 417 =cut
 418
 419 sub all_were_successful
 420 {
 421     use Test::Builder;
 422     my $Test = Test::Builder->new;
 423     return grep( !$_, $Test->summary )? 0: 1;
 424 }
 425
 426 END {
 427     return unless -e tmpdir();
 428     if ( all_were_successful() ) {
 429             cleanup_tmp();
 430     } else {
 431             diag( note_on_fail() );
 432     }
 433 }
 434
 435 1;