[Rt-commit] rt branch, 4.2/test-shredder-pm, created. rt-4.0.8-568-g2c5bfb4

Ruslan Zakirov ruz at bestpractical.com
Fri Nov 23 15:33:52 EST 2012


The branch, 4.2/test-shredder-pm has been created
        at  2c5bfb4bf90182e2f89f2c19c3a86f819534fe09 (commit)

- Log -----------------------------------------------------------------
commit 2c5bfb4bf90182e2f89f2c19c3a86f819534fe09
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Fri Apr 6 21:30:04 2012 +0400

    switch shredder's tests over RT::Test
    
    Rename utils.pl to lib/RT/Test/Shredder.pm. Drop
    duplicated functionality. It's still SQLite only
    but it would be much easier to test any on DB.

diff --git a/t/shredder/utils.pl b/lib/RT/Test/Shredder.pm
similarity index 55%
rename from t/shredder/utils.pl
rename to lib/RT/Test/Shredder.pm
index 846762a..654aac0 100644
--- a/t/shredder/utils.pl
+++ b/lib/RT/Test/Shredder.pm
@@ -1,15 +1,11 @@
-
 use strict;
 use warnings;
 
+package RT::Test::Shredder;
+use base 'RT::Test';
+
 require File::Copy;
 require Cwd;
-require RT::Test;
-
-BEGIN {
-### after:     push @INC, qw(@RT_LIB_PATH@);
-}
-use RT::Shredder;
 
 =head1 DESCRIPTION
 
@@ -58,6 +54,14 @@ All tests follow this algorithm:
 
 Savepoints are named and you can create two or more savepoints.
 
+=cut
+
+sub import {
+    my $class = shift;
+    $class->SUPER::import(@_);
+    $class->export_to_level(1);
+}
+
 =head1 FUNCTIONS
 
 =head2 RT CONFIG
@@ -69,99 +73,31 @@ options necessary to switch to a local SQLite database.
 
 =cut
 
