rt/lib/RT/Test/Shredder.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 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
 110     $class->SUPER::import(@_, tests => undef );
 111
 112     RT::Test::plan( skip_all => 'Shredder tests only work on SQLite' )
 113           unless RT->Config->Get('DatabaseType') eq 'SQLite';
 114
 115     my %args = @_;
 116     RT::Test::plan( tests => $args{'tests'} ) if $args{tests};
 117
 118     $class->export_to_level(1);
 119 }
 120
 121 =head1 FUNCTIONS
 122
 123 =head2 DATABASES
 124
 125 =head3 db_name
 126
 127 Returns the absolute file path to the current DB.
 128 It is C<<RT::Test->temp_directory . "rt4test" >>.
 129
 130 =cut
 131
 132 sub db_name { return RT->Config->Get("DatabaseName") }
 133
 134 =head3 connect_sqlite
 135
 136 Returns connected DBI DB handle.
 137
 138 Takes path to sqlite db.
 139
 140 =cut
 141
 142 sub connect_sqlite
 143 {
 144     my $self = shift;
 145     return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
 146 }
 147
 148 =head2 SHREDDER
 149
 150 =head3 shredder_new
 151
 152 Creates and returns a new RT::Shredder object.
 153
 154 =cut
 155
 156 sub shredder_new
 157 {
 158     my $self = shift;
 159
 160     require RT::Shredder;
 161     my $obj = RT::Shredder->new;
 162
 163     my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' );
 164     $obj->AddDumpPlugin( Arguments => {
 165         file_name    => $file,
 166         from_storage => 0,
 167     } );
 168
 169     return $obj;
 170 }
 171
 172
 173 =head2 SAVEPOINTS
 174
 175 =head3 savepoint_name
 176
 177 Returns the absolute path to the named savepoint DB file.
 178 Takes one argument - savepoint name, by default C<sp>.
 179
 180 =cut
 181
 182 sub savepoint_name
 183 {
 184     my $self  = shift;
 185     my $name = shift || 'default';
 186     return File::Spec->catfile( $self->temp_directory, "sp.$name.db" );
 187 }
 188
 189 =head3 create_savepoint
 190
 191 Creates savepoint DB from the current DB.
 192 Takes name of the savepoint as argument.
 193
 194 =head3 restore_savepoint
 195
 196 Restores current DB to savepoint state.
 197 Takes name of the savepoint as argument.
 198
 199 =cut
 200
 201 sub create_savepoint {
 202     my $self = shift;
 203     return $self->__cp_db( $self->db_name => $self->savepoint_name( shift ) );
 204 }
 205 sub restore_savepoint {
 206     my $self = shift;
 207     return $self->__cp_db( $self->savepoint_name( shift ) => $self->db_name );
 208 }
 209 sub __cp_db
 210 {
 211     my $self  = shift;
 212     my( $orig, $dest ) = @_;
 213     RT::Test::__disconnect_rt();
 214     File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
 215     RT::Test::__reconnect_rt();
 216     return;
 217 }
 218
 219
 220 =head2 DUMPS
 221
 222 =head3 dump_sqlite
 223
 224 Returns DB dump as a complex hash structure:
 225     {
 226     TableName => {
 227         #id => {
 228             lc_field => 'value',
 229         }
 230     }
 231     }
 232
 233 Takes named argument C<CleanDates>. If true, clean all date fields from
 234 dump. True by default.
 235
 236 =cut
 237
 238 sub dump_sqlite
 239 {
 240     my $self = shift;
 241     my $dbh = shift;
 242     my %args = ( CleanDates => 1, @_ );
 243
 244     my $old_fhkn = $dbh->{'FetchHashKeyName'};
 245     $dbh->{'FetchHashKeyName'} = 'NAME_lc';
 246
 247     my @tables = $RT::Handle->_TableNames( $dbh );
 248
 249     my $res = {};
 250     foreach my $t( @tables ) {
 251         next if lc($t) eq 'sessions';
 252         $res->{$t} = $dbh->selectall_hashref(
 253             "SELECT * FROM $t". $self->dump_sqlite_exceptions($t), 'id'
 254         );
 255         $self->clean_dates( $res->{$t} ) if $args{'CleanDates'};
 256         die $DBI::err if $DBI::err;
 257     }
 258
 259     $dbh->{'FetchHashKeyName'} = $old_fhkn;
 260     return $res;
 261 }
 262
 263 =head3 dump_sqlite_exceptions
 264
 265 If there are parts of the DB which can change from creating and deleting
 266 a queue, skip them when doing the comparison.  One example is the global
 267 queue cache attribute on RT::System which will be updated on Queue creation
 268 and can't be rolled back by the shredder.  It may actually make sense for
 269 Shredder to be updating this at some point in the future.
 270
 271 =cut
 272
 273 sub dump_sqlite_exceptions {
 274     my $self = shift;
 275     my $table = shift;
 276
 277     my $special_wheres = {
 278         attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
 279     };
 280
 281     return $special_wheres->{lc $table}||'';
 282
 283 }
 284
 285 =head3 dump_current_and_savepoint
 286
 287 Returns dump of the current DB and of the named savepoint.
 288 Takes one argument - savepoint name.
 289
 290 =cut
 291
 292 sub dump_current_and_savepoint
 293 {
 294     my $self = shift;
 295     my $orig = $self->savepoint_name( shift );
 296     die "Couldn't find savepoint file" unless -f $orig && -r _;
 297     my $odbh = $self->connect_sqlite( $orig );
 298     return ( $self->dump_sqlite( $RT::Handle->dbh, @_ ), $self->dump_sqlite( $odbh, @_ ) );
 299 }
 300
 301 =head3 dump_savepoint_and_current
 302
 303 Returns the same data as C<dump_current_and_savepoint> function,
 304 but in reversed order.
 305
 306 =cut
 307
 308 sub dump_savepoint_and_current { return reverse (shift)->dump_current_and_savepoint(@_) }
 309
 310 sub clean_dates
 311 {
 312     my $self = shift;
 313     my $h = shift;
 314     my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
 315     foreach my $id ( keys %{ $h } ) {
 316         next unless $h->{ $id };
 317         foreach ( keys %{ $h->{ $id } } ) {
 318             delete $h->{$id}{$_} if $h->{$id}{$_} &&
 319               $h->{$id}{$_} =~ /$date_re/;
 320         }
 321     }
 322 }
 323
 324 1;