Dev to 4.0.11
[usit-rt.git] / lib / RT / Shredder.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
403d7b0b 5# This software is Copyright (c) 1996-2013 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
108Configuration->Tools->Shredder tab. The interface is similar to the
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
167
168=head1 INFORMATION FOR DEVELOPERS
169
170=head2 General API
171
172L<RT::Shredder> is an extension to RT which adds shredder methods to
173RT objects and classes. The API is not well documented yet, but you
174can find usage examples in L<rt-shredder> and the
175F<lib/t/regression/shredder/*.t> test files.
176
177However, here is a small example that do the same action as in CLI
178example from L</SYNOPSIS>:
179
180 use RT::Shredder;
181 RT::Shredder::Init( force => 1 );
182 my $deleted = RT::Tickets->new( RT->SystemUser );
183 $deleted->{'allow_deleted_search'} = 1;
184 $deleted->LimitQueue( VALUE => 'general' );
185 $deleted->LimitStatus( VALUE => 'deleted' );
186 while( my $t = $deleted->Next ) {
187 $t->Wipeout;
188 }
189
190
191=head2 RT::Shredder class' API
192
193L<RT::Shredder> implements interfaces to objects cache, actions on the
194objects in the cache and backups storage.
195
196=cut
197
198our $VERSION = '0.04';
199use File::Spec ();
200
201
202BEGIN {
203# I can't use 'use lib' here since it breakes tests
204# because test suite uses old RT::Shredder setup from
205# RT lib path
206
207### after: push @INC, qw(@RT_LIB_PATH@);
208 use RT::Shredder::Constants;
209 use RT::Shredder::Exceptions;
210
211 require RT;
212
213 require RT::Shredder::Record;
214
215 require RT::Shredder::ACE;
216 require RT::Shredder::Attachment;
217 require RT::Shredder::CachedGroupMember;
218 require RT::Shredder::CustomField;
219 require RT::Shredder::CustomFieldValue;
220 require RT::Shredder::GroupMember;
221 require RT::Shredder::Group;
222 require RT::Shredder::Link;
223 require RT::Shredder::Principal;
224 require RT::Shredder::Queue;
225 require RT::Shredder::Scrip;
226 require RT::Shredder::ScripAction;
227 require RT::Shredder::ScripCondition;
228 require RT::Shredder::Template;
229 require RT::Shredder::ObjectCustomFieldValue;
230 require RT::Shredder::Ticket;
231 require RT::Shredder::Transaction;
232 require RT::Shredder::User;
233}
234
235our @SUPPORTED_OBJECTS = qw(
236 ACE
237 Attachment
238 CachedGroupMember
239 CustomField
240 CustomFieldValue
241 GroupMember
242 Group
243 Link
244 Principal
245 Queue
246 Scrip
247 ScripAction
248 ScripCondition
249 Template
250 ObjectCustomFieldValue
251 Ticket
252 Transaction
253 User
254);
255
256=head3 GENERIC
257
258=head4 Init
259
260 RT::Shredder::Init( %default_options );
261
262C<RT::Shredder::Init()> should be called before creating an
263RT::Shredder object. It iniitalizes RT and loads the RT
264configuration.
265
266%default_options are passed to every C<<RT::Shredder->new>> call.
267
268=cut
269
270our %opt = ();
271
272sub Init
273{
274 %opt = @_;
275 RT::LoadConfig();
276 RT::Init();
277}
278
279=head4 new
280
281 my $shredder = RT::Shredder->new(%options);
282
283Construct a new RT::Shredder object.
284
285There currently are no %options.
286
287=cut
288
289sub new
290{
291 my $proto = shift;
292 my $self = bless( {}, ref $proto || $proto );
293 $self->_Init( @_ );
294 return $self;
295}
296
297sub _Init
298{
299 my $self = shift;
300 $self->{'opt'} = { %opt, @_ };
301 $self->{'cache'} = {};
302 $self->{'resolver'} = {};
303 $self->{'dump_plugins'} = [];
304}
305
306=head4 CastObjectsToRecords( Objects => undef )
307
308Cast objects to the C<RT::Record> objects or its ancesstors.
309Objects can be passed as SCALAR (format C<< <class>-<id> >>),
310ARRAY, C<RT::Record> ancesstors or C<RT::SearchBuilder> ancesstor.
311
312Most methods that takes C<Objects> argument use this method to
313cast argument value to list of records.
314
315Returns an array of records.
316
317For example:
318
319 my @objs = $shredder->CastObjectsToRecords(
320 Objects => [ # ARRAY reference
321 'RT::Attachment-10', # SCALAR or SCALAR reference
322 $tickets, # RT::Tickets object (isa RT::SearchBuilder)
323 $user, # RT::User object (isa RT::Record)
324 ],
325 );
326
327=cut
328
329sub CastObjectsToRecords
330{
331 my $self = shift;
332 my %args = ( Objects => undef, @_ );
333
334 my @res;
335 my $targets = delete $args{'Objects'};
336 unless( $targets ) {
337 RT::Shredder::Exception->throw( "Undefined Objects argument" );
338 }
339
340 if( UNIVERSAL::isa( $targets, 'RT::SearchBuilder' ) ) {
341 #XXX: try to use ->_DoSearch + ->ItemsArrayRef in feature
342 # like we do in Record with links, but change only when
343 # more tests would be available
344 while( my $tmp = $targets->Next ) { push @res, $tmp };
345 } elsif ( UNIVERSAL::isa( $targets, 'RT::Record' ) ) {
346 push @res, $targets;
347 } elsif ( UNIVERSAL::isa( $targets, 'ARRAY' ) ) {
348 foreach( @$targets ) {
349 push @res, $self->CastObjectsToRecords( Objects => $_ );
350 }
351 } elsif ( UNIVERSAL::isa( $targets, 'SCALAR' ) || !ref $targets ) {
352 $targets = $$targets if ref $targets;
353 my ($class, $id) = split /-/, $targets;
354 RT::Shredder::Exception->throw( "Unsupported class $class" )
355 unless $class =~ /^\w+(::\w+)*$/;
356 $class = 'RT::'. $class unless $class =~ /^RTx?::/i;
357 eval "require $class";
358 die "Couldn't load '$class' module" if $@;
359 my $obj = $class->new( RT->SystemUser );
360 die "Couldn't construct new '$class' object" unless $obj;
361 $obj->Load( $id );
362 unless ( $obj->id ) {
363 $RT::Logger->error( "Couldn't load '$class' object with id '$id'" );
364 RT::Shredder::Exception::Info->throw( 'CouldntLoadObject' );
365 }
366 die "Loaded object has different id" unless( $id eq $obj->id );
367 push @res, $obj;
368 } else {
369 RT::Shredder::Exception->throw( "Unsupported type ". ref $targets );
370 }
371 return @res;
372}
373
374=head3 OBJECTS CACHE
375
376=head4 PutObjects( Objects => undef )
377
378Puts objects into cache.
379
380Returns array of the cache entries.
381
382See C<CastObjectsToRecords> method for supported types of the C<Objects>
383argument.
384
385=cut
386
387sub PutObjects
388{
389 my $self = shift;
390 my %args = ( Objects => undef, @_ );
391
392 my @res;
393 for( $self->CastObjectsToRecords( Objects => delete $args{'Objects'} ) ) {
394 push @res, $self->PutObject( %args, Object => $_ )
395 }
396
397 return @res;
398}
399
400=head4 PutObject( Object => undef )
401
402Puts record object into cache and returns its cache entry.
403
404B<NOTE> that this method support B<only C<RT::Record> object or its ancesstor
405objects>, if you want put mutliple objects or objects represented by different
406classes then use C<PutObjects> method instead.
407
408=cut
409
410sub PutObject
411{
412 my $self = shift;
413 my %args = ( Object => undef, @_ );
414
415 my $obj = $args{'Object'};
416 unless( UNIVERSAL::isa( $obj, 'RT::Record' ) ) {
417 RT::Shredder::Exception->throw( "Unsupported type '". (ref $obj || $obj || '(undef)')."'" );
418 }
419
420 my $str = $obj->_AsString;
421 return ($self->{'cache'}->{ $str } ||= { State => ON_STACK, Object => $obj } );
422}
423
424=head4 GetObject, GetState, GetRecord( String => ''| Object => '' )
425
426Returns record object from cache, cache entry state or cache entry accordingly.
427
428All three methods takes C<String> (format C<< <class>-<id> >>) or C<Object> argument.
429C<String> argument has more priority than C<Object> so if it's not empty then methods
430leave C<Object> argument unchecked.
431
432You can read about possible states and their meanings in L<RT::Shredder::Constants> docs.
433
434=cut
435
436sub _ParseRefStrArgs
437{
438 my $self = shift;
439 my %args = (
440 String => '',
441 Object => undef,
442 @_
443 );
444 if( $args{'String'} && $args{'Object'} ) {
445 require Carp;
446 Carp::croak( "both String and Object args passed" );
447 }
448 return $args{'String'} if $args{'String'};
449 return $args{'Object'}->_AsString if UNIVERSAL::can($args{'Object'}, '_AsString' );
450 return '';
451}
452
453sub GetObject { return (shift)->GetRecord( @_ )->{'Object'} }
454sub GetState { return (shift)->GetRecord( @_ )->{'State'} }
455sub GetRecord
456{
457 my $self = shift;
458 my $str = $self->_ParseRefStrArgs( @_ );
459 return $self->{'cache'}->{ $str };
460}
461
462=head3 Dependencies resolvers
463
464=head4 PutResolver, GetResolvers and ApplyResolvers
465
466TODO: These methods have no documentation.
467
468=cut
469
470sub PutResolver
471{
472 my $self = shift;
473 my %args = (
474 BaseClass => '',
475 TargetClass => '',
476 Code => undef,
477 @_,
478 );
479 unless( UNIVERSAL::isa( $args{'Code'} => 'CODE' ) ) {
480 die "Resolver '$args{Code}' is not code reference";
481 }
482
483 my $resolvers = (
484 (
485 $self->{'resolver'}->{ $args{'BaseClass'} } ||= {}
486 )->{ $args{'TargetClass'} || '' } ||= []
487 );
488 unshift @$resolvers, $args{'Code'};
489 return;
490}
491
492sub GetResolvers
493{
494 my $self = shift;
495 my %args = (
496 BaseClass => '',
497 TargetClass => '',
498 @_,
499 );
500
501 my @res;
502 if( $args{'TargetClass'} && exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} } ) {
503 push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{ $args{'TargetClass'} || '' } };
504 }
505 if( exists $self->{'resolver'}->{ $args{'BaseClass'} }->{ '' } ) {
506 push @res, @{ $self->{'resolver'}->{ $args{'BaseClass'} }->{''} };
507 }
508
509 return @res;
510}
511
512sub ApplyResolvers
513{
514 my $self = shift;
515 my %args = ( Dependency => undef, @_ );
516 my $dep = $args{'Dependency'};
517
518 my @resolvers = $self->GetResolvers(
519 BaseClass => $dep->BaseClass,
520 TargetClass => $dep->TargetClass,
521 );
522
523 unless( @resolvers ) {
524 RT::Shredder::Exception::Info->throw(
525 tag => 'NoResolver',
526 error => "Couldn't find resolver for dependency '". $dep->AsString ."'",
527 );
528 }
529 $_->(
530 Shredder => $self,
531 BaseObject => $dep->BaseObject,
532 TargetObject => $dep->TargetObject,
533 ) foreach @resolvers;
534
535 return;
536}
537
538sub WipeoutAll
539{
540 my $self = $_[0];
541
dab09ea8
MKG
542 foreach my $cache_val ( values %{ $self->{'cache'} } ) {
543 next if $cache_val->{'State'} & (WIPED | IN_WIPING);
544 $self->Wipeout( Object => $cache_val->{'Object'} );
84fb5b46
MKG
545 }
546}
547
548sub Wipeout
549{
550 my $self = shift;
551 my $mark;
552 eval {
553 die "Couldn't begin transaction" unless $RT::Handle->BeginTransaction;
554 $mark = $self->PushDumpMark or die "Couldn't get dump mark";
555 $self->_Wipeout( @_ );
556 $self->PopDumpMark( Mark => $mark );
557 die "Couldn't commit transaction" unless $RT::Handle->Commit;
558 };
559 if( $@ ) {
560 my $error = $@;
561 $RT::Handle->Rollback('force');
562 $self->RollbackDumpTo( Mark => $mark ) if $mark;
563 die $error if RT::Shredder::Exception::Info->caught;
564 die "Couldn't wipeout object: $error";
565 }
566}
567
568sub _Wipeout
569{
570 my $self = shift;
571 my %args = ( CacheRecord => undef, Object => undef, @_ );
572
573 my $record = $args{'CacheRecord'};
574 $record = $self->PutObject( Object => $args{'Object'} ) unless $record;
575 return if $record->{'State'} & (WIPED | IN_WIPING);
576
577 $record->{'State'} |= IN_WIPING;
578 my $object = $record->{'Object'};
579
580 $self->DumpObject( Object => $object, State => 'before any action' );
581
582 unless( $object->BeforeWipeout ) {
583 RT::Shredder::Exception->throw( "BeforeWipeout check returned error" );
584 }
585
586 my $deps = $object->Dependencies( Shredder => $self );
587 $deps->List(
588 WithFlags => DEPENDS_ON | VARIABLE,
589 Callback => sub { $self->ApplyResolvers( Dependency => $_[0] ) },
590 );
591 $self->DumpObject( Object => $object, State => 'after resolvers' );
592
593 $deps->List(
594 WithFlags => DEPENDS_ON,
595 WithoutFlags => WIPE_AFTER | VARIABLE,
596 Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
597 );
598 $self->DumpObject( Object => $object, State => 'after wiping dependencies' );
599
600 $object->__Wipeout;
601 $record->{'State'} |= WIPED; delete $record->{'Object'};
602 $self->DumpObject( Object => $object, State => 'after wipeout' );
603
604 $deps->List(
605 WithFlags => DEPENDS_ON | WIPE_AFTER,
606 WithoutFlags => VARIABLE,
607 Callback => sub { $self->_Wipeout( Object => $_[0]->TargetObject ) },
608 );
609 $self->DumpObject( Object => $object, State => 'after late dependencies' );
610
611 return;
612}
613
614sub ValidateRelations
615{
616 my $self = shift;
617 my %args = ( @_ );
618
619 foreach my $record( values %{ $self->{'cache'} } ) {
620 next if( $record->{'State'} & VALID );
621 $record->{'Object'}->ValidateRelations( Shredder => $self );
622 }
623}
624
625=head3 Data storage and backups
626
627=head4 GetFileName( FileName => '<ISO DATETIME>-XXXX.sql', FromStorage => 1 )
628
629Takes desired C<FileName> and flag C<FromStorage> then translate file name to absolute
630path by next rules:
631
632* Default value of the C<FileName> option is C<< <ISO DATETIME>-XXXX.sql >>;
633
634* 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;
635
636* 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.
637
638* if C<FromStorage> argument is true (default behaviour) then result path would always be relative to C<StoragePath>;
639
640* if C<FromStorage> argument is false then result would be relative to the current dir unless it's already absolute path.
641
642Returns an absolute path of the file.
643
644Examples:
645 # file from storage with default name format
646 my $fname = $shredder->GetFileName;
647
648 # file from storage with custom name format
649 my $fname = $shredder->GetFileName( FileName => 'shredder-XXXX.backup' );
650
651 # file with path relative to the current dir
652 my $fname = $shredder->GetFileName(
653 FromStorage => 0,
654 FileName => 'backups/shredder.sql',
655 );
656
657 # file with absolute path
658 my $fname = $shredder->GetFileName(
659 FromStorage => 0,
660 FileName => '/var/backups/shredder-XXXX.sql'
661 );
662
663=cut
664
665sub GetFileName
666{
667 my $self = shift;
668 my %args = ( FileName => '', FromStorage => 1, @_ );
669
670 # default value
671 my $file = $args{'FileName'} || '%t-XXXX.sql';
672 if( $file =~ /\%t/i ) {
673 require POSIX;
674 my $date_time = POSIX::strftime( "%Y%m%dT%H%M%S", gmtime );
675 $file =~ s/\%t/$date_time/gi;
676 }
677
678 # convert to absolute path
679 if( $args{'FromStorage'} ) {
680 $file = File::Spec->catfile( $self->StoragePath, $file );
681 } elsif( !File::Spec->file_name_is_absolute( $file ) ) {
682 $file = File::Spec->rel2abs( $file );
683 }
684
685 # check mask
686 if( $file =~ /XXXX[^\/\\]*$/ ) {
687 my( $tmp, $i ) = ( $file, 0 );
688 do {
689 $i++;
690 $tmp = $file;
691 $tmp =~ s/XXXX([^\/\\]*)$/sprintf("%04d", $i).$1/e;
692 } while( -e $tmp && $i < 9999 );
693 $file = $tmp;
694 }
695
696 if( -f $file ) {
697 unless( -w _ ) {
698 die "File '$file' exists, but is read-only";
699 }
700 } elsif( !-e _ ) {
701 unless( File::Spec->file_name_is_absolute( $file ) ) {
702 $file = File::Spec->rel2abs( $file );
703 }
704
705 # check base dir
706 my $dir = File::Spec->join( (File::Spec->splitpath( $file ))[0,1] );
707 unless( -e $dir && -d _) {
708 die "Base directory '$dir' for file '$file' doesn't exist";
709 }
710 unless( -w $dir ) {
711 die "Base directory '$dir' is not writable";
712 }
713 } else {
714 die "'$file' is not regular file";
715 }
716
717 return $file;
718}
719
720=head4 StoragePath
721
722Returns an absolute path to the storage dir. See
c36a7e1d 723L</$ShredderStoragePath>.
84fb5b46
MKG
724
725See also description of the L</GetFileName> method.
726
727=cut
728
729sub StoragePath
730{
731 return scalar( RT->Config->Get('ShredderStoragePath') )
732 || File::Spec->catdir( $RT::VarPath, qw(data RT-Shredder) );
733}
734
735my %active_dump_state = ();
736sub AddDumpPlugin {
737 my $self = shift;
738 my %args = ( Object => undef, Name => 'SQLDump', Arguments => undef, @_ );
739
740 my $plugin = $args{'Object'};
741 unless ( $plugin ) {
742 require RT::Shredder::Plugin;
743 $plugin = RT::Shredder::Plugin->new;
744 my( $status, $msg ) = $plugin->LoadByName( $args{'Name'} );
745 die "Couldn't load dump plugin: $msg\n" unless $status;
746 }
747 die "Plugin is not of correct type" unless lc $plugin->Type eq 'dump';
748
749 if ( my $pargs = $args{'Arguments'} ) {
750 my ($status, $msg) = $plugin->TestArgs( %$pargs );
751 die "Couldn't set plugin args: $msg\n" unless $status;
752 }
753
754 my @applies_to = $plugin->AppliesToStates;
755 die "Plugin doesn't apply to any state" unless @applies_to;
756 $active_dump_state{ lc $_ } = 1 foreach @applies_to;
757
758 push @{ $self->{'dump_plugins'} }, $plugin;
759
760 return $plugin;
761}
762
763sub DumpObject {
764 my $self = shift;
765 my %args = (Object => undef, State => undef, @_);
766 die "No state passed" unless $args{'State'};
767 return unless $active_dump_state{ lc $args{'State'} };
768
769 foreach (@{ $self->{'dump_plugins'} }) {
770 next unless grep lc $args{'State'} eq lc $_, $_->AppliesToStates;
771 my ($state, $msg) = $_->Run( %args );
772 die "Couldn't run plugin: $msg" unless $state;
773 }
774}
775
776{ my $mark = 1; # XXX: integer overflows?
777sub PushDumpMark {
778 my $self = shift;
779 $mark++;
780 foreach (@{ $self->{'dump_plugins'} }) {
781 my ($state, $msg) = $_->PushMark( Mark => $mark );
782 die "Couldn't push mark: $msg" unless $state;
783 }
784 return $mark;
785}
786sub PopDumpMark {
787 my $self = shift;
788 foreach (@{ $self->{'dump_plugins'} }) {
789 my ($state, $msg) = $_->PushMark( @_ );
790 die "Couldn't pop mark: $msg" unless $state;
791 }
792}
793sub RollbackDumpTo {
794 my $self = shift;
795 foreach (@{ $self->{'dump_plugins'} }) {
796 my ($state, $msg) = $_->RollbackTo( @_ );
797 die "Couldn't rollback to mark: $msg" unless $state;
798 }
799}
800}
801
8021;
803__END__
804
805=head1 NOTES
806
807=head2 Database transactions support
808
809Since 0.03_01 RT::Shredder uses database transactions and should be
810much safer to run on production servers.
811
812=head2 Foreign keys
813
814Mainstream RT doesn't use FKs, but at least I posted DDL script that creates them
815in mysql DB, note that if you use FKs then this two valid keys don't allow delete
816Tickets because of bug in MySQL:
817
818 ALTER TABLE Tickets ADD FOREIGN KEY (EffectiveId) REFERENCES Tickets(id);
819 ALTER TABLE CachedGroupMembers ADD FOREIGN KEY (Via) REFERENCES CachedGroupMembers(id);
820
821L<http://bugs.mysql.com/bug.php?id=4042>
822
823=head1 BUGS AND HOW TO CONTRIBUTE
824
825We need your feedback in all cases: if you use it or not,
826is it works for you or not.
827
828=head2 Testing
829
830Don't skip C<make test> step while install and send me reports if it's fails.
831Add your own tests, it's easy enough if you've writen at list one perl script
832that works with RT. Read more about testing in F<t/utils.pl>.
833
834=head2 Reporting
835
836Send reports to L</AUTHOR> or to the RT mailing lists.
837
838=head2 Documentation
839
840Many bugs in the docs: insanity, spelling, gramar and so on.
841Patches are wellcome.
842
843=head2 Todo
844
845Please, see Todo file, it has some technical notes
846about what I plan to do, when I'll do it, also it
847describes some problems code has.
848
849=head2 Repository
850
851Since RT-3.7 shredder is a part of the RT distribution.
852Versions of the RTx::Shredder extension could
853be downloaded from the CPAN. Those work with older
854RT versions or you can find repository at
855L<https://opensvn.csie.org/rtx_shredder>
856
857=head1 AUTHOR
858
859 Ruslan U. Zakirov <Ruslan.Zakirov@gmail.com>
860
861=head1 COPYRIGHT
862
863This program is free software; you can redistribute
864it and/or modify it under the same terms as Perl itself.
865
866The full text of the license can be found in the
867Perl distribution.
868
869=head1 SEE ALSO
870
871L<rt-shredder>, L<rt-validator>
872
873=cut