-sub rewrite_rtconfig
-{
-    # database
-    config_set( '$DatabaseType'       , 'SQLite' );
-    config_set( '$DatabaseHost'       , 'localhost' );
-    config_set( '$DatabaseRTHost'     , 'localhost' );
-    config_set( '$DatabasePort'       , '' );
-    config_set( '$DatabaseUser'       , 'rt_user' );
-    config_set( '$DatabasePassword'   , 'rt_pass' );
-    config_set( '$DatabaseRequireSSL' , undef );
-    # database file name
-    config_set( '$DatabaseName'       , db_name() );
-
-    # generic logging
-    config_set( '$LogToSyslog'    , undef );
-    config_set( '$LogToSTDERR'    , 'error' );
-    config_set( '$LogStackTraces' , 'crit' );
-    # logging to standalone file
-    config_set( '$LogToFile'      , 'debug' );
-    my $fname = File::Spec->catfile(RT::Test->temp_directory(), test_name() .".log");
-    config_set( '$LogToFileNamed' , $fname );
-    config_set('@LexiconLanguages', qw(en));
-}
-
-=head3 config_set
-
-This sub is a helper used by C<rewrite_rtconfig>. You shouldn't
-need to use it elsewhere unless you need to change other RT
-configuration variables.
+sub bootstrap_more_config {
+    my $self = shift;
+    my $config = shift;
 
-=cut
+    print $config <<'END';
+Set($DatabaseType       , 'SQLite');
+Set($DatabaseHost       , 'localhost' );
+Set($DatabaseRTHost     , 'localhost' );
+Set($DatabasePort       , '' );
+END
 
-sub config_set {
-    my $opt = shift;
-    $opt =~ s/^[\$\%\@]//;
-    RT->Config->Set($opt, @_)
+    print $config "Set(\$DatabaseName, '". $self->db_name ."');\n";
+    return;
 }
 
 =head2 DATABASES
 
-=head3 init_db
-
-Creates a new RT DB with initial data in a new test tmp dir.
-Also runs RT::Init() and RT::InitLogging().
-
-This is all you need to call to setup a testing environment
-in most situations.
-
-=cut
-
-sub init_db
-{
-    RT::Test->bootstrap_tempdir() unless RT::Test->temp_directory();
-    RT::LoadConfig();
-    rewrite_rtconfig();
-    RT::InitLogging();
-
-    _init_db();
-
-    RT::Init();
-    $SIG{__WARN__} = sub { $RT::Logger->warning( @_ ); warn @_ };
-    $SIG{__DIE__} = sub { $RT::Logger->crit( @_ ) unless $^S; die @_ };
-}
-
-use IPC::Open2;
-sub _init_db
-{
-
-
-    foreach ( qw(Type Host Port Name User Password) ) {
-        $ENV{ "RT_DB_". uc $_ } = RT->Config->Get("Database$_");
-    }
-    my $rt_setup_database = RT::Test::get_relocatable_file(
-        'rt-setup-database', (File::Spec->updir(), File::Spec->updir(), 'sbin'));
-    my $cmd =  "$^X $rt_setup_database --action init 2>&1";
-
-    my ($child_out, $child_in);
-    my $pid = open2($child_out, $child_in, $cmd);
-    close $child_in;
-    my $result = do { local $/; <$child_out> };
-    return $result;
-}
-
 =head3 db_name
 
 Returns the absolute file path to the current DB.
-It is <<RT::Test->temp_directory . test_name() .'.db'>>.
-
-See also the C<test_name> function.
+It is C<<RT::Test->temp_directory . 'main.db'>>.
 
 =cut
 
-sub db_name { return File::Spec->catfile(RT::Test->temp_directory(), test_name() .".db") }
+sub db_name { return File::Spec->catfile((shift)->temp_directory, "main.db") }
 
 =head3 connect_sqlite
 
@@ -173,6 +109,7 @@ Takes path to sqlite db.
 
 sub connect_sqlite
 {
+    my $self = shift;
     return DBI->connect("dbi:SQLite:dbname=". shift, "", "");
 }
 
@@ -186,9 +123,12 @@ Creates and returns a new RT::Shredder object.
 
 sub shredder_new
 {
+    my $self = shift;
+
+    require RT::Shredder;
     my $obj = RT::Shredder->new;
 
-    my $file = File::Spec->catfile( RT::Test->temp_directory, test_name() .'.XXXX.sql' );
+    my $file = File::Spec->catfile( $self->temp_directory, 'dump.XXXX.sql' );
     $obj->AddDumpPlugin( Arguments => {
         file_name    => $file,
         from_storage => 0,
@@ -198,25 +138,6 @@ sub shredder_new
 }
 
 
-=head2 TEST FILES
-
-=head3 test_name
-
-Returns name of the test file running now with file extension and
-directory names stripped.
-
-For example, it returns '00load' for the test file 't/00load.t'.
-
-=cut
-
-sub test_name
-{
-    my $name = $0;
-    $name =~ s/^.*[\\\/]//;
-    $name =~ s/\..*$//;
-    return $name;
-}
-
 =head2 SAVEPOINTS
 
 =head3 savepoint_name
@@ -228,8 +149,9 @@ Takes one argument - savepoint name, by default C<sp>.
 
 sub savepoint_name
 {
-    my $name = shift || 'sp';
-    return File::Spec->catfile( RT::Test->temp_directory, test_name() .".$name.db" );
+    my $self  = shift;
+    my $name = shift || 'default';
+    return File::Spec->catfile( $self->temp_directory, "sp.$name.db" );
 }
 
 =head3 create_savepoint
@@ -244,10 +166,17 @@ Takes name of the savepoint as argument.
 
 =cut
 
-sub create_savepoint { return __cp_db( db_name() => savepoint_name( shift ) ) }
-sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
+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': $!";
@@ -276,6 +205,7 @@ dump. True by default.
 
 sub dump_sqlite
 {
+    my $self = shift;
     my $dbh = shift;
     my %args = ( CleanDates => 1, @_ );
 
@@ -288,8 +218,10 @@ sub dump_sqlite
     my $res = {};
     foreach my $t( @tables ) {
         next if lc($t) eq 'sessions';
-        $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t".dump_sqlite_exceptions($t), 'id');
-        clean_dates( $res->{$t} ) if $args{'CleanDates'};
+        $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;
     }
 
@@ -308,6 +240,7 @@ 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 = {
@@ -327,10 +260,11 @@ Takes one argument - savepoint name.
 
 sub dump_current_and_savepoint
 {
-    my $orig = savepoint_name( shift );
+    my $self = shift;
+    my $orig = $self->savepoint_name( shift );
     die "Couldn't find savepoint file" unless -f $orig && -r _;
-    my $odbh = connect_sqlite( $orig );
-    return ( dump_sqlite( $RT::Handle->dbh, @_ ), dump_sqlite( $odbh, @_ ) );
+    my $odbh = $self->connect_sqlite( $orig );
+    return ( $self->dump_sqlite( $RT::Handle->dbh, @_ ), $self->dump_sqlite( $odbh, @_ ) );
 }
 
 =head3 dump_savepoint_and_current
@@ -340,10 +274,11 @@ but in reversed order.
 
 =cut
 
-sub dump_savepoint_and_current { return reverse dump_current_and_savepoint(@_) }
+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 } ) {
@@ -355,35 +290,4 @@ sub clean_dates
     }
 }
 
-=head2 NOTES
-
-Function that returns debug notes.
-
-=head3 note_on_fail
-
-Returns a note about debug info that you can display if tests fail.
-
-=cut
-
-sub note_on_fail
-{
-    my $name = test_name();
-    my $tmpdir = RT::Test->temp_directory();
-    return <<END;
-Some tests in '$0' file failed.
-You can find debug info in '$tmpdir' dir.
-There should be:
-    $name.log - RT debug log file
-    $name.db - latest RT DB used while testing
-    $name.*.db - savepoint databases
-See also perldoc t/shredder/utils.pl for how to use this info.
-END
-}
-
-END {
-    if ( ! RT::Test->builder->is_passing ) {
-        diag( note_on_fail() );
-    }
-}
-
 1;
diff --git a/t/shredder/00load.t b/t/shredder/00load.t
index 21d5ef7..2d78da4 100644
--- a/t/shredder/00load.t
+++ b/t/shredder/00load.t
@@ -1,14 +1,6 @@
 use strict;
 use warnings;
-use File::Spec;
-use Test::More tests => 11;
-use RT::Test nodb => 1;
-
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
+use RT::Test nodb => 1, tests => 11;
 
 use_ok("RT::Shredder");
 
diff --git a/t/shredder/00skeleton.t b/t/shredder/00skeleton.t
index c23e064..86f6fa9 100644
--- a/t/shredder/00skeleton.t
+++ b/t/shredder/00skeleton.t
@@ -3,22 +3,14 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 1;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-init_db();
+use RT::Test::Shredder tests => 1;
+my $test = "RT::Test::Shredder";
 
-
-create_savepoint('clean'); # backup of the clean RT DB
-my $shredder = shredder_new(); # new shredder object
+$test->create_savepoint('clean'); # backup of the clean RT DB
+my $shredder = $test->shredder_new(); # new shredder object
 
 # ....
 # create and wipe RT objects
 #
 
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
diff --git a/t/shredder/01basics.t b/t/shredder/01basics.t
index b0000b1..aea4e49 100644
--- a/t/shredder/01basics.t
+++ b/t/shredder/01basics.t
@@ -3,18 +3,10 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 3;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-init_db();
+use RT::Test::Shredder tests => 3;
+my $test = "RT::Test::Shredder";
 
-
-create_savepoint();
+$test->create_savepoint();
 
 use RT::Tickets;
 my $ticket = RT::Ticket->new( RT->SystemUser );
@@ -25,7 +17,7 @@ $ticket = RT::Ticket->new( RT->SystemUser );
 my ($status, $msg) = $ticket->Load( $id );
 ok( $id, "load ticket" ) or diag( "error: $msg" );
 
-my $shredder = shredder_new();
+my $shredder = $test->shredder_new();
 $shredder->Wipeout( Object => $ticket );
 
-cmp_deeply( dump_current_and_savepoint(), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint(), "current DB equal to savepoint");
diff --git a/t/shredder/01ticket.t b/t/shredder/01ticket.t
index b834963..60e4a7e 100644
--- a/t/shredder/01ticket.t
+++ b/t/shredder/01ticket.t
@@ -3,19 +3,10 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 15;
-use RT::Test ();
+use RT::Test::Shredder tests => 15;
+my $test = "RT::Test::Shredder";
 
-
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-
-init_db();
-create_savepoint('clean');
+$test->create_savepoint('clean');
 
 use RT::Ticket;
 use RT::Tickets;
@@ -32,17 +23,17 @@ use RT::Tickets;
     $tickets->LimitStatus( VALUE => 'deleted' );
     is( $tickets->Count, 1, "found one deleted ticket" );
 
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     $shredder->PutObjects( Objects => $tickets );
     $shredder->WipeoutAll;
 }
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 
 {
     my $parent = RT::Ticket->new( RT->SystemUser );
     my ($pid) = $parent->Create( Subject => 'test', Queue => 1 );
     ok( $pid, "created new ticket" );
-    create_savepoint('parent_ticket');
+    $test->create_savepoint('parent_ticket');
 
     my $child = RT::Ticket->new( RT->SystemUser );
     my ($cid) = $child->Create( Subject => 'test', Queue => 1 );
@@ -50,15 +41,15 @@ cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint"
 
     my ($status, $msg) = $parent->AddLink( Type => 'MemberOf', Target => $cid );
     ok( $status, "Added link between tickets") or diag("error: $msg");
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     $shredder->PutObjects( Objects => $child );
     $shredder->WipeoutAll;
-    cmp_deeply( dump_current_and_savepoint('parent_ticket'), "current DB equal to savepoint");
+    cmp_deeply( $test->dump_current_and_savepoint('parent_ticket'), "current DB equal to savepoint");
 
     $shredder->PutObjects( Objects => $parent );
     $shredder->WipeoutAll;
 }
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 
 {
     my $parent = RT::Ticket->new( RT->SystemUser );
@@ -66,7 +57,7 @@ cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint"
     ok( $pid, "created new ticket" );
     my ($status, $msg) = $parent->Delete;
     ok( $status, 'deleted parent ticket');
-    create_savepoint('parent_ticket');
+    $test->create_savepoint('parent_ticket');
 
     my $child = RT::Ticket->new( RT->SystemUser );
     my ($cid) = $child->Create( Subject => 'test', Queue => 1 );
@@ -74,16 +65,16 @@ cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint"
 
     ($status, $msg) = $parent->AddLink( Type => 'DependsOn', Target => $cid );
     ok( $status, "Added link between tickets") or diag("error: $msg");
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     $shredder->PutObjects( Objects => $child );
     $shredder->WipeoutAll;
 
-  TODO: {
+    TODO: {
         local $TODO = "Shredder doesn't delete all links and transactions";
-        cmp_deeply( dump_current_and_savepoint('parent_ticket'), "current DB equal to savepoint");
+        cmp_deeply( $test->dump_current_and_savepoint('parent_ticket'), "current DB equal to savepoint");
     }
 
     $shredder->PutObjects( Objects => $parent );
     $shredder->WipeoutAll;
 }
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
diff --git a/t/shredder/02group_member.t b/t/shredder/02group_member.t
index 5952e1e..4f881a0 100644
--- a/t/shredder/02group_member.t
+++ b/t/shredder/02group_member.t
@@ -3,20 +3,12 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 22;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-init_db();
-
+use RT::Test::Shredder tests => 22;
+my $test = "RT::Test::Shredder";
 
 ### nested membership check
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
 	my $pgroup = RT::Group->new( RT->SystemUser );
 	my ($pgid) = $pgroup->CreateUserDefinedGroup( Name => 'Parent group' );
 	ok( $pgid, "created parent group" );
@@ -30,14 +22,14 @@ init_db();
 	my ($status, $msg) = $pgroup->AddMember( $cgroup->id );
 	ok( $status, "added child group to parent") or diag "error: $msg";
 	
-	create_savepoint('bucreate'); # before user create
+	$test->create_savepoint('bucreate'); # before user create
 	my $user = RT::User->new( RT->SystemUser );
 	my $uid;
 	($uid, $msg) = $user->Create( Name => 'new user', Privileged => 1, Disabled => 0 );
 	ok( $uid, "created new user" ) or diag "error: $msg";
 	is( $user->id, $uid, "id is correct" );
 	
-	create_savepoint('buadd'); # before group add
+	$test->create_savepoint('buadd'); # before group add
 	($status, $msg) = $cgroup->AddMember( $user->id );
 	ok( $status, "added user to child group") or diag "error: $msg";
 	
@@ -46,23 +38,23 @@ init_db();
 	$members->Limit( FIELD => 'GroupId', VALUE => $cgid );
 	is( $members->Count, 1, "find membership record" );
 	
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $members );
 	$shredder->WipeoutAll();
-	cmp_deeply( dump_current_and_savepoint('buadd'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('buadd'), "current DB equal to savepoint");
 	
 	$shredder->PutObjects( Objects => $user );
 	$shredder->WipeoutAll();
-	cmp_deeply( dump_current_and_savepoint('bucreate'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('bucreate'), "current DB equal to savepoint");
 	
 	$shredder->PutObjects( Objects => [$pgroup, $cgroup] );
 	$shredder->WipeoutAll();
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
 
 ### deleting member of the ticket Owner role group
 {
-	restore_savepoint('clean');
+	$test->restore_savepoint('clean');
 
 	my $user = RT::User->new( RT->SystemUser );
 	my ($uid, $msg) = $user->Create( Name => 'new user', Privileged => 1, Disabled => 0 );
@@ -90,7 +82,7 @@ init_db();
 	is( $ticket->Owner, $user->id, "owner successfuly set") or diag( "error: $msg" );
 
 	my $member = $ticket->OwnerGroup->MembersObj->First;
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $member );
 	$shredder->WipeoutAll();
 
diff --git a/t/shredder/02queue.t b/t/shredder/02queue.t
index 7cfd378..5b83e0f 100644
--- a/t/shredder/02queue.t
+++ b/t/shredder/02queue.t
@@ -3,33 +3,25 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 16;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-init_db();
-
+use RT::Test::Shredder tests => 16;
+my $test = "RT::Test::Shredder";
 
 diag 'simple queue' if $ENV{TEST_VERBOSE};
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
     my $queue = RT::Queue->new( RT->SystemUser );
     my ($id, $msg) = $queue->Create( Name => 'my queue' );
     ok($id, 'created queue') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $queue );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
 
 diag 'queue with scrip' if $ENV{TEST_VERBOSE};
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
     my $queue = RT::Queue->new( RT->SystemUser );
     my ($id, $msg) = $queue->Create( Name => 'my queue' );
     ok($id, 'created queue') or diag "error: $msg";
@@ -44,15 +36,15 @@ diag 'queue with scrip' if $ENV{TEST_VERBOSE};
     );
     ok($id, 'created scrip') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $queue );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
 
 diag 'queue with template' if $ENV{TEST_VERBOSE};
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
     my $queue = RT::Queue->new( RT->SystemUser );
     my ($id, $msg) = $queue->Create( Name => 'my queue' );
     ok($id, 'created queue') or diag "error: $msg";
