rt 4.2.15
[freeside.git] / rt / lib / RT / Shredder.pm
index 5e1e86e..13ce0fb 100644 (file)
@@ -1,40 +1,40 @@
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
-# 
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
 # (Except where explicitly superseded by other copyright notices)
-# 
-# 
+#
+#
 # LICENSE:
-# 
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 # 02110-1301 or visit their web page on the internet at
 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-# 
-# 
+#
+#
 # CONTRIBUTION SUBMISSION POLICY:
-# 
+#
 # (The following paragraph is not intended to limit the rights granted
 # to you to modify and distribute this software under the terms of
 # the GNU General Public License and is only of importance to you if
 # you choose to contribute your changes and enhancements to the
 # community by submitting them to Best Practical Solutions, LLC.)
-# 
+#
 # By intentionally submitting any modifications, corrections or
 # derivatives to this work, or any other work intended for use with
 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
@@ -43,7 +43,7 @@
 # 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;
@@ -52,6 +52,7 @@ use strict;
 use warnings;
 
 
+
 =head1 NAME
 
 RT::Shredder - Permanently wipeout data from RT
@@ -61,8 +62,7 @@ RT::Shredder - Permanently wipeout data from RT
 
 =head2 CLI
 
-  rt-shredder --force --plugin 'Tickets=queue,general;status,deleted'
-
+  rt-shredder --force --plugin 'Tickets=query,Queue="General" and Status="deleted"'
 
 =head1 DESCRIPTION
 
@@ -105,7 +105,7 @@ 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
+Admin->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.
@@ -138,29 +138,49 @@ shredding session when the file had been created.
 
 =head1 CONFIGURATION
 
-=head2 $RT::DependenciesLimit
+=head2 $DependenciesLimit
 
 Shredder stops with an error if the object has more than
-C<$RT::DependenciesLimit> dependencies. For example: a ticket has 1000
+C<$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.
+Defaults to 1000.  To change this (for example, to 10000) add the
+following to your F<RT_SiteConfig.pm>:
 
-You can change the default value, in F<RT_SiteConfig.pm> add C<Set(
-$DependenciesLimit, new_limit );>
+    Set( $DependenciesLimit, 10_000 );>
 
 
 =head2 $ShredderStoragePath
 
-Directory containing Shredder backup dumps.
+Directory containing Shredder backup dumps; defaults to
+F</opt/rt4/var/data/RT-Shredder> (assuming an /opt/rt4 installation).
+
+To change this (for example, to /some/backup/path) add the following to
+your F<RT_SiteConfig.pm>:
+
+    Set( $ShredderStoragePath, "/some/backup/path" );>
+
+Be sure to specify an absolute path.
+
+=head1 Database Indexes
+
+We have found that the following indexes significantly speed up
+shredding on most databases.
 
-Defaults to F</path-to-RT-var-dir/data/RT-Shredder>.
+    CREATE INDEX SHREDDER_CGM1 ON CachedGroupMembers(MemberId, GroupId, Disabled);
+    CREATE INDEX SHREDDER_CGM2 ON CachedGroupMembers(ImmediateParentId,MemberId);
+    CREATE INDEX SHREDDER_CGM3 on CachedGroupMembers (Via, Id);
 
-You can change the default value, in F<RT_SiteConfig.pm> add C<Set(
-$ShredderStoragePath, new_path );>  Be sure to use an absolute path.
+    CREATE UNIQUE INDEX SHREDDER_GM1 ON GroupMembers(MemberId, GroupId);
 
+    CREATE INDEX SHREDDER_TXN1 ON Transactions(ReferenceType, OldReference);
+    CREATE INDEX SHREDDER_TXN2 ON Transactions(ReferenceType, NewReference);
+    CREATE INDEX SHREDDER_TXN3 ON Transactions(Type, OldValue);
+    CREATE INDEX SHREDDER_TXN4 ON Transactions(Type, NewValue);
+
+    CREATE INDEX SHREDDER_ATTACHMENTS1 ON Attachments(Creator);
 
 =head1 INFORMATION FOR DEVELOPERS
 
@@ -176,7 +196,7 @@ example from L</SYNOPSIS>:
 
   use RT::Shredder;
   RT::Shredder::Init( force => 1 );
