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