@@ -65,15 +57,15 @@ diag 'queue with template' if $ENV{TEST_VERBOSE};
     );
     ok($id, 'created template') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $queue );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
 
 diag 'queue with a right granted' if $ENV{TEST_VERBOSE};
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
     my $queue = RT::Queue->new( RT->SystemUser );
     my ($id, $msg) = $queue->Create( Name => 'my queue' );
     ok($id, 'created queue') or diag "error: $msg";
@@ -88,21 +80,21 @@ diag 'queue with a right granted' if $ENV{TEST_VERBOSE};
     );
     ok($id, 'granted right') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $queue );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
 
 diag 'queue with a watcher' if $ENV{TEST_VERBOSE};
 {
 # XXX, FIXME: if uncomment these lines then we'll get 'Bizarre...'
-#	create_savepoint('clean');
+#	$test->create_savepoint('clean');
     my $group = RT::Group->new( RT->SystemUser );
     my ($id, $msg) = $group->CreateUserDefinedGroup(Name => 'my group');
     ok($id, 'created group') or diag "error: $msg";
 
-	create_savepoint('bqcreate');
+	$test->create_savepoint('bqcreate');
     my $queue = RT::Queue->new( RT->SystemUser );
     ($id, $msg) = $queue->Create( Name => 'my queue' );
     ok($id, 'created queue') or diag "error: $msg";
@@ -113,12 +105,12 @@ diag 'queue with a watcher' if $ENV{TEST_VERBOSE};
     );
     ok($id, 'added watcher') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $queue );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('bqcreate'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('bqcreate'), "current DB equal to savepoint");
 
 #	$shredder->PutObjects( Objects => $group );
 #	$shredder->WipeoutAll;
