summaryrefslogtreecommitdiff
path: root/rt/t/shredder
diff options
context:
space:
mode:
Diffstat (limited to 'rt/t/shredder')
-rw-r--r--rt/t/shredder/00load.t29
-rw-r--r--rt/t/shredder/00skeleton.t25
-rw-r--r--rt/t/shredder/01basics.t32
-rw-r--r--rt/t/shredder/01ticket.t86
-rw-r--r--rt/t/shredder/02group_member.t103
-rw-r--r--rt/t/shredder/02queue.t125
-rw-r--r--rt/t/shredder/02template.t76
-rw-r--r--rt/t/shredder/02user.t62
-rw-r--r--rt/t/shredder/03plugin.t46
-rw-r--r--rt/t/shredder/03plugin_summary.t23
-rw-r--r--rt/t/shredder/03plugin_tickets.t150
-rw-r--r--rt/t/shredder/03plugin_users.t40
-rw-r--r--rt/t/shredder/utils.pl435
13 files changed, 0 insertions, 1232 deletions
diff --git a/rt/t/shredder/00load.t b/rt/t/shredder/00load.t
deleted file mode 100644
index 1e06261bc..000000000
--- a/rt/t/shredder/00load.t
+++ /dev/null
@@ -1,29 +0,0 @@
-use strict;
-use warnings;
-use File::Spec;
-use Test::More tests => 11;
-use RT::Test ();
-
-BEGIN {
- my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
- File::Spec->curdir());
- require $shredder_utils;
-}
-
-use_ok("RT::Shredder");
-
-use_ok("RT::Shredder::Plugin");
-use_ok("RT::Shredder::Plugin::Base");
-
-# search plugins
-use_ok("RT::Shredder::Plugin::Base::Search");
-use_ok("RT::Shredder::Plugin::Objects");
-use_ok("RT::Shredder::Plugin::Attachments");
-use_ok("RT::Shredder::Plugin::Tickets");
-use_ok("RT::Shredder::Plugin::Users");
-
-# dump plugins
-use_ok("RT::Shredder::Plugin::Base::Dump");
-use_ok("RT::Shredder::Plugin::SQLDump");
-use_ok("RT::Shredder::Plugin::Summary");
-
diff --git a/rt/t/shredder/00skeleton.t b/rt/t/shredder/00skeleton.t
deleted file mode 100644
index eab9433cd..000000000
--- a/rt/t/shredder/00skeleton.t
+++ /dev/null
@@ -1,25 +0,0 @@
-#!/usr/bin/perl -w
-
-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();
-
-
-create_savepoint('clean'); # backup of the clean RT DB
-my $shredder = shredder_new(); # new shredder object
-
-# ....
-# create and wipe RT objects
-#
-
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
diff --git a/rt/t/shredder/01basics.t b/rt/t/shredder/01basics.t
deleted file mode 100644
index 450f2df8c..000000000
--- a/rt/t/shredder/01basics.t
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/usr/bin/perl -w
-
-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();
-
-
-create_savepoint();
-
-use RT::Tickets;
-my $ticket = RT::Ticket->new( $RT::SystemUser );
-my ($id) = $ticket->Create( Subject => 'test', Queue => 1 );
-ok( $id, "created new ticket" );
-
-$ticket = RT::Ticket->new( $RT::SystemUser );
-my ($status, $msg) = $ticket->Load( $id );
-ok( $id, "load ticket" ) or diag( "error: $msg" );
-
-my $shredder = shredder_new();
-$shredder->Wipeout( Object => $ticket );
-
-cmp_deeply( dump_current_and_savepoint(), "current DB equal to savepoint");
diff --git a/rt/t/shredder/01ticket.t b/rt/t/shredder/01ticket.t
deleted file mode 100644
index 5625b985d..000000000
--- a/rt/t/shredder/01ticket.t
+++ /dev/null
@@ -1,86 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-
-use Test::Deep;
-use File::Spec;
-use Test::More tests => 15;
-use RT::Test ();
-
-
-BEGIN {
- my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
- File::Spec->curdir());
- require $shredder_utils;
-}
-
-init_db();
-create_savepoint('clean');
-
-use RT::Ticket;
-use RT::Tickets;
-
-{
- my $ticket = RT::Ticket->new( $RT::SystemUser );
- my ($id) = $ticket->Create( Subject => 'test', Queue => 1 );
- ok( $id, "created new ticket" );
- $ticket->Delete;
- is( $ticket->Status, 'deleted', "successfuly changed status" );
-
- my $tickets = RT::Tickets->new( $RT::SystemUser );
- $tickets->{'allow_deleted_search'} = 1;
- $tickets->LimitStatus( VALUE => 'deleted' );
- is( $tickets->Count, 1, "found one deleted ticket" );
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $tickets );
- $shredder->WipeoutAll;
-}
-cmp_deeply( 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');
-
- my $child = RT::Ticket->new( $RT::SystemUser );
- my ($cid) = $child->Create( Subject => 'test', Queue => 1 );
- ok( $cid, "created new ticket" );
-
- my ($status, $msg) = $parent->AddLink( Type => 'MemberOf', Target => $cid );
- ok( $status, "Added link between tickets") or diag("error: $msg");
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $child );
- $shredder->WipeoutAll;
- cmp_deeply( 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");
-
-{
- my $parent = RT::Ticket->new( $RT::SystemUser );
- my ($pid) = $parent->Create( Subject => 'test', Queue => 1 );
- ok( $pid, "created new ticket" );
- my ($status, $msg) = $parent->Delete;
- ok( $status, 'deleted parent ticket');
- create_savepoint('parent_ticket');
-
- my $child = RT::Ticket->new( $RT::SystemUser );
- my ($cid) = $child->Create( Subject => 'test', Queue => 1 );
- ok( $cid, "created new ticket" );
-
- ($status, $msg) = $parent->AddLink( Type => 'DependsOn', Target => $cid );
- ok( $status, "Added link between tickets") or diag("error: $msg");
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $child );
- $shredder->WipeoutAll;
- cmp_deeply( 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");
diff --git a/rt/t/shredder/02group_member.t b/rt/t/shredder/02group_member.t
deleted file mode 100644
index b68557a8b..000000000
--- a/rt/t/shredder/02group_member.t
+++ /dev/null
@@ -1,103 +0,0 @@
-#!/usr/bin/perl -w
-
-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();
-
-
-### nested membership check
-{
- create_savepoint('clean');
- my $pgroup = RT::Group->new( $RT::SystemUser );
- my ($pgid) = $pgroup->CreateUserDefinedGroup( Name => 'Parent group' );
- ok( $pgid, "created parent group" );
- is( $pgroup->id, $pgid, "id is correct" );
-
- my $cgroup = RT::Group->new( $RT::SystemUser );
- my ($cgid) = $cgroup->CreateUserDefinedGroup( Name => 'Child group' );
- ok( $cgid, "created child group" );
- is( $cgroup->id, $cgid, "id is correct" );
-
- my ($status, $msg) = $pgroup->AddMember( $cgroup->id );
- ok( $status, "added child group to parent") or diag "error: $msg";
-
- 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
- ($status, $msg) = $cgroup->AddMember( $user->id );
- ok( $status, "added user to child group") or diag "error: $msg";
-
- my $members = RT::GroupMembers->new( $RT::SystemUser );
- $members->Limit( FIELD => 'MemberId', VALUE => $uid );
- $members->Limit( FIELD => 'GroupId', VALUE => $cgid );
- is( $members->Count, 1, "find membership record" );
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $members );
- $shredder->WipeoutAll();
- cmp_deeply( 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");
-
- $shredder->PutObjects( Objects => [$pgroup, $cgroup] );
- $shredder->WipeoutAll();
- cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
-}
-
-### deleting member of the ticket Owner role group
-{
- restore_savepoint('clean');
-
- 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" );
-
- use RT::Queue;
- my $queue = new RT::Queue( $RT::SystemUser );
- $queue->Load('general');
- ok( $queue->id, "queue loaded succesfully" );
-
- $user->PrincipalObj->GrantRight( Right => 'OwnTicket', Object => $queue );
-
- use RT::Tickets;
- my $ticket = RT::Ticket->new( $RT::SystemUser );
- my ($id) = $ticket->Create( Subject => 'test', Queue => $queue->id );
- ok( $id, "created new ticket" );
- $ticket = RT::Ticket->new( $RT::SystemUser );
- my $status;
- ($status, $msg) = $ticket->Load( $id );
- ok( $id, "load ticket" ) or diag( "error: $msg" );
-
- ($status, $msg) = $ticket->SetOwner( $user->id );
- ok( $status, "owner successfuly set") or diag( "error: $msg" );
- is( $ticket->Owner, $user->id, "owner successfuly set") or diag( "error: $msg" );
-
- my $member = $ticket->OwnerGroup->MembersObj->First;
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $member );
- $shredder->WipeoutAll();
-
- $ticket = RT::Ticket->new( $RT::SystemUser );
- ($status, $msg) = $ticket->Load( $id );
- ok( $id, "load ticket" ) or diag( "error: $msg" );
- is( $ticket->Owner, $RT::Nobody->id, "owner switched back to nobody" );
- is( $ticket->OwnerGroup->MembersObj->First->MemberId, $RT::Nobody->id, "and owner role group member is nobody");
-}
diff --git a/rt/t/shredder/02queue.t b/rt/t/shredder/02queue.t
deleted file mode 100644
index 197cf63c8..000000000
--- a/rt/t/shredder/02queue.t
+++ /dev/null
@@ -1,125 +0,0 @@
-#!/usr/bin/perl -w
-
-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();
-
-
-diag 'simple queue' if $ENV{'TEST_VERBOSE'};
-{
- 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();
- $shredder->PutObjects( Objects => $queue );
- $shredder->WipeoutAll;
- cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
-}
-
-diag 'queue with scrip' if $ENV{'TEST_VERBOSE'};
-{
- 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 $scrip = RT::Scrip->new( $RT::SystemUser );
- ($id, $msg) = $scrip->Create(
- Description => 'my scrip',
- Queue => $queue->id,
- ScripCondition => 'On Create',
- ScripAction => 'Open Tickets',
- Template => 'Blank',
- );
- ok($id, 'created scrip') or diag "error: $msg";
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $queue );
- $shredder->WipeoutAll;
- cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
-}
-
-diag 'queue with template' if $ENV{'TEST_VERBOSE'};
-{
- 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 $template = RT::Template->new( $RT::SystemUser );
- ($id, $msg) = $template->Create(
- Name => 'my template',
- Queue => $queue->id,
- Content => "\nsome content",
- );
- ok($id, 'created template') or diag "error: $msg";
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $queue );
- $shredder->WipeoutAll;
- cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
-}
-
-diag 'queue with a right granted' if $ENV{'TEST_VERBOSE'};
-{
- 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 $group = RT::Group->new( $RT::SystemUser );
- $group->LoadSystemInternalGroup('Everyone');
- ok($group->id, 'loaded group');
-
- ($id, $msg) = $group->PrincipalObj->GrantRight(
- Right => 'CreateTicket',
- Object => $queue,
- );
- ok($id, 'granted right') or diag "error: $msg";
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $queue );
- $shredder->WipeoutAll;
- cmp_deeply( 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');
- 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');
- my $queue = RT::Queue->new( $RT::SystemUser );
- ($id, $msg) = $queue->Create( Name => 'my queue' );
- ok($id, 'created queue') or diag "error: $msg";
-
- ($id, $msg) = $queue->AddWatcher(
- Type => 'Cc',
- PrincipalId => $group->id,
- );
- ok($id, 'added watcher') or diag "error: $msg";
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $queue );
- $shredder->WipeoutAll;
- cmp_deeply( 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");
-}
diff --git a/rt/t/shredder/02template.t b/rt/t/shredder/02template.t
deleted file mode 100644
index d4c323e09..000000000
--- a/rt/t/shredder/02template.t
+++ /dev/null
@@ -1,76 +0,0 @@
-#!/usr/bin/perl -w
-
-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();
-
-
-diag 'global template' if $ENV{'TEST_VERBOSE'};
-{
- create_savepoint('clean');
- my $template = RT::Template->new( $RT::SystemUser );
- my ($id, $msg) = $template->Create(
- Name => 'my template',
- Content => "\nsome content",
- );
- ok($id, 'created template') or diag "error: $msg";
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $template );
- $shredder->WipeoutAll;
- cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
-}
-
-diag 'local template' if $ENV{'TEST_VERBOSE'};
-{
- create_savepoint('clean');
- my $template = RT::Template->new( $RT::SystemUser );
- my ($id, $msg) = $template->Create(
- Name => 'my template',
- Queue => 'General',
- Content => "\nsome content",
- );
- ok($id, 'created template') or diag "error: $msg";
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $template );
- $shredder->WipeoutAll;
- cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
-}
-
-diag 'template used in scrip' if $ENV{'TEST_VERBOSE'};
-{
- create_savepoint('clean');
- my $template = RT::Template->new( $RT::SystemUser );
- my ($id, $msg) = $template->Create(
- Name => 'my template',
- Queue => 'General',
- Content => "\nsome content",
- );
- ok($id, 'created template') or diag "error: $msg";
-
- my $scrip = RT::Scrip->new( $RT::SystemUser );
- ($id, $msg) = $scrip->Create(
- Description => 'my scrip',
- Queue => 'General',
- ScripCondition => 'On Create',
- ScripAction => 'Open Tickets',
- Template => $template->id,
- );
- ok($id, 'created scrip') or diag "error: $msg";
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => $template );
- $shredder->WipeoutAll;
- cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
-}
diff --git a/rt/t/shredder/02user.t b/rt/t/shredder/02user.t
deleted file mode 100644
index 03abd6c69..000000000
--- a/rt/t/shredder/02user.t
+++ /dev/null
@@ -1,62 +0,0 @@
-#!/usr/bin/perl -w
-
-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();
-
-
-create_savepoint('clean');
-
-my $queue = RT::Queue->new( $RT::SystemUser );
-my ($qid) = $queue->Load( 'General' );
-ok( $qid, "loaded queue" );
-
-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
-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
-
-{
- my $resolver = sub {
- my %args = (@_);
- my $t = $args{'TargetObject'};
- my $resolver_uid = $RT::SystemUser->id;
- foreach my $method ( qw(Creator LastUpdatedBy) ) {
- next unless $t->_Accessible( $method => 'read' );
- $t->__Set( Field => $method, Value => $resolver_uid );
- }
- };
- my $shredder = 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");
-}
-
-{
- restore_savepoint('aucreate');
- my $user = RT::User->new( $RT::SystemUser );
- $user->Load($uid);
- ok($user->id, "loaded user after restore");
- my $shredder = 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");
-}
diff --git a/rt/t/shredder/03plugin.t b/rt/t/shredder/03plugin.t
deleted file mode 100644
index 190f40acf..000000000
--- a/rt/t/shredder/03plugin.t
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/usr/bin/perl -w
-
-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;
-}
-
-my @PLUGINS = sort qw(Attachments Base Objects SQLDump Summary Tickets Users);
-
-use_ok('RT::Shredder::Plugin');
-{
- my $plugin = new RT::Shredder::Plugin;
- isa_ok($plugin, 'RT::Shredder::Plugin');
- my %plugins = $plugin->List;
- cmp_deeply( [sort keys %plugins], [@PLUGINS], "correct plugins" );
-}
-{ # test ->List as class method
- my %plugins = RT::Shredder::Plugin->List;
- cmp_deeply( [sort keys %plugins], [@PLUGINS], "correct plugins" );
-}
-{ # reblessing on LoadByName
- foreach (@PLUGINS) {
- my $plugin = new RT::Shredder::Plugin;
- isa_ok($plugin, 'RT::Shredder::Plugin');
- my ($status, $msg) = $plugin->LoadByName( $_ );
- ok($status, "loaded plugin by name") or diag("error: $msg");
- isa_ok($plugin, "RT::Shredder::Plugin::$_" );
- }
-}
-{ # error checking in LoadByName
- my $plugin = new RT::Shredder::Plugin;
- isa_ok($plugin, 'RT::Shredder::Plugin');
- my ($status, $msg) = $plugin->LoadByName;
- ok(!$status, "not loaded plugin - empty name");
- ($status, $msg) = $plugin->LoadByName('Foo');
- ok(!$status, "not loaded plugin - not exist");
-}
-
diff --git a/rt/t/shredder/03plugin_summary.t b/rt/t/shredder/03plugin_summary.t
deleted file mode 100644
index 30606af41..000000000
--- a/rt/t/shredder/03plugin_summary.t
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-
-use Test::Deep;
-use File::Spec;
-use Test::More tests => 4;
-use RT::Test ();
-BEGIN {
- my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
- File::Spec->curdir());
- require $shredder_utils;
-}
-
-
-use_ok('RT::Shredder::Plugin');
-my $plugin_obj = new RT::Shredder::Plugin;
-isa_ok($plugin_obj, 'RT::Shredder::Plugin');
-my ($status, $msg) = $plugin_obj->LoadByName('Summary');
-ok($status, 'loaded summary plugin') or diag "error: $msg";
-isa_ok($plugin_obj, 'RT::Shredder::Plugin::Summary');
-
diff --git a/rt/t/shredder/03plugin_tickets.t b/rt/t/shredder/03plugin_tickets.t
deleted file mode 100644
index 3d742ff83..000000000
--- a/rt/t/shredder/03plugin_tickets.t
+++ /dev/null
@@ -1,150 +0,0 @@
-#!/usr/bin/perl -w
-
-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_ok('RT::Shredder::Plugin::Tickets');
-{
- my $plugin = new RT::Shredder::Plugin::Tickets;
- isa_ok($plugin, 'RT::Shredder::Plugin::Tickets');
-
- is(lc $plugin->Type, 'search', 'correct type');
-}
-
-init_db();
-create_savepoint('clean');
-use_ok('RT::Ticket');
-use_ok('RT::Tickets');
-
-{ # create parent and child and check functionality of 'with_linked' arg
- my $parent = RT::Ticket->new( $RT::SystemUser );
- my ($pid) = $parent->Create( Subject => 'parent', Queue => 1 );
- ok( $pid, "created new ticket" );
-
- my $child = RT::Ticket->new( $RT::SystemUser );
- my ($cid) = $child->Create( Subject => 'child', Queue => 1, MemberOf => $pid );
- ok( $cid, "created new ticket" );
-
- my $plugin = new RT::Shredder::Plugin::Tickets;
- isa_ok($plugin, 'RT::Shredder::Plugin::Tickets');
-
- my ($status, $msg, @objs);
- ($status, $msg) = $plugin->TestArgs( query => 'Subject = "parent"' );
- ok($status, "plugin arguments are ok") or diag "error: $msg";
-
- ($status, @objs) = $plugin->Run;
- ok($status, "executed plugin successfully") or diag "error: @objs";
- @objs = RT::Shredder->CastObjectsToRecords( Objects => \@objs );
- is(scalar @objs, 1, "only one object in result set");
- is($objs[0]->id, $pid, "parent is in result set");
-
- ($status, $msg) = $plugin->TestArgs( query => 'Subject = "parent"', with_linked => 1 );
- ok($status, "plugin arguments are ok") or diag "error: $msg";
-
- ($status, @objs) = $plugin->Run;
- ok($status, "executed plugin successfully") or diag "error: @objs";
- @objs = RT::Shredder->CastObjectsToRecords( Objects => \@objs );
- my %has = map { $_->id => 1 } @objs;
- is(scalar @objs, 2, "two objects in the result set");
- ok($has{$pid}, "parent is in the result set");
- ok($has{$cid}, "child is in the result set");
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => \@objs );
- $shredder->WipeoutAll;
-}
-cmp_deeply( 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 );
- my ($pid) = $parent->Create( Subject => 'parent', Queue => 1 );
- ok( $pid, "created new ticket" );
-
- my $child = RT::Ticket->new( $RT::SystemUser );
- my ($cid) = $child->Create( Subject => 'child', Queue => 1, MemberOf => $pid );
- ok( $cid, "created new ticket" );
-
- my ($status, $msg) = $child->AddLink( Target => $pid, Type => 'DependsOn' );
- ok($status, "added reqursive link") or diag "error: $msg";
-
- my $plugin = new RT::Shredder::Plugin::Tickets;
- isa_ok($plugin, 'RT::Shredder::Plugin::Tickets');
-
- my (@objs);
- ($status, $msg) = $plugin->TestArgs( query => 'Subject = "parent"' );
- ok($status, "plugin arguments are ok") or diag "error: $msg";
-
- ($status, @objs) = $plugin->Run;
- ok($status, "executed plugin successfully") or diag "error: @objs";
- @objs = RT::Shredder->CastObjectsToRecords( Objects => \@objs );
- is(scalar @objs, 1, "only one object in result set");
- is($objs[0]->id, $pid, "parent is in result set");
-
- ($status, $msg) = $plugin->TestArgs( query => 'Subject = "parent"', with_linked => 1 );
- ok($status, "plugin arguments are ok") or diag "error: $msg";
-
- ($status, @objs) = $plugin->Run;
- ok($status, "executed plugin successfully") or diag "error: @objs";
- @objs = RT::Shredder->CastObjectsToRecords( Objects => \@objs );
- is(scalar @objs, 2, "two objects in the result set");
- my %has = map { $_->id => 1 } @objs;
- ok($has{$pid}, "parent is in the result set");
- ok($has{$cid}, "child is in the result set");
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => \@objs );
- $shredder->WipeoutAll;
-}
-cmp_deeply( 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 );
- my ($pid) = $parent->Create( Subject => 'parent', Queue => 1, Status => 'resolved' );
- ok( $pid, "created new ticket" );
-
- my $child1 = RT::Ticket->new( $RT::SystemUser );
- my ($cid1) = $child1->Create( Subject => 'child', Queue => 1, MemberOf => $pid );
- ok( $cid1, "created new ticket" );
- my $child2 = RT::Ticket->new( $RT::SystemUser );
- my ($cid2) = $child2->Create( Subject => 'child', Queue => 1, MemberOf => $pid, Status => 'resolved' );
- ok( $cid2, "created new ticket" );
-
- my $plugin = new RT::Shredder::Plugin::Tickets;
- isa_ok($plugin, 'RT::Shredder::Plugin::Tickets');
-
- my ($status, $msg) = $plugin->TestArgs( query => 'Status = "resolved"', apply_query_to_linked => 1 );
- ok($status, "plugin arguments are ok") or diag "error: $msg";
-
- my @objs;
- ($status, @objs) = $plugin->Run;
- ok($status, "executed plugin successfully") or diag "error: @objs";
- @objs = RT::Shredder->CastObjectsToRecords( Objects => \@objs );
- is(scalar @objs, 2, "two objects in the result set");
- my %has = map { $_->id => 1 } @objs;
- ok($has{$pid}, "parent is in the result set");
- ok(!$has{$cid1}, "first child is in the result set");
- ok($has{$cid2}, "second child is in the result set");
-
- my $shredder = shredder_new();
- $shredder->PutObjects( Objects => \@objs );
- $shredder->WipeoutAll;
-
- my $ticket = RT::Ticket->new( $RT::SystemUser );
- $ticket->Load( $cid1 );
- is($ticket->id, $cid1, 'loaded ticket');
-
- $shredder->PutObjects( Objects => $ticket );
- $shredder->WipeoutAll;
-}
-cmp_deeply( dump_current_and_savepoint('clean'), "current DB equal to savepoint");
diff --git a/rt/t/shredder/03plugin_users.t b/rt/t/shredder/03plugin_users.t
deleted file mode 100644
index 45fc8a27e..000000000
--- a/rt/t/shredder/03plugin_users.t
+++ /dev/null
@@ -1,40 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-
-use Test::Deep;
-use File::Spec;
-use Test::More tests => 9;
-use RT::Test ();
-BEGIN {
- my $shredder_utils = RT::Test::get_relocatable_file('utils.pl',
- File::Spec->curdir());
- require $shredder_utils;
-}
-
-
-my @ARGS = sort qw(limit status name member_of email replace_relations no_tickets);
-
-use_ok('RT::Shredder::Plugin::Users');
-{
- my $plugin = new RT::Shredder::Plugin::Users;
- isa_ok($plugin, 'RT::Shredder::Plugin::Users');
-
- is(lc $plugin->Type, 'search', 'correct type');
-
- my @args = sort $plugin->SupportArgs;
- cmp_deeply(\@args, \@ARGS, "support all args");
-
-
- my ($status, $msg) = $plugin->TestArgs( name => 'r??t*' );
- ok($status, "arg name = 'r??t*'") or diag("error: $msg");
-
- for (qw(any disabled enabled)) {
- my ($status, $msg) = $plugin->TestArgs( status => $_ );
- ok($status, "arg status = '$_'") or diag("error: $msg");
- }
- ($status, $msg) = $plugin->TestArgs( status => '!@#' );
- ok(!$status, "bad 'status' arg value");
-}
-
diff --git a/rt/t/shredder/utils.pl b/rt/t/shredder/utils.pl
deleted file mode 100644
index 54243318e..000000000
--- a/rt/t/shredder/utils.pl
+++ /dev/null
@@ -1,435 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use File::Temp 0.19 ();
-require File::Path;
-require File::Copy;
-require Cwd;
-
-BEGIN {
-### after: push @INC, qw(@RT_LIB_PATH@);
- push @INC, qw(/opt/rt3/local/lib /opt/rt3/lib);
-}
-use RT::Shredder;
-
-# where to keep temporary generated test data
-my $tmpdir = '';
-
-=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.
-
-=head1 FUNCTIONS
-
-=head2 RT CONFIG
-
-=head3 rewrite_rtconfig
-
-Call this sub after C<RT::LoadConfig>. It changes the RT config
-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( '$LogToScreen' , 'error' );
- config_set( '$LogStackTraces' , 'crit' );
- # logging to standalone file
- config_set( '$LogToFile' , 'debug' );
- my $fname = File::Spec->catfile(create_tmpdir(), test_name() .".log");
- config_set( '$LogToFileNamed' , $fname );
-}
-
-=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.
-
-=cut
-
-sub config_set {
- my $opt = shift;
- $opt =~ s/^[\$\%\@]//;
- RT->Config->Set($opt, @_)
-}
-
-=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
-{
- create_tmpdir();
- 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 <$tmpdir . test_name() .'.db'>.
-
-See also the C<test_name> function.
-
-=cut
-
-sub db_name { return File::Spec->catfile(create_tmpdir(), test_name() .".db") }
-
-=head3 connect_sqlite
-
-Returns connected DBI DB handle.
-
-Takes path to sqlite db.
-
-=cut
-
-sub connect_sqlite
-{
- 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 $obj = new RT::Shredder;
-
- my $file = File::Spec->catfile( create_tmpdir(), test_name() .'.XXXX.sql' );
- $obj->AddDumpPlugin( Arguments => {
- file_name => $file,
- from_storage => 0,
- } );
-
- return $obj;
-}
-
-
-=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 TEMPORARY DIRECTORY
-
-=head3 tmpdir
-
-Returns the absolute path to a tmp dir used in tests.
-
-=cut
-
-sub tmpdir {
- if (-d $tmpdir) {
- return $tmpdir;
- } else {
- $tmpdir = File::Temp->newdir(TEMPLATE => 'shredderXXXXX', CLEANUP => 0);
- return $tmpdir;
- }
-}
-
-=head2 create_tmpdir
-
-Creates a tmp dir if one doesn't exist already. Returns tmpdir path.
-
-=cut
-
-sub create_tmpdir { my $n = tmpdir(); File::Path::mkpath( [$n] ); return $n }
-
-=head3 cleanup_tmp
-
-Deletes all the tmp dir used in the tests.
-See also the C<test_name> function.
-
-=cut
-
-sub cleanup_tmp
-{
- my $dir = File::Spec->catdir(tmpdir(), test_name());
- return File::Path::rmtree( File::Spec->catdir( tmpdir(), test_name() ));
-}
-
-=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 $name = shift || 'sp';
- return File::Spec->catfile( create_tmpdir(), test_name() .".$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 { return __cp_db( db_name() => savepoint_name( shift ) ) }
-sub restore_savepoint { return __cp_db( savepoint_name( shift ) => db_name() ) }
-sub __cp_db
-{
- my( $orig, $dest ) = @_;
- $RT::Handle->dbh->disconnect;
- # DIRTY HACK: undef Handles to force reconnect
- $RT::Handle = undef;
- %DBIx::SearchBuilder::DBIHandle = ();
- $DBIx::SearchBuilder::PrevHandle = undef;
-
- File::Copy::copy( $orig, $dest ) or die "Couldn't copy '$orig' => '$dest': $!";
- RT::ConnectToDatabase();
- 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 $dbh = shift;
- my %args = ( CleanDates => 1, @_ );
-
- my $old_fhkn = $dbh->{'FetchHashKeyName'};
- $dbh->{'FetchHashKeyName'} = 'NAME_lc';
-
- my $sth = $dbh->table_info( '', '', '%', 'TABLE' ) || die $DBI::err;
- my @tables = keys %{$sth->fetchall_hashref( 'table_name' )};
-
- my $res = {};
- foreach my $t( @tables ) {
- next if lc($t) eq 'sessions';
- $res->{$t} = $dbh->selectall_hashref("SELECT * FROM $t", 'id');
- clean_dates( $res->{$t} ) if $args{'CleanDates'};
- die $DBI::err if $DBI::err;
- }
-
- $dbh->{'FetchHashKeyName'} = $old_fhkn;
- return $res;
-}
-
-=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 $orig = 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, @_ ) );
-}
-
-=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 dump_current_and_savepoint(@_) }
-
-sub clean_dates
-{
- 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/;
- }
- }
-}
-
-=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 = tmpdir();
- 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
-}
-
-=head2 OTHER
-
-=head3 all_were_successful
-
-Returns true if all tests that have already run were successful.
-
-=cut
-
-sub all_were_successful
-{
- use Test::Builder;
- my $Test = Test::Builder->new;
- return grep( !$_, $Test->summary )? 0: 1;
-}
-
-END {
- return unless -e tmpdir();
- if ( all_were_successful() ) {
- cleanup_tmp();
- } else {
- diag( note_on_fail() );
- }
-}
-
-1;
generated by cgit v1.2.1 (git 2.18.0) at 2024-09-22 23:42:51 +0000