lib/RT/Test/Shredder.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 use strict;
  50 use warnings;
  51
  52 package RT::Test::Shredder;
  53 use base 'RT::Test';
  54
  55 require File::Copy;
  56 require Cwd;
  57
  58 =head1 DESCRIPTION
  59
  60 RT::Shredder test suite utilities
  61
  62 =head1 TESTING
  63
  64 Since RT:Shredder 0.01_03 we have a test suite. You
  65 can run tests and see if everything works as expected
  66 before you try shredder on your actual data.
  67 Tests also help in the development process.
  68
  69 The test suite uses SQLite databases to store data in individual files,
  70 so you could sun tests on your production servers without risking
  71 damage to your production data.
  72
  73 You'll want to run the test suite almost every time you install or update
  74 the shredder distribution, especialy if you have local customizations of
  75 the DB schema and/or RT code.
  76
  77 Tests are one thing you can write even if you don't know much perl,
  78 but want to learn more about RT's internals. New tests are very welcome.
  79
  80 =head2 WRITING TESTS
  81
  82 The shredder distribution has several files to help write new tests.
  83
  84   t/shredder/utils.pl - this file, utilities
  85   t/00skeleton.t - skeleteton .t file for new tests
  86
  87 All tests follow this algorithm:
  88
  89   require "t/shredder/utils.pl"; # plug in utilities
  90   init_db(); # create new tmp RT DB and init RT API
  91   # create RT data you want to be always in the RT DB
  92   # ...
  93   create_savepoint('mysp'); # create DB savepoint
  94   # create data you want delete with shredder
  95   # ...
  96   # run shredder on the objects you've created
  97   # ...
  98   # check that shredder deletes things you want
  99   # this command will compare savepoint DB with current
 100   cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
 101   # then you can create another object and delete it, then check again
 102
 103 Savepoints are named and you can create two or more savepoints.
 104
 105 =cut
 106
 107 sub import {
 108     my $class = shift;
 109     $class->SUPER::import(@_);
 110     $class->export_to_level(1);
 111 }
 112
 113 =head1 FUNCTIONS
 114
 115 =head2 RT CONFIG
 116
 117 =head3 rewrite_rtconfig
 118
 119 Call this sub after C<RT::LoadConfig>. It changes the RT config
 120 options necessary to switch to a local SQLite database.
 121
 122 =cut
 123
 124 sub bootstrap_more_config {
 125     my $self = shift;
 126     my $config = shift;
 127
 128     print $config <<'END';
 129 Set($DatabaseType       , 'SQLite');
 130 Set($DatabaseHost       , 'localhost' );
 131 Set($DatabaseRTHost     , 'localhost' );
 132 Set($DatabasePort       , '' );
 133 END
 134
 135     print $config "Set(\$DatabaseName, '". $self->db_name ."');\n";
 136     return;
 137 }
 138
 139 =head2 DATABASES
 140
 141 =head3 db_name
 142
 143 Returns the absolute file path to the current DB.
 144 It is C<<RT::Test->temp_directory . 'main.db'>>.
 145
 146 =cut
 147
 148 sub db_name { return File::Spec->catfile((shift)->temp_directory, "main.db") }
 149
 150 =head3 connect_sqlite
 151
 152 Returns connected DBI DB handle.
 153
 154 Takes path to sqlite db.
 155
 156 =cut
 157
 158 sub connect_sqlite
 159 {
 160     my $self = shift;
 161     return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
 162 }
 163
 164 =head2 SHREDDER
 165
 166 =head3 shredder_new
 167
 168 Creates and returns a new RT::Shredder object.
 169
 170 =cut
 171
 172 sub shredder_new
 173 {
 174     my $self = shift;
 175
 176     require RT::Shredder;
 177     my $obj = RT::Shredder->new;
 178
 179     my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' );
 180     $obj->AddDumpPlugin( Arguments => {
 181         file_name    => $file,
 182         from_storage => 0,
 183     } );
 184
 185     return $obj;
 186 }
 187
 188
 189 =head2 SAVEPOINTS
 190
 191 =head3 savepoint_name
 192
 193 Returns the absolute path to the named savepoint DB file.
 194 Takes one argument - savepoint name, by default C<sp>.
 195
 196 =cut
 197
 198 sub savepoint_name
 199 {
 200     my $self  = shift;
 201     my $name = shift || 'default';
 202     return File::Spec->catfile( $self->temp_directory, "sp.$name.db" );
 203 }
 204
 205 =head3 create_savepoint
 206
 207 Creates savepoint DB from the current DB.
 208 Takes name of the savepoint as argument.
 209
 210 =head3 restore_savepoint
 211
 212 Restores current DB to savepoint state.
 213 Takes name of the savepoint as argument.
 214
 215 =cut
 216
 217 sub create_savepoint {
 218     my $self = shift;
 219     return $self->__cp_db( $self->db_name => $self->savepoint_name( shift ) );
 220 }
 221 sub restore_savepoint {
 222     my $self = shift;
 223     return $self->__cp_db( $self->savepoint_name( shift ) => $self->db_name );
 224 }
 225 sub __cp_db
 226 {
 227     my $self  = shift;
 228     my( $orig, $dest ) = @_;
 229     RT::Test::__disconnect_rt();
 230     File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
 231     RT::Test::__reconnect_rt();
 232     return;
 233 }
 234
 235
 236 =head2 DUMPS
 237
 238 =head3 dump_sqlite
 239
 240 Returns DB dump as a complex hash structure:
 241     {
 242     TableName => {
 243         #id => {
 244             lc_field => 'value',
 245         }
 246     }
 247     }
 248
 249 Takes named argument C<CleanDates>. If true, clean all date fields from
 250 dump. True by default.
 251
 252 =cut
 253
 254 sub dump_sqlite
 255 {
 256     my $self = shift;
 257     my $dbh = shift;
 258     my %args = ( CleanDates => 1, @_ );
 259
 260     my $old_fhkn = $dbh->{'FetchHashKeyName'};
 261     $dbh->{'FetchHashKeyName'} = 'NAME_lc';
 262
 263     my @tables = $RT::Handle->_TableNames( $dbh );
 264
 265     my $res = {};
 266     foreach my $t( @tables ) {
 267         next if lc($t) eq 'sessions';
 268         $res->{$t} = $dbh->selectall_hashref(
 269             "SELECT * FROM $t". $self->dump_sqlite_exceptions($t), 'id'
 270         );
 271         $self->clean_dates( $res->{$t} ) if $args{'CleanDates'};
 272         die $DBI::err if $DBI::err;
 273     }
 274
 275     $dbh->{'FetchHashKeyName'} = $old_fhkn;
 276     return $res;
 277 }
 278
 279 =head3 dump_sqlite_exceptions
 280
 281 If there are parts of the DB which can change from creating and deleting
 282 a queue, skip them when doing the comparison.  One example is the global
 283 queue cache attribute on RT::System which will be updated on Queue creation
 284 and can't be rolled back by the shredder.  It may actually make sense for
 285 Shredder to be updating this at some point in the future.
 286
 287 =cut
 288
 289 sub dump_sqlite_exceptions {
 290     my $self = shift;
 291     my $table = shift;
 292
 293     my $special_wheres = {
 294         attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
 295     };
 296
 297     return $special_wheres->{lc $table}||'';
 298
 299 }
 300
 301 =head3 dump_current_and_savepoint
 302
 303 Returns dump of the current DB and of the named savepoint.
 304 Takes one argument - savepoint name.
 305
 306 =cut
 307
 308 sub dump_current_and_savepoint
 309 {
 310     my $self = shift;
 311     my $orig = $self->savepoint_name( shift );
 312     die "Couldn't find savepoint file" unless -f $orig && -r _;
 313     my $odbh = $self->connect_sqlite( $orig );
 314     return ( $self->dump_sqlite( $RT::Handle->dbh, @_ ), $self->dump_sqlite( $odbh, @_ ) );
 315 }
 316
 317 =head3 dump_savepoint_and_current
 318
 319 Returns the same data as C<dump_current_and_savepoint> function,
 320 but in reversed order.
 321
 322 =cut
 323
 324 sub dump_savepoint_and_current { return reverse (shift)->dump_current_and_savepoint(@_) }
 325
 326 sub clean_dates
 327 {
 328     my $self = shift;
 329     my $h = shift;
 330     my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
 331     foreach my $id ( keys %{ $h } ) {
 332         next unless $h->{ $id };
 333         foreach ( keys %{ $h->{ $id } } ) {
 334             delete $h->{$id}{$_} if $h->{$id}{$_} &&
 335               $h->{$id}{$_} =~ /$date_re/;
 336         }
 337     }
 338 }
 339
 340 1;