-#	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+#	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
diff --git a/t/shredder/02template.t b/t/shredder/02template.t
index 4d0cd4f..2f9b4ab 100644
--- a/t/shredder/02template.t
+++ b/t/shredder/02template.t
@@ -3,20 +3,12 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 7;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-init_db();
-
+use RT::Test::Shredder tests => 7;
+my $test = "RT::Test::Shredder";
 
 diag 'global template' if $ENV{TEST_VERBOSE};
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
     my $template = RT::Template->new( RT->SystemUser );
     my ($id, $msg) = $template->Create(
         Name => 'my template',
@@ -24,15 +16,15 @@ diag 'global template' if $ENV{TEST_VERBOSE};
     );
     ok($id, 'created template') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $template );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
 
 diag 'local template' if $ENV{TEST_VERBOSE};
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
     my $template = RT::Template->new( RT->SystemUser );
     my ($id, $msg) = $template->Create(
         Name => 'my template',
@@ -41,15 +33,15 @@ diag 'local template' if $ENV{TEST_VERBOSE};
     );
     ok($id, 'created template') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $template );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
 
 diag 'template used in scrip' if $ENV{TEST_VERBOSE};
 {
-	create_savepoint('clean');
+	$test->create_savepoint('clean');
     my $template = RT::Template->new( RT->SystemUser );
     my ($id, $msg) = $template->Create(
         Name => 'my template',
@@ -68,8 +60,8 @@ diag 'template used in scrip' if $ENV{TEST_VERBOSE};
     );
     ok($id, 'created scrip') or diag "error: $msg";
 
-	my $shredder = shredder_new();
+	my $shredder = $test->shredder_new();
 	$shredder->PutObjects( Objects => $template );
 	$shredder->WipeoutAll;
-	cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+	cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 }
diff --git a/t/shredder/02user.t b/t/shredder/02user.t
index d97511d..776a26d 100644
--- a/t/shredder/02user.t
+++ b/t/shredder/02user.t
@@ -3,18 +3,10 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 8;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-init_db();
-
+use RT::Test::Shredder tests => 8;
+my $test = "RT::Test::Shredder";
 
