]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
5 | # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC | |
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 | ||
49 | package RT::Shredder; | |
50 | ||
51 | use strict; | |
52 | use warnings; | |
53 | ||
54 | ||
55 | ||
56 | =head1 NAME | |
57 | ||
58 | RT::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 | ||
69 | RT::Shredder is extension to RT which allows you to permanently wipeout | |
70 | data from the RT database. Shredder supports the wiping of almost | |
71 | all RT objects (Tickets, Transactions, Attachments, Users...). | |
72 | ||
73 | ||
74 | =head2 "Delete" vs "Wipeout" | |
75 | ||
76 | RT uses the term "delete" to mean "deactivate". To avoid confusion, | |
77 | RT::Shredder uses the term "Wipeout" to mean "permanently erase" (or | |
78 | what most people would think of as "delete"). | |
79 | ||
80 | ||
81 | =head2 Why do you want this? | |
82 | ||
83 | Normally in RT, "deleting" an item simply deactivates it and makes it | |
84 | invisible from view. This is done to retain full history and | |
85 | auditability of your tickets. For most RT users this is fine and they | |
86 | have no need of RT::Shredder. | |
87 | ||
88 | But in some large and heavily used RT instances the database can get | |
89 | clogged up with junk, particularly spam. This can slow down searches | |
90 | and bloat the size of the database. For these users, RT::Shredder | |
91 | allows them to completely clear the database of this unwanted junk. | |
92 | ||
93 | An additional use of Shredder is to obliterate sensitive information | |
94 | (passwords, credit card numbers, ...) which might have made their way | |
95 | into RT. | |
96 | ||
97 | ||
98 | =head2 Command line tools (CLI) | |
99 | ||
100 | L<rt-shredder> is a program which allows you to wipe objects from | |
101 | command line or with system tasks scheduler (cron, for example). | |
102 | See also 'rt-shredder --help'. | |
103 | ||
104 | ||
105 | =head2 Web based interface (WebUI) | |
106 | ||
107 | Shredder's WebUI integrates into RT's WebUI. You can find it in the | |
108 | Configuration->Tools->Shredder tab. The interface is similar to the | |
109 | CLI and gives you the same functionality. You can find 'Shredder' link | |
110 | at the bottom of tickets search results, so you could wipeout tickets | |
111 | in the way similar to the bulk update. | |
112 | ||
113 | ||
114 | =head1 DATA STORAGE AND BACKUPS | |
115 | ||
116 | Shredder allows you to store data you wiped in files as scripts with SQL | |
117 | commands. | |
118 | ||
119 | =head3 Restoring from backup | |
120 | ||
121 | Should you wipeout something you did not intend to the objects can be | |
122 | restored by using the storage files. These files are a simple set of | |
123 | SQL commands to re-insert your objects into the RT database. | |
124 | ||
125 | 1) 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 | ||
130 | 2) 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 | ||
136 | That's it.i This will restore everything you'd deleted during a | |
137 | shredding session when the file had been created. | |
138 | ||
139 | =head1 CONFIGURATION | |
140 | ||
141 | =head2 $DependenciesLimit | |
142 | ||
143 | Shredder stops with an error if the object has more than | |
144 | C<$DependenciesLimit> dependencies. For example: a ticket has 1000 | |
145 | transactions or a transaction has 1000 attachments. This is protection | |
146 | from bugs in shredder from wiping out your whole database, but | |
147 | sometimes when you have big mail loops you may hit it. | |
148 | ||
149 | Defaults to 1000. To change this (for example, to 10000) add the | |
150 | following to your F<RT_SiteConfig.pm>: | |
151 | ||
152 | Set( $DependenciesLimit, 10_000 );> | |
153 | ||
154 | ||
155 | =head2 $ShredderStoragePath | |
156 | ||
157 | Directory containing Shredder backup dumps; defaults to | |
158 | F</opt/rt4/var/data/RT-Shredder> (assuming an /opt/rt4 installation). | |
159 | ||
160 | To change this (for example, to /some/backup/path) add the following to | |
161 | your F<RT_SiteConfig.pm>: | |
162 | ||
163 | Set( $ShredderStoragePath, "/some/backup/path" );> | |
164 | ||
165 | Be sure to specify an absolute path. | |
166 | ||
167 | ||
168 | =head1 INFORMATION FOR DEVELOPERS | |
169 | ||
170 | =head2 General API | |
171 | ||
172 | L<RT::Shredder> is an extension to RT which adds shredder methods to | |
173 | RT objects and classes. The API is not well documented yet, but you | |
174 | can find usage examples in L<rt-shredder> and the | |
175 | F<lib/t/regression/shredder/*.t> test files. | |
176 | ||
177 | However, here is a small example that do the same action as in CLI | |
178 | example 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 | ||
193 | L<RT::Shredder> implements interfaces to objects cache, actions on the | |
194 | objects in the cache and backups storage. | |
195 | ||
196 | =cut | |
197 | ||
198 | our $VERSION = '0.04'; | |
199 | use File::Spec (); | |
200 | ||
201 | ||
202 | BEGIN { | |
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 | ||
235 | our @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 | ||
262 | C<RT::Shredder::Init()> should be called before creating an | |
263 | RT::Shredder object. It iniitalizes RT and loads the RT | |
264 | configuration. | |
265 | ||
266 | %default_options are passed to every C<<RT::Shredder->new>> call. | |
267 | ||
268 | =cut | |
269 | ||
270 | our %opt = (); | |
271 | ||
272 | sub Init | |
273 | { | |
274 | %opt = @_; | |
275 | RT::LoadConfig(); | |
276 | RT::Init(); | |
277 | } | |
278 | ||
279 | =head4 new | |
280 | ||
281 | my $shredder = RT::Shredder->new(%options); | |
282 | ||
283 | Construct a new RT::Shredder object. | |
284 | ||
285 | There currently are no %options. | |
286 | ||
287 | =cut | |
288 | ||
289 | sub new | |
290 | { | |
291 | my $proto = shift; | |
292 | my $self = bless( {}, ref $proto || $proto ); | |
293 | $self->_Init( @_ ); | |
294 | return $self; | |
295 | } | |
296 | ||
297 | sub _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 | ||
308 | Cast objects to the C<RT::Record> objects or its ancesstors. | |
309 | Objects can be passed as SCALAR (format C<< <class>-<id> >>), | |
310 | ARRAY, C<RT::Record> ancesstors or C<RT::SearchBuilder> ancesstor. | |
311 | ||
312 | Most methods that takes C<Objects> argument use this method to | |
313 | cast argument value to list of records. | |
314 | ||
315 | Returns an array of records. | |
316 | ||
317 | For 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 | ||
329 | sub 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 | ||
378 | Puts objects into cache. | |
379 | ||
380 | Returns array of the cache entries. | |
381 | ||
382 | See C<CastObjectsToRecords> method for supported types of the C<Objects> | |
383 | argument. | |
384 | ||
385 | =cut | |
386 | ||
387 | sub 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 | ||
402 | Puts record object into cache and returns its cache entry. | |
403 | ||
404 | B<NOTE> that this method support B<only C<RT::Record> object or its ancesstor | |
405 | objects>, if you want put mutliple objects or objects represented by different | |
406 | classes then use C<PutObjects> method instead. | |
407 | ||
408 | =cut | |
409 | ||
410 | sub 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 | ||
426 | Returns record object from cache, cache entry state or cache entry accordingly. | |
427 | ||
428 | All three methods takes C<String> (format C<< <class>-<id> >>) or C<Object> argument. | |
429 | C<String> argument has more priority than C<Object> so if it's not empty then methods | |
430 | leave C<Object> argument unchecked. | |
431 | ||
432 | You can read about possible states and their meanings in L<RT::Shredder::Constants> docs. | |
433 | ||
434 | =cut | |
435 | ||
436 | sub _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 | ||
453 | sub GetObject { return (shift)->GetRecord( @_ )->{'Object'} } | |
454 | sub GetState { return (shift)->GetRecord( @_ )->{'State'} } | |
455 | sub 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 | ||
466 | TODO: These methods have no documentation. | |
467 | ||
468 | =cut | |
469 | ||
470 | sub 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 | ||
492 | sub 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 | ||
512 | sub 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 | ||
538 | sub 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 | ||
548 | sub 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 | ||
568 | sub _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 | ||
614 | sub 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 | ||
629 | Takes desired C<FileName> and flag C<FromStorage> then translate file name to absolute | |
630 | path 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 | ||
642 | Returns an absolute path of the file. | |
643 | ||
644 | Examples: | |
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 | ||
665 | sub 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 | ||
722 | Returns an absolute path to the storage dir. See | |
723 | L<CONFIGURATION/$ShredderStoragePath>. | |
724 | ||
725 | See also description of the L</GetFileName> method. | |
726 | ||
727 | =cut | |
728 | ||
729 | sub StoragePath | |
730 | { | |
731 | return scalar( RT->Config->Get('ShredderStoragePath') ) | |
732 | || File::Spec->catdir( $RT::VarPath, qw(data RT-Shredder) ); | |
733 | } | |
734 | ||
735 | my %active_dump_state = (); | |
736 | sub 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 | ||
763 | sub 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? | |
777 | sub 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 | } | |
786 | sub 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 | } | |
793 | sub 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 | ||
802 | 1; | |
803 | __END__ | |
804 | ||
805 | =head1 NOTES | |
806 | ||
807 | =head2 Database transactions support | |
808 | ||
809 | Since 0.03_01 RT::Shredder uses database transactions and should be | |
810 | much safer to run on production servers. | |
811 | ||
812 | =head2 Foreign keys | |
813 | ||
814 | Mainstream RT doesn't use FKs, but at least I posted DDL script that creates them | |
815 | in mysql DB, note that if you use FKs then this two valid keys don't allow delete | |
816 | Tickets 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 | ||
821 | L<http://bugs.mysql.com/bug.php?id=4042> | |
822 | ||
823 | =head1 BUGS AND HOW TO CONTRIBUTE | |
824 | ||
825 | We need your feedback in all cases: if you use it or not, | |
826 | is it works for you or not. | |
827 | ||
828 | =head2 Testing | |
829 | ||
830 | Don't skip C<make test> step while install and send me reports if it's fails. | |
831 | Add your own tests, it's easy enough if you've writen at list one perl script | |
832 | that works with RT. Read more about testing in F<t/utils.pl>. | |
833 | ||
834 | =head2 Reporting | |
835 | ||
836 | Send reports to L</AUTHOR> or to the RT mailing lists. | |
837 | ||
838 | =head2 Documentation | |
839 | ||
840 | Many bugs in the docs: insanity, spelling, gramar and so on. | |
841 | Patches are wellcome. | |
842 | ||
843 | =head2 Todo | |
844 | ||
845 | Please, see Todo file, it has some technical notes | |
846 | about what I plan to do, when I'll do it, also it | |
847 | describes some problems code has. | |
848 | ||
849 | =head2 Repository | |
850 | ||
851 | Since RT-3.7 shredder is a part of the RT distribution. | |
852 | Versions of the RTx::Shredder extension could | |
853 | be downloaded from the CPAN. Those work with older | |
854 | RT versions or you can find repository at | |
855 | L<https://opensvn.csie.org/rtx_shredder> | |
856 | ||
857 | =head1 AUTHOR | |
858 | ||
859 | Ruslan U. Zakirov <Ruslan.Zakirov@gmail.com> | |
860 | ||
861 | =head1 COPYRIGHT | |
862 | ||
863 | This program is free software; you can redistribute | |
864 | it and/or modify it under the same terms as Perl itself. | |
865 | ||
866 | The full text of the license can be found in the | |
867 | Perl distribution. | |
868 | ||
869 | =head1 SEE ALSO | |
870 | ||
871 | L<rt-shredder>, L<rt-validator> | |
872 | ||
873 | =cut |