--- /dev/null
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+use strict;
+use warnings;
+
+package RT::Test::Shredder;
+use base 'RT::Test';
+
+require File::Copy;
+require Cwd;
+
+=head1 DESCRIPTION
+
+RT::Shredder test suite utilities
+
+=head1 TESTING
+
+Since RT:Shredder 0.01_03 we have a test suite. You
+can run tests and see if everything works as expected
+before you try shredder on your actual data.
+Tests also help in the development process.
+
+The test suite uses SQLite databases to store data in individual files,
+so you could sun tests on your production servers without risking
+damage to your production data.
+
+You'll want to run the test suite almost every time you install or update
+the shredder distribution, especialy if you have local customizations of
+the DB schema and/or RT code.
+
+Tests are one thing you can write even if you don't know much perl,
+but want to learn more about RT's internals. New tests are very welcome.
+
+=head2 WRITING TESTS
+
+The shredder distribution has several files to help write new tests.
+
+ t/shredder/utils.pl - this file, utilities
+ t/00skeleton.t - skeleteton .t file for new tests
+
+All tests follow this algorithm:
+
+ require "t/shredder/utils.pl"; # plug in utilities
+ init_db(); # create new tmp RT DB and init RT API
+ # create RT data you want to be always in the RT DB
+ # ...
+ create_savepoint('mysp'); # create DB savepoint
+ # create data you want delete with shredder
+ # ...
+ # run shredder on the objects you've created
+ # ...
+ # check that shredder deletes things you want
+ # this command will compare savepoint DB with current
+ cmp_deeply( dump_current_and_savepoint('mysp'), "current DB equal to savepoint");
+ # then you can create another object and delete it, then check again
+
+Savepoints are named and you can create two or more savepoints.
+
+=cut
+
+sub import {
+ my $class = shift;
+
+ $class->SUPER::import(@_, tests => undef );
+
+ RT::Test::plan( skip_all => 'Shredder tests only work on SQLite' )
+ unless RT->Config->Get('DatabaseType') eq 'SQLite';
+
+ my %args = @_;
+ RT::Test::plan( tests => $args{'tests'} ) if $args{tests};
+
+ $class->export_to_level(1);
+}
+
+=head1 FUNCTIONS
+
+=head2 DATABASES
+
+=head3 db_name
+
+Returns the absolute file path to the current DB.
+It is C<<RT::Test->temp_directory . "rt4test" >>.
+
+=cut
+
+sub db_name { return RT->Config->Get("DatabaseName") }
+
+=head3 connect_sqlite
+
+Returns connected DBI DB handle.
+
+Takes path to sqlite db.
+
+=cut
+
+sub connect_sqlite
+{
+ my $self = shift;
+ return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
+}
+
+=head2 SHREDDER
+
+=head3 shredder_new
+
+Creates and returns a new RT::Shredder object.
+
+=cut
+
+sub shredder_new
+{
+ my $self = shift;
+
+ require RT::Shredder;
+ my $obj = RT::Shredder->new;
+
+ my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' );
+ $obj->AddDumpPlugin( Arguments => {
+ file_name => $file,
+ from_storage => 0,
+ } );
+
+ return $obj;
+}
+
+
+=head2 SAVEPOINTS
+
+=head3 savepoint_name
+
+Returns the absolute path to the named savepoint DB file.
+Takes one argument - savepoint name, by default C<sp>.
+
+=cut
+
+sub savepoint_name
+{
+ my $self = shift;
+ my $name = shift || 'default';
+ return File::Spec->catfile( $self->temp_directory, "sp.$name.db" );
+}
+
+=head3 create_savepoint
+
+Creates savepoint DB from the current DB.
+Takes name of the savepoint as argument.
+
+=head3 restore_savepoint
+
+Restores current DB to savepoint state.
+Takes name of the savepoint as argument.
+
+=cut
+
+sub create_savepoint {
+ my $self = shift;
+ return $self->__cp_db( $self->db_name => $self->savepoint_name( shift ) );
+}
+sub restore_savepoint {
+ my $self = shift;
+ return $self->__cp_db( $self->savepoint_name( shift ) => $self->db_name );
+}
+sub __cp_db
+{
+ my $self = shift;
+ my( $orig, $dest ) = @_;
+ RT::Test::__disconnect_rt();
+ File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
+ RT::Test::__reconnect_rt();
+ return;
+}
+
+
+=head2 DUMPS
+
+=head3 dump_sqlite
+
+Returns DB dump as a complex hash structure:
+ {
+ TableName => {
+ #id => {
+ lc_field => 'value',
+ }
+ }
+ }
+
+Takes named argument C<CleanDates>. If true, clean all date fields from
+dump. True by default.
+
+=cut
+
+sub dump_sqlite
+{
+ my $self = shift;
+ my $dbh = shift;
+ my %args = ( CleanDates => 1, @_ );
+
+ my $old_fhkn = $dbh->{'FetchHashKeyName'};
+ $dbh->{'FetchHashKeyName'} = 'NAME_lc';
+
+ my @tables = $RT::Handle->_TableNames( $dbh );
+
+ my $res = {};
+ foreach my $t( @tables ) {
+ next if lc($t) eq 'sessions';
+ $res->{$t} = $dbh->selectall_hashref(
+ "SELECT * FROM $t". $self->dump_sqlite_exceptions($t), 'id'
+ );
+ $self->clean_dates( $res->{$t} ) if $args{'CleanDates'};
+ die $DBI::err if $DBI::err;
+ }
+
+ $dbh->{'FetchHashKeyName'} = $old_fhkn;
+ return $res;
+}
+
+=head3 dump_sqlite_exceptions
+
+If there are parts of the DB which can change from creating and deleting
+a queue, skip them when doing the comparison. One example is the global
+queue cache attribute on RT::System which will be updated on Queue creation
+and can't be rolled back by the shredder. It may actually make sense for
+Shredder to be updating this at some point in the future.
+
+=cut
+
+sub dump_sqlite_exceptions {
+ my $self = shift;
+ my $table = shift;
+
+ my $special_wheres = {
+ attributes => " WHERE Name != 'QueueCacheNeedsUpdate'"
+ };
+
+ return $special_wheres->{lc $table}||'';
+
+}
+
+=head3 dump_current_and_savepoint
+
+Returns dump of the current DB and of the named savepoint.
+Takes one argument - savepoint name.
+
+=cut
+
+sub dump_current_and_savepoint
+{
+ my $self = shift;
+ my $orig = $self->savepoint_name( shift );
+ die "Couldn't find savepoint file" unless -f $orig && -r _;
+ my $odbh = $self->connect_sqlite( $orig );
+ return ( $self->dump_sqlite( $RT::Handle->dbh, @_ ), $self->dump_sqlite( $odbh, @_ ) );
+}
+
+=head3 dump_savepoint_and_current
+
+Returns the same data as C<dump_current_and_savepoint> function,
+but in reversed order.
+
+=cut
+
+sub dump_savepoint_and_current { return reverse (shift)->dump_current_and_savepoint(@_) }
+
+sub clean_dates
+{
+ my $self = shift;
+ my $h = shift;
+ my $date_re = qr/^\d\d\d\d\-\d\d\-\d\d\s*\d\d\:\d\d(\:\d\d)?$/i;
+ foreach my $id ( keys %{ $h } ) {
+ next unless $h->{ $id };
+ foreach ( keys %{ $h->{ $id } } ) {
+ delete $h->{$id}{$_} if $h->{$id}{$_} &&
+ $h->{$id}{$_} =~ /$date_re/;
+ }
+ }
+}
+
+1;
projects / freeside.git / blobdiff