-create_savepoint('clean');
+$test->create_savepoint('clean');
 
 my $queue = RT::Queue->new( RT->SystemUser );
 my ($qid) = $queue->Load( 'General' );
@@ -24,14 +16,14 @@ my $ticket = RT::Ticket->new( RT->SystemUser );
 my ($tid) = $ticket->Create( Queue => $qid, Subject => 'test' );
 ok( $tid, "ticket created" );
 
-create_savepoint('bucreate'); # berfore user create
+$test->create_savepoint('bucreate'); # berfore user create
 my $user = RT::User->new( RT->SystemUser );
 my ($uid, $msg) = $user->Create( Name => 'new user', Privileged => 1, Disabled => 0 );
 ok( $uid, "created new user" ) or diag "error: $msg";
 is( $user->id, $uid, "id is correct" );
 # HACK: set ticket props to enable VARIABLE dependencies
 $ticket->__Set( Field => 'LastUpdatedBy', Value => $uid );
-create_savepoint('aucreate'); # after user create
+$test->create_savepoint('aucreate'); # after user create
 
 {
     my $resolver = sub {
@@ -43,19 +35,19 @@ create_savepoint('aucreate'); # after user create
             $t->__Set( Field => $method, Value => $resolver_uid );
         }
     };
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     $shredder->PutResolver( BaseClass => 'RT::User', Code => $resolver );
     $shredder->Wipeout( Object => $user );
