summaryrefslogtreecommitdiff
path: root/rt/lib/RT/Shredder.pm
diff options
context:
space:
mode:
Diffstat (limited to 'rt/lib/RT/Shredder.pm')
-rw-r--r--rt/lib/RT/Shredder.pm868
1 files changed, 0 insertions, 868 deletions
diff --git a/rt/lib/RT/Shredder.pm b/rt/lib/RT/Shredder.pm
deleted file mode 100644
index 5e1e86ecf..000000000
--- a/rt/lib/RT/Shredder.pm
+++ /dev/null
@@ -1,868 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-# <jesse@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 }}}
-
-package RT::Shredder;
-
-use strict;
-use warnings;
-
-
-=head1 NAME
-
-RT::Shredder - Permanently wipeout data from RT
-
-
-=head1 SYNOPSIS
-
-=head2 CLI
-
- rt-shredder --force --plugin 'Tickets=queue,general;status,deleted'
-
-
-=head1 DESCRIPTION
-
-RT::Shredder is extension to RT which allows you to permanently wipeout
-data from the RT database. Shredder supports the wiping of almost
-all RT objects (Tickets, Transactions, Attachments, Users...).
-
-
-=head2 "Delete" vs "Wipeout"
-
-RT uses the term "delete" to mean "deactivate". To avoid confusion,
-RT::Shredder uses the term "Wipeout" to mean "permanently erase" (or
-what most people would think of as "delete").
-
-
-=head2 Why do you want this?
-
-Normally in RT, "deleting" an item simply deactivates it and makes it
-invisible from view. This is done to retain full history and
-auditability of your tickets. For most RT users this is fine and they
-have no need of RT::Shredder.
-
-But in some large and heavily used RT instances the database can get
-clogged up with junk, particularly spam. This can slow down searches
-and bloat the size of the database. For these users, RT::Shredder
-allows them to completely clear the database of this unwanted junk.
-
-An additional use of Shredder is to obliterate sensitive information
-(passwords, credit card numbers, ...) which might have made their way
-into RT.
-
-
-=head2 Command line tools (CLI)
-
-L<rt-shredder> is a program which allows you to wipe objects from
-command line or with system tasks scheduler (cron, for example).
-See also 'rt-shredder --help'.
-
-
-=head2 Web based interface (WebUI)
-
-Shredder's WebUI integrates into RT's WebUI. You can find it in the
-Configuration->Tools->Shredder tab. The interface is similar to the
-CLI and gives you the same functionality. You can find 'Shredder' link
-at the bottom of tickets search results, so you could wipeout tickets
-in the way similar to the bulk update.
-
-
-=head1 DATA STORAGE AND BACKUPS
-
-Shredder allows you to store data you wiped in files as scripts with SQL
-commands.
-
-=head3 Restoring from backup
-
-Should you wipeout something you did not intend to the objects can be
-restored by using the storage files. These files are a simple set of
-SQL commands to re-insert your objects into the RT database.
-
-1) Locate the appropriate shredder SQL dump file. In the WebUI, when
- you use shredder, the path to the dump file is displayed. It also
- gives the option to download the dump file after each wipeout. Or
- it can be found in your C<$ShredderStoragePath>.
-
-2) Load the shredder SQL dump into your RT database. The details will
- be different for each database and RT configuration, consult your
- database manual and RT config. For example, in MySQL...
-
- mysql -u your_rt_user -p your_rt_database < /path/to/rt/var/data/shredder/dump.sql
-
-That's it.i This will restore everything you'd deleted during a
-shredding session when the file had been created.
-
-=head1 CONFIGURATION
-
-=head2 $RT::DependenciesLimit
-
-Shredder stops with an error if the object has more than
-C<$RT::DependenciesLimit> dependencies. For example: a ticket has 1000
-transactions or a transaction has 1000 attachments. This is protection
-from bugs in shredder from wiping out your whole database, but
-sometimes when you have big mail loops you may hit it.
-
-Defaults to 1000.
-
-You can change the default value, in F<RT_SiteConfig.pm> add C<Set(
-$DependenciesLimit, new_limit );>
-
-
-=head2 $ShredderStoragePath
-
-Directory containing Shredder backup dumps.
-
-Defaults to F</path-to-RT-var-dir/data/RT-Shredder>.
-
-You can change the default value, in F<RT_SiteConfig.pm> add C<Set(
-$ShredderStoragePath, new_path );> Be sure to use an absolute path.
-
-
-=head1 INFORMATION FOR DEVELOPERS
-
-=head2 General API
-
-L<RT::Shredder> is an extension to RT which adds shredder methods to
-RT objects and classes. The API is not well documented yet, but you
-can find usage examples in L<rt-shredder> and the
-F<lib/t/regression/shredder/*.t> test files.
-
-However, here is a small example that do the same action as in CLI
-example from L</SYNOPSIS>:
-
- use RT::Shredder;
- RT::Shredder::Init( force => 1 );
- my $deleted = RT::Tickets->new( $RT::SystemUser );
- $deleted->{'allow_deleted_search'} = 1;
- $deleted->LimitQueue( VALUE => 'general' );
- $deleted->LimitStatus( VALUE => 'deleted' );
- while( my $t = $deleted->Next ) {
- $t->Wipeout;
- }
-
-
-=head2 RT::Shredder class' API
-
-L<RT::Shredder> implements interfaces to objects cache, actions on the
-objects in the cache and backups storage.
-
-=cut
-
-our $VERSION = '0.04';
-use File::Spec ();
-
-
-BEGIN {
-# I can't use 'use lib' here since it breakes tests
-# because test suite uses old RT::Shredder setup from
-# RT lib path
-
-### after: push @INC, qw(@RT_LIB_PATH@);
- push @INC, qw(/opt/rt3/local/lib /opt/rt3/lib);
- use RT::Shredder::Constants;
- use RT::Shredder::Exceptions;
-
- require RT;
-
- require RT::Shredder::Record;
-
- require RT::Shredder::ACE;
- require RT::Shredder::Attachment;
- require RT::Shredder::CachedGroupMember;
- require RT::Shredder::CustomField;
- require RT::Shredder::CustomFieldValue;
- require RT::Shredder::GroupMember;
- require RT::Shredder::Group;
- require RT::Shredder::Link;
- require RT::Shredder::Principal;
- require RT::Shredder::Queue;
- require RT::Shredder::Scrip;
- require RT::Shredder::ScripAction;
- require RT::Shredder::ScripCondition;
- require RT::Shredder::Template;
- require RT::Shredder::ObjectCustomFieldValue;
- require RT::Shredder::Ticket;
- require RT::Shredder::Transaction;
- require RT::Shredder::User;
-}
-
-our @SUPPORTED_OBJECTS = qw(
- ACE
- Attachment
- CachedGroupMember
- CustomField
- CustomFieldValue
- GroupMember
- Group
- Link
- Principal
- Queue
- Scrip
- ScripAction
- ScripCondition
- Template
- ObjectCustomFieldValue
- Ticket
- Transaction
- User
-);
-
-=head3 GENERIC
-
-=head4 Init
-
- RT::Shredder::Init( %default_options );
-
-C<RT::Shredder::Init()> should be called before creating an
-RT::Shredder object. It iniitalizes RT and loads the RT
-configuration.
-
-%default_options are passed to every C<<RT::Shredder->new>> call.
-
-=cut
-
-our %opt = ();
-
-sub Init
-{
- %opt = @_;
- RT::LoadConfig();
- RT::Init();
-}
-
-=head4 new
-
- my $shredder = RT::Shredder->new(%options);
-
-Construct a new RT::Shredder object.
-
-There currently are no %options.
-
-=cut
-
-sub new
-{
- my $proto = shift;
- my $self = bless( {}, ref $proto || $proto );
- $self->_Init( @_ );
- return $self;
-}
-
-sub _Init
-{
- my $self = shift;
- $self->{'opt'} = { %opt, @_ };
- $self->{'cache'} = {};
- $self->{'resolver'} = {};
- $self->{'dump_plugins'} = [];
-}
-
-=head4 CastObjectsToRecords( Objects => undef )
-
-Cast objects to the C<RT::Record> objects or its ancesstors.
-Objects can be passed as SCALAR (format C<< <class>-<id> >>),
-ARRAY, C<RT::Record> ancesstors or C<RT::SearchBuilder> ancesstor.
-
-Most methods that takes C<Objects> argument use this method to
-cast argument value to list of records.
-
-Returns an array of records.
-
-For example:
-
- my @objs = $shredder->CastObjectsToRecords(
- Objects => [ # ARRAY reference
- 'RT::Attachment-10', # SCALAR or SCALAR reference
- $tickets, # RT::Tickets object (isa RT::SearchBuilder)
- $user, # RT::User object (isa RT::Record)
- ],
- );
-
-=cut
-
-sub CastObjectsToRecords
-{
- my $self = shift;
- my %args = ( Objects => undef, @_ );
-
- my @res;
- my $targets = delete $args{'Objects'};
- unless( $targets ) {
- RT::Shredder::Exception->throw( "Undefined Objects argument" );
- }
-
- if( UNIVERSAL::isa( $targets, 'RT::SearchBuilder' ) ) {
- #XXX: try to use ->_DoSearch + ->ItemsArrayRef in feature
- # like we do in Record with links, but change only when
- # more tests would be available
- while( my $tmp = $targets->Next ) { push @res, $tmp };
- } elsif ( UNIVERSAL::isa( $targets, 'RT::Record' ) ) {
- push @res, $targets;
- } elsif ( UNIVERSAL::isa( $targets, 'ARRAY' ) ) {
- foreach( @$targets ) {
- push @res, $self->CastObjectsToRecords( Objects => $_ );
- }
- } elsif ( UNIVERSAL::isa( $targets, 'SCALAR' ) || !ref $targets ) {
- $targets = $$targets if ref $targets;
- my ($class, $id) = split /-/, $targets;
- $class = 'RT::'. $class unless $class =~ /^RTx?::/i;
- eval "require $class";
- die "Couldn't load '$class' module" if $@;
- my $obj = $class->new( $RT::SystemUser );
- die "Couldn't construct new '$class' object" unless $obj;
- $obj->Load( $id );
- unless ( $obj->id ) {
- $RT::Logger->error( "Couldn't load '$class' object with id '$id'" );
- RT::Shredder::Exception::Info->throw( 'CouldntLoadObject' );
- }
- die "Loaded object has different id" unless( $id eq $obj->id );
- push @res, $obj;
- } else {
- RT::Shredder::Exception->throw( "Unsupported type ". ref $targets );
- }
- return @res;
-}
-
-=head3 OBJECTS CACHE
-
-=head4 PutObjects( Objects => undef )
-
-Puts objects into cache.
-
-Returns array of the cache entries.
-
-See C<CastObjectsToRecords> method for supported types of the C<Objects>
-argument.
-
-=cut
-
-sub PutObjects
-{
- my $self = shift;
- my %args = ( Objects => undef, @_ );
-
- my @res;
- for( $self->CastObjectsToRecords( Objects => delete $args{'Objects'} ) ) {
- push @res, $self->PutObject( %args, Object => $_ )
- }
-
- return @res;
-}
-
-=head4 PutObject( Object => undef )
-
-Puts record object into cache and returns its cache entry.
-
-B<NOTE> that this method support B<only C<RT::Record> object or its ancesstor
-objects>, if you want put mutliple objects or objects represented by different
-classes then use C<PutObjects> method instead.
-
-=cut
-
-sub PutObject
-{
- my $self = shift;
- my %args = ( Object => undef, @_ );
-
- my $obj = $args{'Object'};
- unless( UNIVERSAL::isa( $obj, 'RT::Record' ) ) {
- RT::Shredder::Exception->throw( "Unsupported type '". (ref $obj || $obj || '(undef)')."'" );
- }
-
- my $str = $obj->_AsString;
- return ($self->{'cache'}->{ $str } ||= { State => ON_STACK, Object => $obj } );
-}
-
-=head4 GetObject, GetState, GetRecord( String => ''| Object => '' )
-
-Returns record object from cache, cache entry state or cache entry accordingly.
-
-All three methods takes C<String> (format C<< <class>-<id> >>) or C<Object> argument.
-C<String> argument has more priority than C<Object> so if it's not empty then methods
-leave C<Object> argument unchecked.
-
-You can read about possible states and their meanings in L<RT::Shredder::Constants> docs.
-
-=cut
-
-sub _ParseRefStrArgs
-{
- my $self = shift;
- my %args = (
- String => '',
- Object => undef,
- @_
- );
- if( $args{'String'} && $args{'Object'} ) {
- require Carp;
- Carp::croak( "both String and Object args passed" );
- }
- return $args{'String'} if $args{'String'};
- return $args{'Object'}->_AsString if UNIVERSAL::can($args{'Object'}, '_AsString' );
- return '';
-}
-
-sub GetObject { return (shift)->GetRecord( @_ )->{'Object'} }
-sub GetState { return (shift)->GetRecord( @_ )->{'State'} }
-sub GetRecord
-{
- my $self = shift;
- my $str = $self->_ParseRefStrArgs( @_ );
- return $self->{'cache'}->{ $str };
-}
-
-=head3 Dependencies resolvers
-
-=head4 PutResolver, GetResolvers and ApplyResolvers
-
-TODO: These methods have no documentation.
-
-=cut
-
-sub PutResolver
-{
- my $self = shift;
- my %args = (
- BaseClass => '',
- TargetClass => '',
- Code => undef,
- @_,
- );
- unless( UNIVERSAL::isa( $args{'Code'} => 'CODE' ) ) {
- die "Resolver '$args{Code}' is not code reference";
- }
-
- my $resolvers = (
- (
- $self->{'resolver'}->{ $args{'BaseClass'} } ||= {}
- )->{ $args{'TargetClass'} || '' } ||= []
- );
- unshift @$resolvers, $args{'Code'};
- return;
-}
-
-sub GetResolvers
-{
- my $self = shift;
- my %args = (
- BaseClass => '',
- TargetClass => '',
- @_,
- );
-
- my @res;
- if( $args{'TargetClass'} && exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} } ) {
- push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} || '' } };
- }
- if( exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ '' } ) {
- push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{''} };
- }
-
- return @res;
-}
-
-sub ApplyResolvers
-{
- my $self = shift;
- my %args = ( Dependency => undef, @_ );
- my $dep = $args{'Dependency'};
-
- my @resolvers = $self->GetResolvers(
- BaseClass => $dep->BaseClass,
- TargetClass => $dep->TargetClass,
- );
-
- unless( @resolvers ) {
- RT::Shredder::Exception::Info->throw(
- tag => 'NoResolver',
- error => "Couldn't find resolver for dependency '". $dep->AsString ."'",
- );
- }
- $_->(
- Shredder => $self,
- BaseObject => $dep->BaseObject,
- TargetObject => $dep->TargetObject,
- ) foreach @resolvers;
-
- return;
-}
-
-sub WipeoutAll
-{
- my $self = $_[0];
-
- while ( my ($k, $v) = each %{ $self->{'cache'} } ) {
- next if $v->{'State'} & (WIPED | IN_WIPING);
- $self->Wipeout( Object => $v->{'Object'} );
- }
-}
-
-sub Wipeout
-{
- my $self = shift;
- my $mark;
- eval {
- die "Couldn't begin transaction" unless $RT::Handle->BeginTransaction;
- $mark = $self->PushDumpMark or die "Couldn't get dump mark";
- $self->_Wipeout( @_ );
- $self->PopDumpMark( Mark => $mark );
- die "Couldn't commit transaction" unless $RT::Handle->Commit;
- };
- if( $@ ) {
- $RT::Handle->Rollback('force');
- $self->RollbackDumpTo( Mark => $mark ) if $mark;
- die $@ if RT::Shredder::Exception::Info->caught;
- die "Couldn't wipeout object: $@";
- }
-}
-
-sub _Wipeout
-{
- my $self = shift;
- my %args = ( CacheRecord => undef, Object => undef, @_ );
-
- my $record = $args{'CacheRecord'};
- $record = $self->PutObject( Object => $args{'Object'} ) unless $record;
- return if $record->{'State'} & (WIPED | IN_WIPING);
-
- $record->{'State'} |= IN_WIPING;
- my $object = $record->{'Object'};
-
- $self->DumpObject( Object => $object, State => 'before any action' );
-
- unless( $object->BeforeWipeout ) {
- RT::Shredder::Exception->throw( "BeforeWipeout check returned error" );
- }
-
- my $deps = $object->Dependencies( Shredder => $self );
- $deps->List(
- WithFlags => DEPENDS_ON | VARIABLE,
- Callback => sub { $self->ApplyResolvers( Dependency => $_[0] ) },
- );
- $self->DumpObject( Object => $object, State => 'after resolvers' );
-
- $deps->List(
- WithFlags => DEPENDS_ON,
- WithoutFlags => WIPE_AFTER | VARIABLE,
- Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
- );
- $self->DumpObject( Object => $object, State => 'after wiping dependencies' );
-
- $object->__Wipeout;
- $record->{'State'} |= WIPED; delete $record->{'Object'};
- $self->DumpObject( Object => $object, State => 'after wipeout' );
-
- $deps->List(
- WithFlags => DEPENDS_ON | WIPE_AFTER,
- WithoutFlags => VARIABLE,
- Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
- );
- $self->DumpObject( Object => $object, State => 'after late dependencies' );
-
- return;
-}
-
-sub ValidateRelations
-{
- my $self = shift;
- my %args = ( @_ );
-
- foreach my $record( values %{ $self->{'cache'} } ) {
- next if( $record->{'State'} & VALID );
- $record->{'Object'}->ValidateRelations( Shredder => $self );
- }
-}
-
-=head3 Data storage and backups
-
-=head4 GetFileName( FileName => '<ISO DATETIME>-XXXX.sql', FromStorage => 1 )
-
-Takes desired C<FileName> and flag C<FromStorage> then translate file name to absolute
-path by next rules:
-
-* Default value of the C<FileName> option is C<< <ISO DATETIME>-XXXX.sql >>;
-
-* if C<FileName> has C<XXXX> (exactly four uppercase C<X> letters) then it would be changed with digits from 0000 to 9999 range, with first one free value;
-
-* if C<FileName> has C<%T> then it would be replaced with the current date and time in the C<YYYY-MM-DDTHH:MM:SS> format. Note that using C<%t> may still generate not unique names, using C<XXXX> recomended.
-
-* if C<FromStorage> argument is true (default behaviour) then result path would always be relative to C<StoragePath>;
-
-* if C<FromStorage> argument is false then result would be relative to the current dir unless it's already absolute path.
-
-Returns an absolute path of the file.
-
-Examples:
- # file from storage with default name format
- my $fname = $shredder->GetFileName;
-
- # file from storage with custom name format
- my $fname = $shredder->GetFileName( FileName => 'shredder-XXXX.backup' );
-
- # file with path relative to the current dir
- my $fname = $shredder->GetFileName(
- FromStorage => 0,
- FileName => 'backups/shredder.sql',
- );
-
- # file with absolute path
- my $fname = $shredder->GetFileName(
- FromStorage => 0,
- FileName => '/var/backups/shredder-XXXX.sql'
- );
-
-=cut
-
-sub GetFileName
-{
- my $self = shift;
- my %args = ( FileName => '', FromStorage => 1, @_ );
-
- # default value
- my $file = $args{'FileName'} || '%t-XXXX.sql';
- if( $file =~ /\%t/i ) {
- require POSIX;
- my $date_time = POSIX::strftime( "%Y%m%dT%H%M%S", gmtime );
- $file =~ s/\%t/$date_time/gi;
- }
-
- # convert to absolute path
- if( $args{'FromStorage'} ) {
- $file = File::Spec->catfile( $self->StoragePath, $file );
- } elsif( !File::Spec->file_name_is_absolute( $file ) ) {
- $file = File::Spec->rel2abs( $file );
- }
-
- # check mask
- if( $file =~ /XXXX[^\/\\]*$/ ) {
- my( $tmp, $i ) = ( $file, 0 );
- do {
- $i++;
- $tmp = $file;
- $tmp =~ s/XXXX([^\/\\]*)$/sprintf("%04d", $i).$1/e;
- } while( -e $tmp && $i < 9999 );
- $file = $tmp;
- }
-
- if( -f $file ) {
- unless( -w _ ) {
- die "File '$file' exists, but is read-only";
- }
- } elsif( !-e _ ) {
- unless( File::Spec->file_name_is_absolute( $file ) ) {
- $file = File::Spec->rel2abs( $file );
- }
-
- # check base dir
- my $dir = File::Spec->join( (File::Spec->splitpath( $file ))[0,1] );
- unless( -e $dir && -d _) {
- die "Base directory '$dir' for file '$file' doesn't exist";
- }
- unless( -w $dir ) {
- die "Base directory '$dir' is not writable";
- }
- } else {
- die "'$file' is not regular file";
- }
-
- return $file;
-}
-
-=head4 StoragePath
-
-Returns an absolute path to the storage dir. See
-L<CONFIGURATION/$ShredderStoragePath>.
-
-See also description of the L</GetFileName> method.
-
-=cut
-
-sub StoragePath
-{
- return scalar( RT->Config->Get('ShredderStoragePath') )
- || File::Spec->catdir( $RT::VarPath, qw(data RT-Shredder) );
-}
-
-my %active_dump_state = ();
-sub AddDumpPlugin {
- my $self = shift;
- my %args = ( Object => undef, Name => 'SQLDump', Arguments => undef, @_ );
-
- my $plugin = $args{'Object'};
- unless ( $plugin ) {
- require RT::Shredder::Plugin;
- $plugin = RT::Shredder::Plugin->new;
- my( $status, $msg ) = $plugin->LoadByName( $args{'Name'} );
- die "Couldn't load dump plugin: $msg\n" unless $status;
- }
- die "Plugin is not of correct type" unless lc $plugin->Type eq 'dump';
-
- if ( my $pargs = $args{'Arguments'} ) {
- my ($status, $msg) = $plugin->TestArgs( %$pargs );
- die "Couldn't set plugin args: $msg\n" unless $status;
- }
-
- my @applies_to = $plugin->AppliesToStates;
- die "Plugin doesn't apply to any state" unless @applies_to;
- $active_dump_state{ lc $_ } = 1 foreach @applies_to;
-
- push @{ $self->{'dump_plugins'} }, $plugin;
-
- return $plugin;
-}
-
-sub DumpObject {
- my $self = shift;
- my %args = (Object => undef, State => undef, @_);
- die "No state passed" unless $args{'State'};
- return unless $active_dump_state{ lc $args{'State'} };
-
- foreach (@{ $self->{'dump_plugins'} }) {
- next unless grep lc $args{'State'} eq lc $_, $_->AppliesToStates;
- my ($state, $msg) = $_->Run( %args );
- die "Couldn't run plugin: $msg" unless $state;
- }
-}
-
-{ my $mark = 1; # XXX: integer overflows?
-sub PushDumpMark {
- my $self = shift;
- $mark++;
- foreach (@{ $self->{'dump_plugins'} }) {
- my ($state, $msg) = $_->PushMark( Mark => $mark );
- die "Couldn't push mark: $msg" unless $state;
- }
- return $mark;
-}
-sub PopDumpMark {
- my $self = shift;
- foreach (@{ $self->{'dump_plugins'} }) {
- my ($state, $msg) = $_->PushMark( @_ );
- die "Couldn't pop mark: $msg" unless $state;
- }
-}
-sub RollbackDumpTo {
- my $self = shift;
- foreach (@{ $self->{'dump_plugins'} }) {
- my ($state, $msg) = $_->RollbackTo( @_ );
- die "Couldn't rollback to mark: $msg" unless $state;
- }
-}
-}
-
-1;
-__END__
-
-=head1 NOTES
-
-=head2 Database transactions support
-
-Since 0.03_01 RT::Shredder uses database transactions and should be
-much safer to run on production servers.
-
-=head2 Foreign keys
-
-Mainstream RT doesn't use FKs, but at least I posted DDL script that creates them
-in mysql DB, note that if you use FKs then this two valid keys don't allow delete
-Tickets because of bug in MySQL:
-
- ALTER TABLE Tickets ADD FOREIGN KEY (EffectiveId) REFERENCES Tickets(id);
- ALTER TABLE CachedGroupMembers ADD FOREIGN KEY (Via) REFERENCES CachedGroupMembers(id);
-
-L<http://bugs.mysql.com/bug.php?id=4042>
-
-=head1 BUGS AND HOW TO CONTRIBUTE
-
-We need your feedback in all cases: if you use it or not,
-is it works for you or not.
-
-=head2 Testing
-
-Don't skip C<make test> step while install and send me reports if it's fails.
-Add your own tests, it's easy enough if you've writen at list one perl script
-that works with RT. Read more about testing in F<t/utils.pl>.
-
-=head2 Reporting
-
-Send reports to L</AUTHOR> or to the RT mailing lists.
-
-=head2 Documentation
-
-Many bugs in the docs: insanity, spelling, gramar and so on.
-Patches are wellcome.
-
-=head2 Todo
-
-Please, see Todo file, it has some technical notes
-about what I plan to do, when I'll do it, also it
-describes some problems code has.
-
-=head2 Repository
-
-Since RT-3.7 shredder is a part of the RT distribution.
-Versions of the RTx::Shredder extension could
-be downloaded from the CPAN. Those work with older
-RT versions or you can find repository at
-L<https://opensvn.csie.org/rtx_shredder>
-
-=head1 AUTHOR
-
- Ruslan U. Zakirov <Ruslan.Zakirov@gmail.com>
-
-=head1 COPYRIGHT
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-Perl distribution.
-
-=head1 SEE ALSO
-
-L<rt-shredder>, L<rt-validator>
-
-=cut
generated by cgit v1.2.1 (git 2.18.0) at 2024-12-28 18:29:47 +0000