Upgrade to 4.2.2
[usit-rt.git] / lib / RT / Shredder.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
84fb5b46
MKG
6# <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
13# This work is made available to you under the terms of Version 2 of
14# the GNU General Public License. A copy of that license should have
15# been provided with this software, but in any event can be snarfed
16# from www.gnu.org.
17#
18# This work is distributed in the hope that it will be useful, but
19# WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21# General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26# 02110-1301 or visit their web page on the internet at
27# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
32# (The following paragraph is not intended to limit the rights granted
33# to you to modify and distribute this software under the terms of
34# the GNU General Public License and is only of importance to you if
35# you choose to contribute your changes and enhancements to the
36# community by submitting them to Best Practical Solutions, LLC.)
37#
38# By intentionally submitting any modifications, corrections or
39# derivatives to this work, or any other work intended for use with
40# Request Tracker, to Best Practical Solutions, LLC, you confirm that
41# you are the copyright holder for those contributions and you grant
42# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43# royalty-free, perpetual, license to use, copy, create derivative
44# works based on those contributions, and sublicense and distribute
45# those contributions and any derivatives thereof.
46#
47# END BPS TAGGED BLOCK }}}
48
49package RT::Shredder;
50
51use strict;
52use warnings;
53
54
55
56=head1 NAME
57
58RT::Shredder - Permanently wipeout data from RT
59
60
61=head1 SYNOPSIS
62
63=head2 CLI
64
65 rt-shredder --force --plugin 'Tickets=query,Queue="General" and Status="deleted"'
66
67=head1 DESCRIPTION
68
69RT::Shredder is extension to RT which allows you to permanently wipeout
70data from the RT database. Shredder supports the wiping of almost
71all RT objects (Tickets, Transactions, Attachments, Users...).
72
73
74=head2 "Delete" vs "Wipeout"
75
76RT uses the term "delete" to mean "deactivate". To avoid confusion,
77RT::Shredder uses the term "Wipeout" to mean "permanently erase" (or
78what most people would think of as "delete").
79
80
81=head2 Why do you want this?
82
83Normally in RT, "deleting" an item simply deactivates it and makes it
84invisible from view. This is done to retain full history and
85auditability of your tickets. For most RT users this is fine and they
86have no need of RT::Shredder.
87
88But in some large and heavily used RT instances the database can get
89clogged up with junk, particularly spam. This can slow down searches
90and bloat the size of the database. For these users, RT::Shredder
91allows them to completely clear the database of this unwanted junk.
92
93An additional use of Shredder is to obliterate sensitive information
94(passwords, credit card numbers, ...) which might have made their way
95into RT.
96
97
98=head2 Command line tools (CLI)
99
100L<rt-shredder> is a program which allows you to wipe objects from
101command line or with system tasks scheduler (cron, for example).
102See also 'rt-shredder --help'.
103
104
105=head2 Web based interface (WebUI)
106
107Shredder's WebUI integrates into RT's WebUI. You can find it in the
af59614d 108Admin->Tools->Shredder tab. The interface is similar to the
84fb5b46
MKG
109CLI and gives you the same functionality. You can find 'Shredder' link
110at the bottom of tickets search results, so you could wipeout tickets
111in the way similar to the bulk update.
112
113
114=head1 DATA STORAGE AND BACKUPS
115
116Shredder allows you to store data you wiped in files as scripts with SQL
117commands.
118
119=head3 Restoring from backup
120
121Should you wipeout something you did not intend to the objects can be
122restored by using the storage files. These files are a simple set of
123SQL commands to re-insert your objects into the RT database.
124
1251) Locate the appropriate shredder SQL dump file. In the WebUI, when
126 you use shredder, the path to the dump file is displayed. It also
127 gives the option to download the dump file after each wipeout. Or
128 it can be found in your C<$ShredderStoragePath>.
129
1302) Load the shredder SQL dump into your RT database. The details will
131 be different for each database and RT configuration, consult your
132 database manual and RT config. For example, in MySQL...
133
134 mysql -u your_rt_user -p your_rt_database < /path/to/rt/var/data/shredder/dump.sql
135
136That's it.i This will restore everything you'd deleted during a
137shredding session when the file had been created.
138
139=head1 CONFIGURATION
140
141=head2 $DependenciesLimit
142
143Shredder stops with an error if the object has more than
144C<$DependenciesLimit> dependencies. For example: a ticket has 1000
145transactions or a transaction has 1000 attachments. This is protection
146from bugs in shredder from wiping out your whole database, but
147sometimes when you have big mail loops you may hit it.
148
149Defaults to 1000. To change this (for example, to 10000) add the
150following to your F<RT_SiteConfig.pm>:
151
152 Set( $DependenciesLimit, 10_000 );>
153
154
155=head2 $ShredderStoragePath
156
157Directory containing Shredder backup dumps; defaults to
158F</opt/rt4/var/data/RT-Shredder> (assuming an /opt/rt4 installation).
159
160To change this (for example, to /some/backup/path) add the following to
161your F<RT_SiteConfig.pm>:
162
163 Set( $ShredderStoragePath, "/some/backup/path" );>
164
165Be sure to specify an absolute path.
166
320f0092
MKG
167=head1 Database Indexes
168
169We have found that the following indexes significantly speed up
170shredding on most databases.
171
172 CREATE INDEX SHREDDER_CGM1 ON CachedGroupMembers(MemberId, GroupId, Disabled);
173 CREATE INDEX SHREDDER_CGM2 ON CachedGroupMembers(ImmediateParentId,MemberId);
174 CREATE INDEX SHREDDER_CGM3 on CachedGroupMembers (Via, Id);
175
176 CREATE UNIQUE INDEX SHREDDER_GM1 ON GroupMembers(MemberId, GroupId);
177
178 CREATE INDEX SHREDDER_TXN1 ON Transactions(ReferenceType, OldReference);
179 CREATE INDEX SHREDDER_TXN2 ON Transactions(ReferenceType, NewReference);
180 CREATE INDEX SHREDDER_TXN3 ON Transactions(Type, OldValue);
181 CREATE INDEX SHREDDER_TXN4 ON Transactions(Type, NewValue)
84fb5b46
MKG
182
183=head1 INFORMATION FOR DEVELOPERS
184
185=head2 General API
186
187L<RT::Shredder> is an extension to RT which adds shredder methods to
188RT objects and classes. The API is not well documented yet, but you
189can find usage examples in L<rt-shredder> and the
190F<lib/t/regression/shredder/*.t> test files.
191
192However, here is a small example that do the same action as in CLI
193example from L</SYNOPSIS>:
194
195 use RT::Shredder;
196 RT::Shredder::Init( force => 1 );
197 my $deleted = RT::Tickets->new( RT->SystemUser );
198 $deleted->{'allow_deleted_search'} = 1;
199 $deleted->LimitQueue( VALUE => 'general' );
200 $deleted->LimitStatus( VALUE => 'deleted' );
201 while( my $t = $deleted->Next ) {
202 $t->Wipeout;
203 }
204
205
206=head2 RT::Shredder class' API
207
208L<RT::Shredder> implements interfaces to objects cache, actions on the
209objects in the cache and backups storage.
210
211=cut
212
84fb5b46
MKG
213use File::Spec ();
214
215
216BEGIN {
217# I can't use 'use lib' here since it breakes tests
218# because test suite uses old RT::Shredder setup from
219# RT lib path
220
221### after: push @INC, qw(@RT_LIB_PATH@);
222 use RT::Shredder::Constants;
223 use RT::Shredder::Exceptions;
224
225 require RT;
226
227 require RT::Shredder::Record;
228
229 require RT::Shredder::ACE;
230 require RT::Shredder::Attachment;
231 require RT::Shredder::CachedGroupMember;
232 require RT::Shredder::CustomField;
233 require RT::Shredder::CustomFieldValue;
234 require RT::Shredder::GroupMember;
235 require RT::Shredder::Group;
236 require RT::Shredder::Link;
237 require RT::Shredder::Principal;
238 require RT::Shredder::Queue;
239 require RT::Shredder::Scrip;
240 require RT::Shredder::ScripAction;
241 require RT::Shredder::ScripCondition;
242 require RT::Shredder::Template;
243 require RT::Shredder::ObjectCustomFieldValue;
244 require RT::Shredder::Ticket;
245 require RT::Shredder::Transaction;
246 require RT::Shredder::User;
247}
248
249our @SUPPORTED_OBJECTS = qw(
250 ACE
251 Attachment
252 CachedGroupMember
253 CustomField
254 CustomFieldValue
255 GroupMember
256 Group
257 Link
258 Principal
259 Queue
260 Scrip
261 ScripAction
262 ScripCondition
263 Template
264 ObjectCustomFieldValue
265 Ticket
266 Transaction
267 User
268);
269
270=head3 GENERIC
271
272=head4 Init
273
274 RT::Shredder::Init( %default_options );
275
276C<RT::Shredder::Init()> should be called before creating an
277RT::Shredder object. It iniitalizes RT and loads the RT
278configuration.
279
280%default_options are passed to every C<<RT::Shredder->new>> call.
281
282=cut
283
284our %opt = ();
285
286sub Init
287{
288 %opt = @_;
289 RT::LoadConfig();
290 RT::Init();
291}
292
293=head4 new
294
295 my $shredder = RT::Shredder->new(%options);
296
297Construct a new RT::Shredder object.
298
299There currently are no %options.
300
301=cut
302
303sub new
304{
305 my $proto = shift;
306 my $self = bless( {}, ref $proto || $proto );
307 $self->_Init( @_ );
308 return $self;
309}
310
311sub _Init
312{
313 my $self = shift;
314 $self->{'opt'} = { %opt, @_ };
315 $self->{'cache'} = {};
316 $self->{'resolver'} = {};
317 $self->{'dump_plugins'} = [];
318}
319
320=head4 CastObjectsToRecords( Objects => undef )
321
322Cast objects to the C<RT::Record> objects or its ancesstors.
323Objects can be passed as SCALAR (format C<< <class>-<id> >>),
324ARRAY, C<RT::Record> ancesstors or C<RT::SearchBuilder> ancesstor.
325
326Most methods that takes C<Objects> argument use this method to
327cast argument value to list of records.
328
329Returns an array of records.
330
331For example:
332
333 my @objs = $shredder->CastObjectsToRecords(
334 Objects => [ # ARRAY reference
335 'RT::Attachment-10', # SCALAR or SCALAR reference
336 $tickets, # RT::Tickets object (isa RT::SearchBuilder)
337 $user, # RT::User object (isa RT::Record)
338 ],
339 );
340
341=cut
342
343sub CastObjectsToRecords
344{
345 my $self = shift;
346 my %args = ( Objects => undef, @_ );
347
348 my @res;
349 my $targets = delete $args{'Objects'};
350 unless( $targets ) {
351 RT::Shredder::Exception->throw( "Undefined Objects argument" );
352 }
353
354 if( UNIVERSAL::isa( $targets, 'RT::SearchBuilder' ) ) {
355 #XXX: try to use ->_DoSearch + ->ItemsArrayRef in feature
356 # like we do in Record with links, but change only when
357 # more tests would be available
358 while( my $tmp = $targets->Next ) { push @res, $tmp };
359 } elsif ( UNIVERSAL::isa( $targets, 'RT::Record' ) ) {
360 push @res, $targets;
361 } elsif ( UNIVERSAL::isa( $targets, 'ARRAY' ) ) {
362 foreach( @$targets ) {
363 push @res, $self->CastObjectsToRecords( Objects => $_ );
364 }
365 } elsif ( UNIVERSAL::isa( $targets, 'SCALAR' ) || !ref $targets ) {
366 $targets = $$targets if ref $targets;
367 my ($class, $id) = split /-/, $targets;
368 RT::Shredder::Exception->throw( "Unsupported class $class" )
369 unless $class =~ /^\w+(::\w+)*$/;
370 $class = 'RT::'. $class unless $class =~ /^RTx?::/i;
371 eval "require $class";
372 die "Couldn't load '$class' module" if $@;
373 my $obj = $class->new( RT->SystemUser );
374 die "Couldn't construct new '$class' object" unless $obj;
375 $obj->Load( $id );
376 unless ( $obj->id ) {
377 $RT::Logger->error( "Couldn't load '$class' object with id '$id'" );
378 RT::Shredder::Exception::Info->throw( 'CouldntLoadObject' );
379 }
380 die "Loaded object has different id" unless( $id eq $obj->id );
381 push @res, $obj;
382 } else {
383 RT::Shredder::Exception->throw( "Unsupported type ". ref $targets );
384 }
385 return @res;
386}
387
388=head3 OBJECTS CACHE
389
390=head4 PutObjects( Objects => undef )
391
392Puts objects into cache.
393
394Returns array of the cache entries.
395
396See C<CastObjectsToRecords> method for supported types of the C<Objects>
397argument.
398
399=cut
400
401sub PutObjects
402{
403 my $self = shift;
404 my %args = ( Objects => undef, @_ );
405
406 my @res;
407 for( $self->CastObjectsToRecords( Objects => delete $args{'Objects'} ) ) {
408 push @res, $self->PutObject( %args, Object => $_ )
409 }
410
411 return @res;
412}
413
414=head4 PutObject( Object => undef )
415
416Puts record object into cache and returns its cache entry.
417
418B<NOTE> that this method support B<only C<RT::Record> object or its ancesstor
419objects>, if you want put mutliple objects or objects represented by different
420classes then use C<PutObjects> method instead.
421
422=cut
423
424sub PutObject
425{
426 my $self = shift;
427 my %args = ( Object => undef, @_ );
428
429 my $obj = $args{'Object'};
430 unless( UNIVERSAL::isa( $obj, 'RT::Record' ) ) {
431 RT::Shredder::Exception->throw( "Unsupported type '". (ref $obj || $obj || '(undef)')."'" );
432 }
433
434 my $str = $obj->_AsString;
435 return ($self->{'cache'}->{ $str } ||= { State => ON_STACK, Object => $obj } );
436}
437
438=head4 GetObject, GetState, GetRecord( String => ''| Object => '' )
439
440Returns record object from cache, cache entry state or cache entry accordingly.
441
442All three methods takes C<String> (format C<< <class>-<id> >>) or C<Object> argument.
443C<String> argument has more priority than C<Object> so if it's not empty then methods
444leave C<Object> argument unchecked.
445
446You can read about possible states and their meanings in L<RT::Shredder::Constants> docs.
447
448=cut
449
450sub _ParseRefStrArgs
451{
452 my $self = shift;
453 my %args = (
454 String => '',
455 Object => undef,
456 @_
457 );
458 if( $args{'String'} && $args{'Object'} ) {
459 require Carp;
460 Carp::croak( "both String and Object args passed" );
461 }
462 return $args{'String'} if $args{'String'};
463 return $args{'Object'}->_AsString if UNIVERSAL::can($args{'Object'}, '_AsString' );
464 return '';
465}
466
467sub GetObject { return (shift)->GetRecord( @_ )->{'Object'} }
468sub GetState { return (shift)->GetRecord( @_ )->{'State'} }
469sub GetRecord
470{
471 my $self = shift;
472 my $str = $self->_ParseRefStrArgs( @_ );
473 return $self->{'cache'}->{ $str };
474}
475
476=head3 Dependencies resolvers
477
478=head4 PutResolver, GetResolvers and ApplyResolvers
479
480TODO: These methods have no documentation.
481
482=cut
483
484sub PutResolver
485{
486 my $self = shift;
487 my %args = (
488 BaseClass => '',
489 TargetClass => '',
490 Code => undef,
491 @_,
492 );
493 unless( UNIVERSAL::isa( $args{'Code'} => 'CODE' ) ) {
494 die "Resolver '$args{Code}' is not code reference";
495 }
496
497 my $resolvers = (
498 (
499 $self->{'resolver'}->{ $args{'BaseClass'} } ||= {}
500 )->{ $args{'TargetClass'} || '' } ||= []
501 );
502 unshift @$resolvers, $args{'Code'};
503 return;
504}
505
506sub GetResolvers
507{
508 my $self = shift;
509 my %args = (
510 BaseClass => '',
511 TargetClass => '',
512 @_,
513 );
514
515 my @res;
516 if( $args{'TargetClass'} && exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} } ) {
517 push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} || '' } };
518 }
519 if( exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ '' } ) {
520 push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{''} };
521 }
522
523 return @res;
524}
525
526sub ApplyResolvers
527{
528 my $self = shift;
529 my %args = ( Dependency => undef, @_ );
530 my $dep = $args{'Dependency'};
531
532 my @resolvers = $self->GetResolvers(
533 BaseClass => $dep->BaseClass,
534 TargetClass => $dep->TargetClass,
535 );
536
537 unless( @resolvers ) {
538 RT::Shredder::Exception::Info->throw(
539 tag => 'NoResolver',
540 error => "Couldn't find resolver for dependency '". $dep->AsString ."'",
541 );
542 }
543 $_->(
544 Shredder => $self,
545 BaseObject => $dep->BaseObject,
546 TargetObject => $dep->TargetObject,
547 ) foreach @resolvers;
548
549 return;
550}
551
552sub WipeoutAll
553{
554 my $self = $_[0];
555
dab09ea8
MKG
556 foreach my $cache_val ( values %{ $self->{'cache'} } ) {
557 next if $cache_val->{'State'} & (WIPED | IN_WIPING);
558 $self->Wipeout( Object => $cache_val->{'Object'} );
84fb5b46
MKG
559 }
560}
561
562sub Wipeout
563{
564 my $self = shift;
565 my $mark;
566 eval {
567 die "Couldn't begin transaction" unless $RT::Handle->BeginTransaction;
568 $mark = $self->PushDumpMark or die "Couldn't get dump mark";
569 $self->_Wipeout( @_ );
570 $self->PopDumpMark( Mark => $mark );
571 die "Couldn't commit transaction" unless $RT::Handle->Commit;
572 };
573 if( $@ ) {
574 my $error = $@;
575 $RT::Handle->Rollback('force');
576 $self->RollbackDumpTo( Mark => $mark ) if $mark;
577 die $error if RT::Shredder::Exception::Info->caught;
578 die "Couldn't wipeout object: $error";
579 }
580}
581
582sub _Wipeout
583{
584 my $self = shift;
585 my %args = ( CacheRecord => undef, Object => undef, @_ );
586
587 my $record = $args{'CacheRecord'};
588 $record = $self->PutObject( Object => $args{'Object'} ) unless $record;
589 return if $record->{'State'} & (WIPED | IN_WIPING);
590
591 $record->{'State'} |= IN_WIPING;
592 my $object = $record->{'Object'};
593
594 $self->DumpObject( Object => $object, State => 'before any action' );
595
596 unless( $object->BeforeWipeout ) {
597 RT::Shredder::Exception->throw( "BeforeWipeout check returned error" );
598 }
599
600 my $deps = $object->Dependencies( Shredder => $self );
601 $deps->List(
602 WithFlags => DEPENDS_ON | VARIABLE,
603 Callback => sub { $self->ApplyResolvers( Dependency => $_[0] ) },
604 );
605 $self->DumpObject( Object => $object, State => 'after resolvers' );
606
607 $deps->List(
608 WithFlags => DEPENDS_ON,
609 WithoutFlags => WIPE_AFTER | VARIABLE,
610 Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
611 );
612 $self->DumpObject( Object => $object, State => 'after wiping dependencies' );
613
614 $object->__Wipeout;
615 $record->{'State'} |= WIPED; delete $record->{'Object'};
616 $self->DumpObject( Object => $object, State => 'after wipeout' );
617
618 $deps->List(
619 WithFlags => DEPENDS_ON | WIPE_AFTER,
620 WithoutFlags => VARIABLE,
621 Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
622 );
623 $self->DumpObject( Object => $object, State => 'after late dependencies' );
624
625 return;
626}
627
84fb5b46
MKG
628=head3 Data storage and backups
629
630=head4 GetFileName( FileName => '<ISO DATETIME>-XXXX.sql', FromStorage => 1 )
631
632Takes desired C<FileName> and flag C<FromStorage> then translate file name to absolute
633path by next rules:
634
635* Default value of the C<FileName> option is C<< <ISO DATETIME>-XXXX.sql >>;
636
637* 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;
638
639* 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.
640
641* if C<FromStorage> argument is true (default behaviour) then result path would always be relative to C<StoragePath>;
642
643* if C<FromStorage> argument is false then result would be relative to the current dir unless it's already absolute path.
644
645Returns an absolute path of the file.
646
647Examples:
648 # file from storage with default name format
649 my $fname = $shredder->GetFileName;
650
651 # file from storage with custom name format
652 my $fname = $shredder->GetFileName( FileName => 'shredder-XXXX.backup' );
653
654 # file with path relative to the current dir
655 my $fname = $shredder->GetFileName(
656 FromStorage => 0,
657 FileName => 'backups/shredder.sql',
658 );
659
660 # file with absolute path
661 my $fname = $shredder->GetFileName(
662 FromStorage => 0,
663 FileName => '/var/backups/shredder-XXXX.sql'
664 );
665
666=cut
667
668sub GetFileName
669{
670 my $self = shift;
671 my %args = ( FileName => '', FromStorage => 1, @_ );
672
673 # default value
674 my $file = $args{'FileName'} || '%t-XXXX.sql';
675 if( $file =~ /\%t/i ) {
676 require POSIX;
677 my $date_time = POSIX::strftime( "%Y%m%dT%H%M%S", gmtime );
678 $file =~ s/\%t/$date_time/gi;
679 }
680
681 # convert to absolute path
682 if( $args{'FromStorage'} ) {
683 $file = File::Spec->catfile( $self->StoragePath, $file );
684 } elsif( !File::Spec->file_name_is_absolute( $file ) ) {
685 $file = File::Spec->rel2abs( $file );
686 }
687
688 # check mask
689 if( $file =~ /XXXX[^\/\\]*$/ ) {
690 my( $tmp, $i ) = ( $file, 0 );
691 do {
692 $i++;
693 $tmp = $file;
694 $tmp =~ s/XXXX([^\/\\]*)$/sprintf("%04d", $i).$1/e;
695 } while( -e $tmp && $i < 9999 );
696 $file = $tmp;
697 }
698
699 if( -f $file ) {
700 unless( -w _ ) {
701 die "File '$file' exists, but is read-only";
702 }
703 } elsif( !-e _ ) {
704 unless( File::Spec->file_name_is_absolute( $file ) ) {
705 $file = File::Spec->rel2abs( $file );
706 }
707
708 # check base dir
709 my $dir = File::Spec->join( (File::Spec->splitpath( $file ))[0,1] );
710 unless( -e $dir && -d _) {
711 die "Base directory '$dir' for file '$file' doesn't exist";
712 }
713 unless( -w $dir ) {
714 die "Base directory '$dir' is not writable";
715 }
716 } else {
717 die "'$file' is not regular file";
718 }
719
720 return $file;
721}
722
723=head4 StoragePath
724
725Returns an absolute path to the storage dir. See
c36a7e1d 726L</$ShredderStoragePath>.
84fb5b46
MKG
727
728See also description of the L</GetFileName> method.
729
730=cut
731
732sub StoragePath
733{
734 return scalar( RT->Config->Get('ShredderStoragePath') )
735 || File::Spec->catdir( $RT::VarPath, qw(data RT-Shredder) );
736}
737
738my %active_dump_state = ();
739sub AddDumpPlugin {
740 my $self = shift;
741 my %args = ( Object => undef, Name => 'SQLDump', Arguments => undef, @_ );
742
743 my $plugin = $args{'Object'};
744 unless ( $plugin ) {
745 require RT::Shredder::Plugin;
746 $plugin = RT::Shredder::Plugin->new;
747 my( $status, $msg ) = $plugin->LoadByName( $args{'Name'} );
748 die "Couldn't load dump plugin: $msg\n" unless $status;
749 }
750 die "Plugin is not of correct type" unless lc $plugin->Type eq 'dump';
751
752 if ( my $pargs = $args{'Arguments'} ) {
753 my ($status, $msg) = $plugin->TestArgs( %$pargs );
754 die "Couldn't set plugin args: $msg\n" unless $status;
755 }
756
757 my @applies_to = $plugin->AppliesToStates;
758 die "Plugin doesn't apply to any state" unless @applies_to;
759 $active_dump_state{ lc $_ } = 1 foreach @applies_to;
760
761 push @{ $self->{'dump_plugins'} }, $plugin;
762
763 return $plugin;
764}
765
766sub DumpObject {
767 my $self = shift;
768 my %args = (Object => undef, State => undef, @_);
769 die "No state passed" unless $args{'State'};
770 return unless $active_dump_state{ lc $args{'State'} };
771
772 foreach (@{ $self->{'dump_plugins'} }) {
773 next unless grep lc $args{'State'} eq lc $_, $_->AppliesToStates;
774 my ($state, $msg) = $_->Run( %args );
775 die "Couldn't run plugin: $msg" unless $state;
776 }
777}
778
779{ my $mark = 1; # XXX: integer overflows?
780sub PushDumpMark {
781 my $self = shift;
782 $mark++;
783 foreach (@{ $self->{'dump_plugins'} }) {
784 my ($state, $msg) = $_->PushMark( Mark => $mark );
785 die "Couldn't push mark: $msg" unless $state;
786 }
787 return $mark;
788}
789sub PopDumpMark {
790 my $self = shift;
791 foreach (@{ $self->{'dump_plugins'} }) {
792 my ($state, $msg) = $_->PushMark( @_ );
793 die "Couldn't pop mark: $msg" unless $state;
794 }
795}
796sub RollbackDumpTo {
797 my $self = shift;
798 foreach (@{ $self->{'dump_plugins'} }) {
799 my ($state, $msg) = $_->RollbackTo( @_ );
800 die "Couldn't rollback to mark: $msg" unless $state;
801 }
802}
803}
804
8051;
806__END__
807
808=head1 NOTES
809
810=head2 Database transactions support
811
812Since 0.03_01 RT::Shredder uses database transactions and should be
813much safer to run on production servers.
814
815=head2 Foreign keys
816
817Mainstream RT doesn't use FKs, but at least I posted DDL script that creates them
818in mysql DB, note that if you use FKs then this two valid keys don't allow delete
819Tickets because of bug in MySQL:
820
821 ALTER TABLE Tickets ADD FOREIGN KEY (EffectiveId) REFERENCES Tickets(id);
822 ALTER TABLE CachedGroupMembers ADD FOREIGN KEY (Via) REFERENCES CachedGroupMembers(id);
823
824L<http://bugs.mysql.com/bug.php?id=4042>
825
826=head1 BUGS AND HOW TO CONTRIBUTE
827
828We need your feedback in all cases: if you use it or not,
829is it works for you or not.
830
831=head2 Testing
832
833Don't skip C<make test> step while install and send me reports if it's fails.
834Add your own tests, it's easy enough if you've writen at list one perl script
835that works with RT. Read more about testing in F<t/utils.pl>.
836
837=head2 Reporting
838
839Send reports to L</AUTHOR> or to the RT mailing lists.
840
841=head2 Documentation
842
843Many bugs in the docs: insanity, spelling, gramar and so on.
844Patches are wellcome.
845
846=head2 Todo
847
848Please, see Todo file, it has some technical notes
849about what I plan to do, when I'll do it, also it
850describes some problems code has.
851
852=head2 Repository
853
854Since RT-3.7 shredder is a part of the RT distribution.
855Versions of the RTx::Shredder extension could
856be downloaded from the CPAN. Those work with older
857RT versions or you can find repository at
858L<https://opensvn.csie.org/rtx_shredder>
859
860=head1 AUTHOR
861
862 Ruslan U. Zakirov <Ruslan.Zakirov@gmail.com>
863
864=head1 COPYRIGHT
865
866This program is free software; you can redistribute
867it and/or modify it under the same terms as Perl itself.
868
869The full text of the license can be found in the
870Perl distribution.
871
872=head1 SEE ALSO
873
874L<rt-shredder>, L<rt-validator>
875
876=cut