-    cmp_deeply( dump_current_and_savepoint('bucreate'), "current DB equal to savepoint");
+    cmp_deeply( $test->dump_current_and_savepoint('bucreate'), "current DB equal to savepoint");
 }
 
 {
-    restore_savepoint('aucreate');
+    $test->restore_savepoint('aucreate');
     my $user = RT::User->new( RT->SystemUser );
     $user->Load($uid);
     ok($user->id, "loaded user after restore");
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     eval { $shredder->Wipeout( Object => $user ) };
     ok($@, "wipeout throw exception if no resolvers");
-    cmp_deeply( dump_current_and_savepoint('aucreate'), "current DB equal to savepoint");
+    cmp_deeply( $test->dump_current_and_savepoint('aucreate'), "current DB equal to savepoint");
 }
diff --git a/t/shredder/03plugin.t b/t/shredder/03plugin.t
index 4ba2fbf..de5d44f 100644
--- a/t/shredder/03plugin.t
+++ b/t/shredder/03plugin.t
@@ -3,14 +3,8 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 28;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
+use RT::Test::Shredder nodb => 1, tests => 28;
+my $test = "RT::Test::Shredder";
 
 my @PLUGINS = sort qw(Attachments Base Objects SQLDump Summary Tickets Users);
 
diff --git a/t/shredder/03plugin_summary.t b/t/shredder/03plugin_summary.t
index ec3b6e9..7da8bb4 100644
--- a/t/shredder/03plugin_summary.t
+++ b/t/shredder/03plugin_summary.t
@@ -2,16 +2,7 @@
 use strict;
 use warnings;
 
