1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2016 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
52 package RT::Test::Shredder;
60 RT::Shredder test suite utilities
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.
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.
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.
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.
82 The shredder distribution has several files to help write new tests.
84 t/shredder/utils.pl - this file, utilities
85 t/00skeleton.t - skeleteton .t file for new tests
87 All tests follow this algorithm:
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
93 create_savepoint('mysp'); # create DB savepoint
94 # create data you want delete with shredder
96 # run shredder on the objects you've created
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
103 Savepoints are named and you can create two or more savepoints.
110 $class->SUPER::import(@_, tests => undef );
112 RT::Test::plan( skip_all => 'Shredder tests only work on SQLite' )
113 unless RT->Config->Get('DatabaseType') eq 'SQLite';
116 RT::Test::plan( tests => $args{'tests'} ) if $args{tests};
118 $class->export_to_level(1);
127 Returns the absolute file path to the current DB.
128 It is C<<RT::Test->temp_directory . "rt4test" >>.
132 sub db_name { return RT->Config->Get("DatabaseName") }
134 =head3 connect_sqlite
136 Returns connected DBI DB handle.
138 Takes path to sqlite db.
145 return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
152 Creates and returns a new RT::Shredder object.
160 require RT::Shredder;
161 my $obj = RT::Shredder->new;
163 my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' );
164 $obj->AddDumpPlugin( Arguments => {
175 =head3 savepoint_name
177 Returns the absolute path to the named savepoint DB file.
178 Takes one argument - savepoint name, by default C<sp>.
185 my $name = shift || 'default';
186 return File::Spec->catfile( $self->temp_directory, "sp.$name.db" );
189 =head3 create_savepoint
191 Creates savepoint DB from the current DB.
192 Takes name of the savepoint as argument.
194 =head3 restore_savepoint
196 Restores current DB to savepoint state.
197 Takes name of the savepoint as argument.
201 sub create_savepoint {
203 return $self->__cp_db( $self->db_name => $self->savepoint_name( shift ) );
205 sub restore_savepoint {
207 return $self->__cp_db( $self->savepoint_name( shift ) => $self->db_name );
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();
224 Returns DB dump as a complex hash structure:
233 Takes named argument C<CleanDates>. If true, clean all date fields from
234 dump. True by default.
242 my %args = ( CleanDates => 1, @_ );
244 my $old_fhkn = $dbh->{'FetchHashKeyName'};
245 $dbh->{'FetchHashKeyName'} = 'NAME_lc';
247 my @tables = $RT::Handle->_TableNames( $dbh );
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'
255 $self->clean_dates( $res->{$t} ) if $args{'CleanDates'};
256 die $DBI::err if $DBI::err;
259 $dbh->{'FetchHashKeyName'} = $old_fhkn;
263 =head3 dump_sqlite_exceptions
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.
273 sub dump_sqlite_exceptions {
277 my $special_wheres = {
278 attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
281 return $special_wheres->{lc $table}||'';
285 =head3 dump_current_and_savepoint
287 Returns dump of the current DB and of the named savepoint.
288 Takes one argument - savepoint name.
292 sub dump_current_and_savepoint
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, @_ ) );
301 =head3 dump_savepoint_and_current
303 Returns the same data as C<dump_current_and_savepoint> function,
304 but in reversed order.
308 sub dump_savepoint_and_current { return reverse (shift)->dump_current_and_savepoint(@_) }
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/;