-  my $deleted = RT::Tickets->new( $RT::SystemUser );
+  my $deleted = RT::Tickets->new( RT->SystemUser );
   $deleted->{'allow_deleted_search'} = 1;
   $deleted->LimitQueue( VALUE => 'general' );
   $deleted->LimitStatus( VALUE => 'deleted' );
@@ -192,7 +212,6 @@ objects in the cache and backups storage.
 
 =cut
 
-our $VERSION = '0.04';
 use File::Spec ();
 
 
@@ -202,32 +221,8 @@ BEGIN {
 # 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(
@@ -272,6 +267,7 @@ sub Init
     %opt = @_;
     RT::LoadConfig();
     RT::Init();
+    return;
 }
 
 =head4 new
@@ -288,8 +284,7 @@ sub new
 {
     my $proto = shift;
     my $self = bless( {}, ref $proto || $proto );
-    $self->_Init( @_ );
-    return $self;
+    return $self->_Init( @_ );
 }
 
 sub _Init
@@ -299,6 +294,7 @@ sub _Init
     $self->{'cache'}        = {};
     $self->{'resolver'}     = {};
     $self->{'dump_plugins'} = [];
+    return $self;
 }
 
 =head4 CastObjectsToRecords( Objects => undef )
@@ -348,18 +344,36 @@ sub CastObjectsToRecords
         }
     } elsif ( UNIVERSAL::isa( $targets, 'SCALAR' ) || !ref $targets ) {
         $targets = $$targets if ref $targets;
-        my ($class, $id) = split /-/, $targets;
+        my ($class, $org, $id);
+        if ($targets =~ /-.*-/) {
+            ($class, $org, $id) = split /-/, $targets;
+            RT::Shredder::Exception->throw( "Can't wipeout remote object $targets" )
+                  unless $org eq RT->Config->Get('Organization');
+        } else {
+            ($class, $id) = split /-/, $targets;
+        }
+        RT::Shredder::Exception->throw( "Unsupported class $class" )
+              unless $class =~ /^\w+(::\w+)*$/;
         $class = 'RT::'. $class unless $class =~ /^RTx?::/i;
-        eval "require $class";
-        die "Couldn't load '$class' module" if $@;
-        my $obj = $class->new( $RT::SystemUser );
+        $class->require or die "Failed to load $class: $@";
+        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 );
+
+        if ( $id =~ /^\d+$/ ) {
+            if ( $id ne $obj->Id ) {
+                die 'Loaded object id ' . $obj->Id . " is different from passed id $id";
+            }
+        }
+        else {
+            if ( $obj->_Accessible( 'Name', 'read' ) && $id ne $obj->Name ) {
+                die 'Loaded object name ' . $obj->Name . " is different from passed name $id";
+            }
+        }
         push @res, $obj;
     } else {
         RT::Shredder::Exception->throw( "Unsupported type ". ref $targets );
@@ -413,8 +427,11 @@ sub PutObject
         RT::Shredder::Exception->throw( "Unsupported type '". (ref $obj || $obj || '(undef)')."'" );
     }
 
-    my $str = $obj->_AsString;
-    return ($self->{'cache'}->{ $str } ||= { State => ON_STACK, Object => $obj } );
+    my $str = $obj->UID;
+    return ($self->{'cache'}->{ $str } ||= {
+        State  => RT::Shredder::Constants::ON_STACK,
+        Object => $obj
+    } );
 }
 
 =head4 GetObject, GetState, GetRecord( String => ''| Object => '' )
@@ -442,7 +459,7 @@ sub _ParseRefStrArgs
         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 $args{'Object'}->UID if UNIVERSAL::can($args{'Object'}, 'UID' );
     return '';
 }
 