-use Test::Deep;
-use File::Spec;
-use Test::More tests => 4;
-use RT::Test nodb => 1;
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-
+use RT::Test::Shredder nodb => 1, tests => 4;
 
 use_ok('RT::Shredder::Plugin');
 my $plugin_obj = RT::Shredder::Plugin->new;
diff --git a/t/shredder/03plugin_tickets.t b/t/shredder/03plugin_tickets.t
index 256be1c..a909c89 100644
--- a/t/shredder/03plugin_tickets.t
+++ b/t/shredder/03plugin_tickets.t
@@ -3,15 +3,10 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 44;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
+use RT::Test::Shredder tests => 45;
+my $test = "RT::Test::Shredder";
 
+use_ok('RT::Shredder');
 
 use_ok('RT::Shredder::Plugin::Tickets');
 {
@@ -21,8 +16,7 @@ use_ok('RT::Shredder::Plugin::Tickets');
     is(lc $plugin->Type, 'search', 'correct type');
 }
 
-init_db();
-create_savepoint('clean');
+$test->create_savepoint('clean');
 use_ok('RT::Ticket');
 use_ok('RT::Tickets');
 
@@ -59,11 +53,11 @@ use_ok('RT::Tickets');
     ok($has{$pid}, "parent is in the result set");
     ok($has{$cid}, "child is in the result set");
 
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     $shredder->PutObjects( Objects => \@objs );
     $shredder->WipeoutAll;
 }
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 
 { # create parent and child and link them reqursively to check that we don't hang
     my $parent = RT::Ticket->new( RT->SystemUser );
@@ -103,11 +97,11 @@ cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint"
     ok($has{$pid}, "parent is in the result set");
     ok($has{$cid}, "child is in the result set");
 
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     $shredder->PutObjects( Objects => \@objs );
     $shredder->WipeoutAll;
 }
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
 
 { # create parent and child and check functionality of 'apply_query_to_linked' arg
     my $parent = RT::Ticket->new( RT->SystemUser );
@@ -141,7 +135,7 @@ cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint"
     ok(!$has{$cid1}, "first child is in the result set");
     ok($has{$cid2}, "second child is in the result set");
 
-    my $shredder = shredder_new();
+    my $shredder = $test->shredder_new();
     $shredder->PutObjects( Objects => \@objs );
     $shredder->WipeoutAll;
 
@@ -152,4 +146,4 @@ cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint"
     $shredder->PutObjects( Objects => $ticket );
     $shredder->WipeoutAll;
 }
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");
diff --git a/t/shredder/03plugin_users.t b/t/shredder/03plugin_users.t
index ef75680..7f551d4 100644
--- a/t/shredder/03plugin_users.t
+++ b/t/shredder/03plugin_users.t
@@ -3,15 +3,8 @@ use strict;
 use warnings;
 
 use Test::Deep;