@@ -535,10 +552,11 @@ sub WipeoutAll
 {
     my $self = $_[0];
 
-    while ( my ($k, $v) = each %{ $self->{'cache'} } ) {
-        next if $v->{'State'} & (WIPED | IN_WIPING);
-        $self->Wipeout( Object => $v->{'Object'} );
+    foreach my $cache_val ( values %{ $self->{'cache'} } ) {
+        next if $cache_val->{'State'} & (RT::Shredder::Constants::WIPED | RT::Shredder::Constants::IN_WIPING);
+        $self->Wipeout( Object => $cache_val->{'Object'} );
     }
+    return;
 }
 
 sub Wipeout
@@ -553,11 +571,13 @@ sub Wipeout
         die "Couldn't commit transaction" unless $RT::Handle->Commit;
     };
     if( $@ ) {
+        my $error = $@;
         $RT::Handle->Rollback('force');
         $self->RollbackDumpTo( Mark => $mark ) if $mark;
-        die $@ if RT::Shredder::Exception::Info->caught;
-        die "Couldn't wipeout object: $@";
+        die $error if RT::Shredder::Exception::Info->caught;
+        die "Couldn't wipeout object: $error";
     }
+    return;
 }
 
 sub _Wipeout
@@ -567,9 +587,9 @@ sub _Wipeout
 
     my $record = $args{'CacheRecord'};
     $record = $self->PutObject( Object => $args{'Object'} ) unless $record;
-    return if $record->{'State'} & (WIPED | IN_WIPING);
+    return if $record->{'State'} & (RT::Shredder::Constants::WIPED | RT::Shredder::Constants::IN_WIPING);
 
-    $record->{'State'} |= IN_WIPING;
+    $record->{'State'} |= RT::Shredder::Constants::IN_WIPING;
     my $object = $record->{'Object'};
 
     $self->DumpObject( Object => $object, State => 'before any action' );
@@ -580,25 +600,25 @@ sub _Wipeout
 
     my $deps = $object->Dependencies( Shredder => $self );
     $deps->List(
-        WithFlags => DEPENDS_ON | VARIABLE,
+        WithFlags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::VARIABLE,
         Callback  => sub { $self->ApplyResolvers( Dependency => $_[0] ) },
     );
     $self->DumpObject( Object => $object, State => 'after resolvers' );
 
     $deps->List(
-        WithFlags    => DEPENDS_ON,
-        WithoutFlags => WIPE_AFTER | VARIABLE,
+        WithFlags    => RT::Shredder::Constants::DEPENDS_ON,
+        WithoutFlags => RT::Shredder::Constants::WIPE_AFTER | RT::Shredder::Constants::VARIABLE,
         Callback     => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
     );
     $self->DumpObject( Object => $object, State => 'after wiping dependencies' );
 
     $object->__Wipeout;
-    $record->{'State'} |= WIPED; delete $record->{'Object'};
+    $record->{'State'} |= RT::Shredder::Constants::WIPED; delete $record->{'Object'};
     $self->DumpObject( Object => $object, State => 'after wipeout' );
 
     $deps->List(
-        WithFlags => DEPENDS_ON | WIPE_AFTER,
-        WithoutFlags => VARIABLE,
+        WithFlags => RT::Shredder::Constants::DEPENDS_ON | RT::Shredder::Constants::WIPE_AFTER,
+        WithoutFlags => RT::Shredder::Constants::VARIABLE,
         Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
     );
     $self->DumpObject( Object => $object, State => 'after late dependencies' );
@@ -606,17 +626,6 @@ sub _Wipeout
     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 )
@@ -715,7 +724,7 @@ sub GetFileName
 =head4 StoragePath
 
 Returns an absolute path to the storage dir.  See
-L<CONFIGURATION/$ShredderStoragePath>.
+L</$ShredderStoragePath>.
 
 See also description of the L</GetFileName> method.
 
@@ -766,6 +775,7 @@ sub DumpObject {
         my ($state, $msg) = $_->Run( %args );
         die "Couldn't run plugin: $msg" unless $state;
     }
+    return;
 }
 
 { my $mark = 1; # XXX: integer overflows?
@@ -781,9 +791,10 @@ sub PushDumpMark {
 sub PopDumpMark {
     my $self = shift;
     foreach (@{ $self->{'dump_plugins'} }) {
-        my ($state, $msg) = $_->PushMark( @_ );
+        my ($state, $msg) = $_->PopMark( @_ );
         die "Couldn't pop mark: $msg" unless $state;
     }
+    return;
 }
 sub RollbackDumpTo {
     my $self = shift;
@@ -791,6 +802,7 @@ sub RollbackDumpTo {
         my ($state, $msg) = $_->RollbackTo( @_ );
         die "Couldn't rollback to mark: $msg" unless $state;
     }
+    return;
 }
 }