-use File::Spec;
-use Test::More tests => 21;
-use RT::Test ();
-BEGIN {
-    my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
-        File::Spec->curdir());
-    require $shredder_utils;
-}
-
+use RT::Test::Shredder tests => 21;
+my $test = "RT::Test::Shredder";
 
 my @ARGS = sort qw(limit status name member_of email replace_relations no_tickets);
 
@@ -37,13 +30,11 @@ use_ok('RT::Shredder::Plugin::Users');
     ok(!$status, "bad 'status' arg value");
 }
 
-init_db();
-
 RT::Test->set_rights(
     { Principal => 'Everyone', Right => [qw(CreateTicket)] },
 );
 
-create_savepoint('clean');
+$test->create_savepoint('clean');
 
 { # Create two users and a ticket. Shred second user and replace relations with first user
     my ($uidA, $uidB, $msg);
@@ -71,14 +62,14 @@ create_savepoint('clean');
     ($status, $msg) = $plugin->TestArgs( status => 'any', name => 'userB', replace_relations => $uidA );
     ok($status, "plugin arguments are ok") or diag "error: $msg";
 
+    my $shredder = $test->shredder_new();
+
     my @objs;
     ($status, @objs) = $plugin->Run;
     ok($status, "executed plugin successfully") or diag "error: @objs";
     @objs = RT::Shredder->CastObjectsToRecords( Objects => \@objs );
     is(scalar @objs, 1, "one object in the result set");
 
-    my $shredder = shredder_new();
-
     ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder );
     ok($status, "set conflicts resolver") or diag "error: $msg";
 
@@ -94,4 +85,4 @@ create_savepoint('clean');
     $shredder->Wipeout( Object => $ticket );
     $shredder->Wipeout( Object => $userA );
 }
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
+cmp_deeply( $test->dump_current_and_savepoint('clean'), "current DB equal to savepoint");

-----------------------------------------------------------------------


More information about the Rt-commit mailing list