Fixed relative path for rt-libs.
[usit-rt.git] / sbin / rt-validator
... / ...
CommitLineData
1#!/usr/bin/perl
2# BEGIN BPS TAGGED BLOCK {{{
3#
4# COPYRIGHT:
5#
6# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
7# <sales@bestpractical.com>
8#
9# (Except where explicitly superseded by other copyright notices)
10#
11#
12# LICENSE:
13#
14# This work is made available to you under the terms of Version 2 of
15# the GNU General Public License. A copy of that license should have
16# been provided with this software, but in any event can be snarfed
17# from www.gnu.org.
18#
19# This work is distributed in the hope that it will be useful, but
20# WITHOUT ANY WARRANTY; without even the implied warranty of
21# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22# General Public License for more details.
23#
24# You should have received a copy of the GNU General Public License
25# along with this program; if not, write to the Free Software
26# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27# 02110-1301 or visit their web page on the internet at
28# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
29#
30#
31# CONTRIBUTION SUBMISSION POLICY:
32#
33# (The following paragraph is not intended to limit the rights granted
34# to you to modify and distribute this software under the terms of
35# the GNU General Public License and is only of importance to you if
36# you choose to contribute your changes and enhancements to the
37# community by submitting them to Best Practical Solutions, LLC.)
38#
39# By intentionally submitting any modifications, corrections or
40# derivatives to this work, or any other work intended for use with
41# Request Tracker, to Best Practical Solutions, LLC, you confirm that
42# you are the copyright holder for those contributions and you grant
43# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
44# royalty-free, perpetual, license to use, copy, create derivative
45# works based on those contributions, and sublicense and distribute
46# those contributions and any derivatives thereof.
47#
48# END BPS TAGGED BLOCK }}}
49use strict;
50use warnings;
51
52# fix lib paths, some may be relative
53BEGIN { # BEGIN RT CMD BOILERPLATE
54 require File::Spec;
55 require Cwd;
56 my @libs = ("lib", "local/lib");
57 my $bin_path;
58
59 for my $lib (@libs) {
60 unless ( File::Spec->file_name_is_absolute($lib) ) {
61 $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
62 $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
63 }
64 unshift @INC, $lib;
65 }
66
67}
68
69use Getopt::Long;
70my %opt = ();
71GetOptions(
72 \%opt,
73 'check|c',
74 'resolve',
75 'force',
76 'verbose|v',
77 'help|h',
78 'links-only',
79);
80
81if ( $opt{help} || !$opt{check} ) {
82 require Pod::Usage;
83 print Pod::Usage::pod2usage( { verbose => 2 } );
84 exit 2;
85}
86
87usage_warning() if $opt{'resolve'} && !$opt{'force'};
88
89sub usage_warning {
90 print <<END;
91This utility can fix some issues with DB by creating or updating. In some
92cases there is not enough data to resurect a missing record, but records which
93refer to a missing record can be deleted. It's up to you to decide what to do.
94
95In any case it's highly recommended to have a backup before resolving anything.
96
97Press enter to continue.
98END
99# Read a line of text, any line of text
100 <STDIN>;
101}
102
103use RT;
104RT::LoadConfig();
105RT::Init();
106
107my $dbh = $RT::Handle->dbh;
108my $db_type = RT->Config->Get('DatabaseType');
109
110my %TYPE = (
111 'Transactions.Field' => 'text',
112 'Transactions.OldValue' => 'text',
113 'Transactions.NewValue' => 'text',
114);
115
116my @models = qw(
117 ACE
118 Attachment
119 Attribute
120 CachedGroupMember
121 CustomField
122 CustomFieldValue
123 GroupMember
124 Group
125 Link
126 ObjectCustomField
127 ObjectCustomFieldValue
128 Principal
129 Queue
130 ScripAction
131 ScripCondition
132 Scrip
133 ObjectScrip
134 Template
135 Ticket
136 Transaction
137 User
138);
139
140my %redo_on;
141$redo_on{'Delete'} = {
142 ACL => [],
143
144 Attributes => [],
145
146 Links => [],
147
148 CustomFields => [],
149 CustomFieldValues => [],
150 ObjectCustomFields => [],
151 ObjectCustomFieldValues => [],
152
153 Queues => [],
154
155 Scrips => [],
156 ObjectScrips => [],
157 ScripActions => [],
158 ScripConditions => [],
159 Templates => [],
160
161 Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
162 Transactions => [ 'Attachments -> other' ],
163
164 Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
165 Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
166 Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
167
168 GroupMembers => [ 'CGM vs. GM' ],
169 CachedGroupMembers => [ 'CGM vs. GM' ],
170};
171$redo_on{'Create'} = {
172 Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
173 Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
174 GroupMembers => [ 'CGM vs. GM' ],
175 CachedGroupMembers => [ 'CGM vs. GM' ],
176};
177$redo_on{'Update'} = {
178 Groups => ['User Defined Group Name uniqueness'],
179};
180
181my %describe_cb;
182%describe_cb = (
183 Attachments => sub {
184 my $row = shift;
185 my $txn_id = $row->{transactionid};
186 my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
187 return $res .', '. describe( 'Transactions', $txn_id );
188 },
189 Transactions => sub {
190 my $row = shift;
191 return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
192 },
193);
194
195{ my %cache = ();
196sub m2t($) {
197 my $model = shift;
198 return $cache{$model} if $cache{$model};
199 my $class = "RT::$model";
200 my $object = $class->new( RT->SystemUser );
201 return $cache{$model} = $object->Table;
202} }
203
204my (@do_check, %redo_check);
205
206my @CHECKS;
207foreach my $table ( qw(Users Groups) ) {
208 push @CHECKS, "$table -> Principals" => sub {
209 my $msg = "A record in $table refers to a nonexistent record in Principals."
210 ." The script can either create the missing record in Principals"
211 ." or delete the record in $table.";
212 my ($type) = ($table =~ /^(.*)s$/);
213 return check_integrity(
214 $table, 'id' => 'Principals', 'id',
215 join_condition => 't.PrincipalType = ?',
216 bind_values => [ $type ],
217 action => sub {
218 my $id = shift;
219 return unless my $a = prompt_action( ['Delete', 'create'], $msg );
220
221 if ( $a eq 'd' ) {
222 delete_record( $table, $id );
223 }
224 elsif ( $a eq 'c' ) {
225 my $principal_id = create_record( 'Principals',
226 id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
227 );
228 }
229 else {
230 die "Unknown action '$a'";
231 }
232 },
233 );
234 };
235
236 push @CHECKS, "Principals -> $table" => sub {
237 my $msg = "A record in Principals refers to a nonexistent record in $table."
238 ." In some cases it's possible to manually resurrect such records,"
239 ." but this utility can only delete records.";
240
241 return check_integrity(
242 'Principals', 'id' => $table, 'id',
243 condition => 's.PrincipalType = ?',
244 bind_values => [ $table =~ /^(.*)s$/ ],
245 action => sub {
246 my $id = shift;
247 return unless prompt( 'Delete', $msg );
248
249 delete_record( 'Principals', $id );
250 },
251 );
252 };
253}
254
255push @CHECKS, 'User <-> ACL equivalence group' => sub {
256 my $res = 1;
257 # from user to group
258 $res *= check_integrity(
259 'Users', 'id' => 'Groups', 'Instance',
260 join_condition => 't.Domain = ? AND t.Type = ?',
261 bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
262 action => sub {
263 my $id = shift;
264 return unless prompt(
265 'Create', "Found an user that has no ACL equivalence group."
266 );
267
268 my $gid = create_record( 'Groups',
269 Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
270 );
271 },
272 );
273 # from group to user
274 $res *= check_integrity(
275 'Groups', 'Instance' => 'Users', 'id',
276 condition => 's.Domain = ? AND s.Type = ?',
277 bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
278 action => sub {
279 my $id = shift;
280 return unless prompt(
281 'Delete', "Found an user ACL equivalence group, but there is no user."
282 );
283
284 delete_record( 'Groups', $id );
285 },
286 );
287 # one ACL equiv group for each user
288 $res *= check_uniqueness(
289 'Groups',
290 columns => ['Instance'],
291 condition => '.Domain = ? AND .Type = ?',
292 bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
293 );
294 return $res;
295};
296
297# check integrity of Queue role groups
298push @CHECKS, 'Queues <-> Role Groups' => sub {
299 # XXX: we check only that there is at least one group for a queue
300 # from queue to group
301 my $res = 1;
302 $res *= check_integrity(
303 'Queues', 'id' => 'Groups', 'Instance',
304 join_condition => 't.Domain = ?',
305 bind_values => [ 'RT::Queue-Role' ],
306 );
307 # from group to queue
308 $res *= check_integrity(
309 'Groups', 'Instance' => 'Queues', 'id',
310 condition => 's.Domain = ?',
311 bind_values => [ 'RT::Queue-Role' ],
312 action => sub {
313 my $id = shift;
314 return unless prompt(
315 'Delete', "Found a role group of a nonexistent queue."
316 );
317
318 delete_record( 'Groups', $id );
319 },
320 );
321 return $res;
322};
323
324# check integrity of Ticket role groups
325push @CHECKS, 'Tickets <-> Role Groups' => sub {
326 # XXX: we check only that there is at least one group for a queue
327 # from queue to group
328 my $res = 1;
329 $res *= check_integrity(
330 'Tickets', 'id' => 'Groups', 'Instance',
331 join_condition => 't.Domain = ?',
332 bind_values => [ 'RT::Ticket-Role' ],
333 );
334 # from group to ticket
335 $res *= check_integrity(
336 'Groups', 'Instance' => 'Tickets', 'id',
337 condition => 's.Domain = ?',
338 bind_values => [ 'RT::Ticket-Role' ],
339 action => sub {
340 my $id = shift;
341 return unless prompt(
342 'Delete', "Found a role group of a nonexistent ticket."
343 );
344
345 delete_record( 'Groups', $id );
346 },
347 );
348 return $res;
349};
350
351# additional CHECKS on groups
352push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
353 # Check that Domain, Instance and Type are unique
354 return check_uniqueness(
355 'Groups',
356 columns => ['Domain', 'Instance', 'Type'],
357 condition => '.Domain LIKE ?',
358 bind_values => [ '%-Role' ],
359 );
360};
361
362push @CHECKS, 'System internal group uniqueness' => sub {
363 return check_uniqueness(
364 'Groups',
365 columns => ['Instance', 'Type'],
366 condition => '.Domain = ?',
367 bind_values => [ 'SystemInternal' ],
368 );
369};
370
371# CHECK that user defined group names are unique
372push @CHECKS, 'User Defined Group Name uniqueness' => sub {
373 return check_uniqueness(
374 'Groups',
375 columns => ['Name'],
376 condition => '.Domain = ?',
377 bind_values => [ 'UserDefined' ],
378 extra_tables => ['Principals sp', 'Principals tp'],
379 extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)),
380 extra_values => ['Group', 'Group'],
381 action => sub {
382 return unless prompt(
383 'Rename', "Found a user defined group with a non-unique Name."
384 );
385
386 my $id = shift;
387 my %cols = @_;
388 update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) });
389 },
390 );
391};
392
393push @CHECKS, 'GMs -> Groups, Members' => sub {
394 my $msg = "A record in GroupMembers references an object that doesn't exist."
395 ." Maybe you deleted a group or principal directly from the database?"
396 ." Usually it's OK to delete such records.";
397 my $res = 1;
398 $res *= check_integrity(
399 'GroupMembers', 'GroupId' => 'Groups', 'id',
400 action => sub {
401 my $id = shift;
402 return unless prompt( 'Delete', $msg );
403
404 delete_record( 'GroupMembers', $id );
405 },
406 );
407 $res *= check_integrity(
408 'GroupMembers', 'MemberId' => 'Principals', 'id',
409 action => sub {
410 my $id = shift;
411 return unless prompt( 'Delete', $msg );
412
413 delete_record( 'GroupMembers', $id );
414 },
415 );
416 return $res;
417};
418
419# CGM and GM
420push @CHECKS, 'CGM vs. GM' => sub {
421 my $res = 1;
422 # all GM record should be duplicated in CGM
423 $res *= check_integrity(
424 GroupMembers => ['GroupId', 'MemberId'],
425 CachedGroupMembers => ['GroupId', 'MemberId'],
426 join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
427 action => sub {
428 my $id = shift;
429 return unless prompt(
430 'Create',
431 "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
432 );
433
434 my $gm = RT::GroupMember->new( RT->SystemUser );
435 $gm->Load( $id );
436 die "Couldn't load GM record #$id" unless $gm->id;
437 my $cgm = create_record( 'CachedGroupMembers',
438 GroupId => $gm->GroupId, MemberId => $gm->MemberId,
439 ImmediateParentId => $gm->GroupId, Via => undef,
440 Disabled => 0, # XXX: we should check integrity of Disabled field
441 );
442 update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
443 },
444 );
445 # all first level CGM records should have a GM record
446 $res *= check_integrity(
447 CachedGroupMembers => ['GroupId', 'MemberId'],
448 GroupMembers => ['GroupId', 'MemberId'],
449 condition => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
450 action => sub {
451 my $id = shift;
452 return unless prompt(
453 'Delete',
454 "Found a record in CachedGroupMembers for a (Group, Member) pair"
455 ." that doesn't exist in the GroupMembers table."
456 );
457
458 delete_record( 'CachedGroupMembers', $id );
459 },
460 );
461 # each group should have a CGM record where MemberId == GroupId
462 $res *= check_integrity(
463 Groups => ['id', 'id'],
464 CachedGroupMembers => ['GroupId', 'MemberId'],
465 join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
466 action => sub {
467 my $id = shift;
468 return unless prompt(
469 'Create',
470 "Found a record in Groups that has no direct"
471 ." duplicate in CachedGroupMembers table."
472 );
473
474 my $g = RT::Group->new( RT->SystemUser );
475 $g->Load( $id );
476 die "Couldn't load group #$id" unless $g->id;
477 die "Loaded group by $id has id ". $g->id unless $g->id == $id;
478 my $cgm = create_record( 'CachedGroupMembers',
479 GroupId => $id, MemberId => $id,
480 ImmediateParentId => $id, Via => undef,
481 Disabled => $g->Disabled,
482 );
483 update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
484 },
485 );
486
487 # and back, each record in CGM with MemberId == GroupId without exceptions
488 # should reference a group
489 $res *= check_integrity(
490 CachedGroupMembers => ['GroupId', 'MemberId'],
491 Groups => ['id', 'id'],
492 condition => "s.GroupId = s.MemberId",
493 action => sub {
494 my $id = shift;
495 return unless prompt(
496 'Delete',
497 "Found a record in CachedGroupMembers for a group that doesn't exist."
498 );
499
500 delete_record( 'CachedGroupMembers', $id );
501 },
502 );
503 # Via
504 $res *= check_integrity(
505 CachedGroupMembers => 'Via',
506 CachedGroupMembers => 'id',
507 action => sub {
508 my $id = shift;
509 return unless prompt(
510 'Delete',
511 "Found a record in CachedGroupMembers with Via that references a nonexistent record."
512 );
513
514 delete_record( 'CachedGroupMembers', $id );
515 },
516 );
517
518 # for every CGM where ImmediateParentId != GroupId there should be
519 # matching parent record (first level)
520 $res *= check_integrity(
521 CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
522 CachedGroupMembers => ['GroupId', 'MemberId'],
523 join_condition => 't.Via = t.id',
524 condition => 's.ImmediateParentId != s.GroupId',
525 action => sub {
526 my $id = shift;
527 return unless prompt(
528 'Delete',
529 "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
530 );
531
532 delete_record( 'CachedGroupMembers', $id );
533 },
534 );
535
536 # for every CGM where ImmediateParentId != GroupId there should be
537 # matching "grand" parent record
538 $res *= check_integrity(
539 CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
540 CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
541 condition => 's.ImmediateParentId != s.GroupId',
542 action => sub {
543 my $id = shift;
544 return unless prompt(
545 'Delete',
546 "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
547 );
548
549 delete_record( 'CachedGroupMembers', $id );
550 },
551 );
552
553 # CHECK recursive records:
554 # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
555 # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
556 {
557 my $query = <<END;
558SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
559 cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
560FROM
561 CachedGroupMembers cgm1
562 CROSS JOIN GroupMembers gm2
563 LEFT JOIN CachedGroupMembers cgm3 ON (
564 cgm3.GroupId = cgm1.GroupId
565 AND cgm3.MemberId = gm2.MemberId
566 AND cgm3.Via = cgm1.id
567 AND cgm3.ImmediateParentId = cgm1.MemberId )
568WHERE cgm1.GroupId != cgm1.MemberId
569AND gm2.GroupId = cgm1.MemberId
570AND cgm3.id IS NULL
571END
572
573 my $action = sub {
574 my %props = @_;
575 return unless prompt(
576 'Create',
577 "Found records in CachedGroupMembers table without recursive duplicates."
578 );
579 my $cgm = create_record( 'CachedGroupMembers', %props );
580 };
581
582 my $sth = execute_query( $query );
583 while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
584 $res = 0;
585 print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
586 print STDERR " but there is no cached GM record that $m is member of #$g.\n";
587 $action->(
588 GroupId => $g, MemberId => $m, Via => $via,
589 ImmediateParentId => $ip, Disabled => $dis,
590 );
591 }
592 }
593
594 return $res;
595};
596
597# Tickets
598push @CHECKS, 'Tickets -> other' => sub {
599 my $res = 1;
600 $res *= check_integrity(
601 'Tickets', 'EffectiveId' => 'Tickets', 'id',
602 action => sub {
603 my $id = shift;
604 return unless prompt(
605 'Delete',
606 "Found a ticket that's been merged into a ticket that no longer exists."
607 );
608
609 delete_record( 'Tickets', $id );
610 },
611 );
612 $res *= check_integrity(
613 'Tickets', 'Queue' => 'Queues', 'id',
614 );
615 $res *= check_integrity(
616 'Tickets', 'Owner' => 'Users', 'id',
617 );
618 # XXX: check that owner is only member of owner role group
619 return $res;
620};
621
622
623push @CHECKS, 'Transactions -> other' => sub {
624 my $res = 1;
625 foreach my $model ( @models ) {
626 $res *= check_integrity(
627 'Transactions', 'ObjectId' => m2t($model), 'id',
628 condition => 's.ObjectType = ?',
629 bind_values => [ "RT::$model" ],
630 action => sub {
631 my $id = shift;
632 return unless prompt(
633 'Delete', "Found a transaction without object."
634 );
635
636 delete_record( 'Transactions', $id );
637 },
638 );
639 }
640 # type = CustomField
641 $res *= check_integrity(
642 'Transactions', 'Field' => 'CustomFields', 'id',
643 condition => 's.Type = ?',
644 bind_values => [ 'CustomField' ],
645 );
646 # type = Take, Untake, Force, Steal or Give
647 $res *= check_integrity(
648 'Transactions', 'OldValue' => 'Users', 'id',
649 condition => 's.Type IN (?, ?, ?, ?, ?)',
650 bind_values => [ qw(Take Untake Force Steal Give) ],
651 action => sub {
652 my $id = shift;
653 return unless prompt(
654 'Delete', "Found a transaction regarding Owner changes,"
655 ." but the User with id stored in OldValue column doesn't exist anymore."
656 );
657
658 delete_record( 'Transactions', $id );
659 },
660 );
661 $res *= check_integrity(
662 'Transactions', 'NewValue' => 'Users', 'id',
663 condition => 's.Type IN (?, ?, ?, ?, ?)',
664 bind_values => [ qw(Take Untake Force Steal Give) ],
665 action => sub {
666 my $id = shift;
667 return unless prompt(
668 'Delete', "Found a transaction regarding Owner changes,"
669 ." but the User with id stored in NewValue column doesn't exist anymore."
670 );
671
672 delete_record( 'Transactions', $id );
673 },
674 );
675 # type = DelWatcher
676 $res *= check_integrity(
677 'Transactions', 'OldValue' => 'Principals', 'id',
678 condition => 's.Type = ?',
679 bind_values => [ 'DelWatcher' ],
680 action => sub {
681 my $id = shift;
682 return unless prompt(
683 'Delete', "Found a transaction describing watcher changes,"
684 ." but the User with id stored in OldValue column doesn't exist anymore."
685 );
686
687 delete_record( 'Transactions', $id );
688 },
689 );
690 # type = AddWatcher
691 $res *= check_integrity(
692 'Transactions', 'NewValue' => 'Principals', 'id',
693 condition => 's.Type = ?',
694 bind_values => [ 'AddWatcher' ],
695 action => sub {
696 my $id = shift;
697 return unless prompt(
698 'Delete', "Found a transaction describing watcher changes,"
699 ." but the User with id stored in NewValue column doesn't exist anymore."
700 );
701
702 delete_record( 'Transactions', $id );
703 },
704 );
705
706# type = DeleteLink or AddLink
707# handled in 'Links: *' checks as {New,Old}Value store URIs
708
709 # type = Set, Field = Queue
710 $res *= check_integrity(
711 'Transactions', 'NewValue' => 'Queues', 'id',
712 condition => 's.Type = ? AND s.Field = ?',
713 bind_values => [ 'Set', 'Queue' ],
714 action => sub {
715 my $id = shift;
716 return unless prompt(
717 'Delete', "Found a transaction describing a queue change,"
718 ." but the Queue with id stored in the NewValue column doesn't exist anymore."
719 );
720
721 delete_record( 'Transactions', $id );
722 },
723 );
724 $res *= check_integrity(
725 'Transactions', 'OldValue' => 'Queues', 'id',
726 condition => 's.Type = ? AND s.Field = ?',
727 bind_values => [ 'Set', 'Queue' ],
728 action => sub {
729 my $id = shift;
730 return unless prompt(
731 'Delete', "Found a transaction describing a queue change,"
732 ." but the Queue with id stored in the OldValue column doesn't exist anymore."
733 );
734
735 delete_record( 'Transactions', $id );
736 },
737 );
738 # Reminders
739 $res *= check_integrity(
740 'Transactions', 'NewValue' => 'Tickets', 'id',
741 join_condition => 't.Type = ?',
742 condition => 's.Type IN (?, ?, ?)',
743 bind_values => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
744 );
745 return $res;
746};
747
748# Attachments
749push @CHECKS, 'Attachments -> other' => sub {
750 my $res = 1;
751 $res *= check_integrity(
752 Attachments => 'TransactionId', Transactions => 'id',
753 action => sub {
754 my $id = shift;
755 return unless prompt(
756 'Delete', "Found an attachment without a transaction."
757 );
758 delete_record( 'Attachments', $id );
759 },
760 );
761 $res *= check_integrity(
762 Attachments => 'Parent', Attachments => 'id',
763 action => sub {
764 my $id = shift;
765 return unless prompt(
766 'Delete', "Found an sub-attachment without its parent attachment."
767 );
768 delete_record( 'Attachments', $id );
769 },
770 );
771 $res *= check_integrity(
772 Attachments => 'Parent',
773 Attachments => 'id',
774 join_condition => 's.TransactionId = t.TransactionId',
775 );
776 return $res;
777};
778
779push @CHECKS, 'CustomFields and friends' => sub {
780 my $res = 1;
781 #XXX: ObjectCustomFields needs more love
782 $res *= check_integrity(
783 'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
784 );
785 $res *= check_integrity(
786 'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
787 );
788 foreach my $model ( @models ) {
789 $res *= check_integrity(
790 'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
791 condition => 's.ObjectType = ?',
792 bind_values => [ "RT::$model" ],
793 );
794 }
795 return $res;
796};
797
798push @CHECKS, Templates => sub {
799 return check_integrity(
800 'Templates', 'Queue' => 'Queues', 'id',
801 );
802};
803
804push @CHECKS, Scrips => sub {
805 my $res = 1;
806 $res *= check_integrity(
807 'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
808 );
809 $res *= check_integrity(
810 'Scrips', 'ScripAction' => 'ScripActions', 'id',
811 );
812 $res *= check_integrity(
813 'Scrips', 'Template' => 'Templates', 'Name',
814 );
815 $res *= check_integrity(
816 'ObjectScrips', 'Scrip' => 'Scrips', 'id',
817 );
818 $res *= check_integrity(
819 'ObjectScrips', 'ObjectId' => 'Queues', 'id',
820 );
821 return $res;
822};
823
824push @CHECKS, Attributes => sub {
825 my $res = 1;
826 foreach my $model ( @models ) {
827 $res *= check_integrity(
828 'Attributes', 'ObjectId' => m2t($model), 'id',
829 condition => 's.ObjectType = ?',
830 bind_values => [ "RT::$model" ],
831 );
832 }
833 return $res;
834};
835
836# Fix situations when Creator or LastUpdatedBy references ACL equivalence
837# group of a user instead of user
838push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
839 my $res = 1;
840 my %fix = ();
841 foreach my $model ( @models ) {
842 my $class = "RT::$model";
843 my $object = $class->new( RT->SystemUser );
844 foreach my $column ( qw(LastUpdatedBy Creator) ) {
845 next unless $object->_Accessible( $column, 'auto' );
846
847 my $table = m2t($model);
848 my $query = <<END;
849SELECT m.id, g.id, g.Instance
850FROM
851 Groups g JOIN $table m ON g.id = m.$column
852WHERE
853 g.Domain = ?
854 AND g.Type = ?
855END
856 my $action = sub {
857 my ($gid, $uid) = @_;
858 return unless prompt(
859 'Update',
860 "Looks like there were a bug in old versions of RT back in 2006\n"
861 ."that has been fixed. If other checks are ok then it's ok to update\n"
862 ."these records to point them to users instead of groups"
863 );
864 $fix{ $table }{ $column }{ $gid } = $uid;
865 };
866
867 my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
868 while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
869 $res = 0;
870 print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
871 print STDERR " when must reference user.\n";
872 $action->( $gid, $uid );
873 if ( keys( %fix ) > 1000 ) {
874 $sth->finish;
875 last;
876 }
877 }
878 }
879 }
880
881 if ( keys %fix ) {
882 foreach my $table ( keys %fix ) {
883 foreach my $column ( keys %{ $fix{ $table } } ) {
884 my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
885 while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
886 update_records( $table, { $column => $gid }, { $column => $uid } );
887 }
888 }
889 }
890 $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
891 }
892 return $res;
893};
894
895push @CHECKS, 'LastUpdatedBy and Creator' => sub {
896 my $res = 1;
897 foreach my $model ( @models ) {
898 my $class = "RT::$model";
899 my $object = $class->new( RT->SystemUser );
900 my $table = $object->Table;
901 foreach my $column ( qw(LastUpdatedBy Creator) ) {
902 next unless $object->_Accessible( $column, 'auto' );
903 $res *= check_integrity(
904 $table, $column => 'Users', 'id',
905 action => sub {
906 my ($id, %prop) = @_;
907 return unless my $replace_with = prompt_integer(
908 'Replace',
909 "Column $column should point to a user, but there is record #$id in table $table\n"
910 ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
911 ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
912 ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
913 ."or something like that.",
914 "$table.$column -> user #$prop{$column}"
915 );
916 update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
917 },
918 );
919 }
920 }
921 return $res;
922};
923
924push @CHECKS, 'Links: wrong organization' => sub {
925 my $res = 1;
926 my @URI_USES = (
927 { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
928 { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
929 { model => 'Link', column => 'Target' },
930 { model => 'Link', column => 'Base' },
931 );
932
933 my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
934 my $scheme = $rt_uri->Scheme;
935 my $prefix = $rt_uri->LocalURIPrefix;
936
937 foreach my $use ( @URI_USES ) {
938 my $table = m2t( $use->{'model'} );
939 my $column = $use->{'column'};
940
941 my $query = "SELECT id, $column FROM $table WHERE"
942 . " $column LIKE ? AND $column NOT LIKE ?";
943 my @binds = ($scheme ."://%", $prefix ."%");
944
945 while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
946 $query .= " AND $k = ?";
947 push @binds, $v;
948 }
949 my $sth = execute_query( $query, @binds );
950 while ( my ($id, $value) = $sth->fetchrow_array ) {
951 $res = 0;
952 print STDERR "Record #$id in $table. Value of $column column most probably is an incorrect link\n";
953 my ($wrong_org) = ( $value =~ m{^\Q$scheme\E://(.+)/[^/]+/[0-9]*$} );
954 next unless my $replace_with = prompt(
955 'Replace',
956 "Column $column in $table is a link. Local links has scheme '$scheme'"
957 ." followed by organization name from the config file. There is record"
958 ." #$id that has scheme '$scheme', but organization is '$wrong_org'."
959 ." Most probably you changed organization, but didn't update links."
960 ." It's ok to replace these wrong links.\n",
961 "Links: wrong organization $wrong_org"
962 );
963
964 print "Updating record(s) in $table\n" if $opt{'verbose'};
965 my $wrong_prefix = $scheme . '://'. $wrong_org;
966 my $query = "UPDATE $table SET $column = ". sql_concat('?', "SUBSTR($column, ?)")
967 ." WHERE $column LIKE ?";
968 execute_query( $query, $prefix, length($wrong_prefix)+1, $wrong_prefix .'/%' );
969
970 $redo_check{'Links: wrong organization'} = 1;
971 $redo_check{'Links: LocalX for non-ticket'} = 1;
972 last; # plenty of chances we covered all cases with one update
973 }
974 }
975 return $res;
976};
977
978push @CHECKS, 'Links: LocalX for non-ticket' => sub {
979 my $res = 1;
980 my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
981 my $scheme = $rt_uri->Scheme;
982 my $prefix = $rt_uri->LocalURIPrefix;
983 my $table = m2t('Link');
984
985 foreach my $dir ( 'Target', 'Base' ) {
986 # we look only at links with correct organization, previouse check deals
987 # with incorrect orgs
988 my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir NOT LIKE ?";
989 my @binds = ($prefix ."/%", $prefix ."/ticket/%");
990
991 my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
992 while ( my ($id, $value) = $sth->fetchrow_array ) {
993 $res = 0;
994 print STDERR "Record #$id in $table. Value of Local$dir is not 0\n";
995 next unless my $replace_with = prompt(
996 'Replace',
997 "Column Local$dir in $table should be 0 if $dir column is not link"
998 ." to a ticket. It's ok to replace with 0.\n",
999 );
1000
1001 print "Updating record(s) in $table\n" if $opt{'verbose'};
1002 execute_query( "UPDATE $table SET Local$dir = 0 WHERE $where", @binds );
1003 $redo_check{'Links: wrong organization'} = 1;
1004
1005 last; # we covered all cases with one update
1006 }
1007 }
1008 return $res;
1009};
1010
1011push @CHECKS, 'Links: LocalX != X' => sub {
1012 my $res = 1;
1013 my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
1014 my $scheme = $rt_uri->Scheme;
1015 my $prefix = $rt_uri->LocalURIPrefix .'/ticket/';
1016 my $table = m2t('Link');
1017
1018 foreach my $dir ( 'Target', 'Base' ) {
1019 # we limit to $dir = */ticket/* so it doesn't conflict with previouse check
1020 # previouse check is more important as there was a bug in RT when Local$dir
1021 # was set for not tickets
1022 # XXX: we have issue with MergedInto links - "LocalX !~ X"
1023 my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir != ". sql_concat('?', "Local$dir")
1024 ." AND Type != ?";
1025 my @binds = ($prefix ."%", $prefix, 'MergedInto');
1026
1027 my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
1028 while ( my ($id, $value) = $sth->fetchrow_array ) {
1029 $res = 0;
1030 print STDERR "Record #$id in $table. Value of $dir doesn't match ticket id in Local$dir\n";
1031 next unless my $replace_with = prompt(
1032 'Replace',
1033 "For ticket links column $dir in $table table should end with"
1034 ." ticket id from Local$dir. It's probably ok to fix $dir column.\n",
1035 );
1036
1037 print "Updating record(s) in $table\n" if $opt{'verbose'};
1038 execute_query(
1039 "UPDATE $table SET $dir = ". sql_concat('?', "Local$dir") ." WHERE $where",
1040 $prefix, @binds
1041 );
1042
1043 last; # we covered all cases with one update
1044 }
1045 }
1046 return $res;
1047};
1048
1049push @CHECKS, 'Links: missing object' => sub {
1050 my $res = 1;
1051 my @URI_USES = (
1052 { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
1053 { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
1054 { model => 'Link', column => 'Target' },
1055 { model => 'Link', column => 'Base' },
1056 );
1057
1058 my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
1059 my $scheme = $rt_uri->Scheme;
1060 my $prefix = $rt_uri->LocalURIPrefix;
1061
1062 foreach my $use ( @URI_USES ) {
1063 my $stable = m2t( $use->{'model'} );
1064 my $scolumn = $use->{'column'};
1065
1066 foreach my $tmodel ( @models ) {
1067 my $tclass = 'RT::'. $tmodel;
1068 my $ttable = m2t($tmodel);
1069
1070 my $tprefix = $prefix .'/'. ($tclass eq 'RT::Ticket'? 'ticket' : $tclass) .'/';
1071
1072 my $query = "SELECT s.id FROM $stable s LEFT JOIN $ttable t "
1073 ." ON t.id = ". sql_str2int("SUBSTR(s.$scolumn, ?)")
1074 ." WHERE s.$scolumn LIKE ? AND t.id IS NULL";
1075 my @binds = (length($tprefix) + 1, $tprefix.'%');
1076
1077 while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
1078 $query .= " AND s.$k = ?";
1079 push @binds, $v;
1080 }
1081
1082 my $sth = execute_query( $query, @binds );
1083 while ( my ($sid) = $sth->fetchrow_array ) {
1084 $res = 0;
1085 print STDERR "Link in $scolumn column in record #$sid in $stable table points"
1086 ." to not existing object.\n";
1087 next unless prompt(
1088 'Delete',
1089 "Column $scolumn in $stable table is a link to an object that doesn't exist."
1090 ." You can delete such records, however make sure there is no other"
1091 ." errors with links.\n",
1092 'Link to a missing object in $ttable'
1093 );
1094
1095 delete_record($stable, $sid);
1096 }
1097 }
1098 }
1099 return $res;
1100};
1101
1102
1103my %CHECKS = @CHECKS;
1104
1105@do_check = do { my $i = 1; grep $i++%2, @CHECKS };
1106
1107if ($opt{'links-only'}) {
1108 @do_check = grep { /^Links:/ } @do_check;
1109}
1110
1111my $status = 1;
1112while ( my $check = shift @do_check ) {
1113 $status *= $CHECKS{ $check }->();
1114
1115 foreach my $redo ( keys %redo_check ) {
1116 die "check $redo doesn't exist" unless $CHECKS{ $redo };
1117 delete $redo_check{ $redo };
1118 next if grep $_ eq $redo, @do_check; # don't do twice
1119 push @do_check, $redo;
1120 }
1121}
1122exit 1 unless $status;
1123exit 0;
1124
1125=head2 check_integrity
1126
1127Takes two (table name, column(s)) pairs. First pair
1128is reference we check and second is destination that
1129must exist. Array reference can be used for multiple
1130columns.
1131
1132Returns 0 if a record is missing or 1 otherwise.
1133
1134=cut
1135
1136sub check_integrity {
1137 my ($stable, @scols) = (shift, shift);
1138 my ($ttable, @tcols) = (shift, shift);
1139 my %args = @_;
1140
1141 @scols = @{ $scols[0] } if ref $scols[0];
1142 @tcols = @{ $tcols[0] } if ref $tcols[0];
1143
1144 print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
1145 if $opt{'verbose'};
1146
1147 my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
1148 ." FROM $stable s LEFT JOIN $ttable t"
1149 ." ON (". join(
1150 ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
1151 ) .")"
1152 . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
1153 ." WHERE t.id IS NULL"
1154 ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
1155
1156 $query .= " AND ( $args{'condition'} )" if $args{'condition'};
1157
1158 my @binds = @{ $args{'bind_values'} || [] };
1159 if ( $tcols[0] eq 'id' && @tcols == 1 ) {
1160 my $type = $TYPE{"$stable.$scols[0]"} || 'number';
1161 if ( $type eq 'number' ) {
1162 $query .= " AND s.$scols[0] != ?"
1163 }
1164 elsif ( $type eq 'text' ) {
1165 $query .= " AND s.$scols[0] NOT LIKE ?"
1166 }
1167 push @binds, 0;
1168 }
1169
1170 my $res = 1;
1171
1172 my $sth = execute_query( $query, @binds );
1173 while ( my ($sid, @set) = $sth->fetchrow_array ) {
1174 $res = 0;
1175
1176 print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n";
1177 for ( my $i = 0; $i < @scols; $i++ ) {
1178 print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
1179 }
1180 print STDERR "\t". describe( $stable, $sid ) ."\n";
1181 $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) )
1182 if $args{'action'};
1183 }
1184 return $res;
1185}
1186
1187sub describe {
1188 my ($table, $id) = @_;
1189 return '' unless my $cb = $describe_cb{ $table };
1190
1191 my $row = load_record( $table, $id );
1192 unless ( $row->{id} ) {
1193 $table =~ s/s$//;
1194 return "$table doesn't exist";
1195 }
1196 return $cb->( $row );
1197}
1198
1199sub columns_eq_cond {
1200 my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
1201 my $ltype = $TYPE{"$lt.$lc"} || 'number';
1202 my $rtype = $TYPE{"$rt.$rc"} || 'number';
1203 return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
1204
1205 if ( $rtype eq 'text' ) {
1206 return "$ra.$rc LIKE CAST($la.$lc AS text)";
1207 }
1208 elsif ( $ltype eq 'text' ) {
1209 return "$la.$lc LIKE CAST($ra.$rc AS text)";
1210 }
1211 else { die "don't know how to cast" }
1212}
1213
1214sub check_uniqueness {
1215 my $on = shift;
1216 my %args = @_;
1217
1218 my @columns = @{ $args{'columns'} };
1219
1220 print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
1221 if $opt{'verbose'};
1222
1223 my ($scond, $tcond);
1224 if ( $scond = $tcond = $args{'condition'} ) {
1225 $scond =~ s/(\s|^)\./$1s./g;
1226 $tcond =~ s/(\s|^)\./$1t./g;
1227 }
1228
1229 my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
1230 ." FROM $on s LEFT JOIN $on t "
1231 ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
1232 . ($tcond? " AND ( $tcond )": "")
1233 . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "")
1234 ." WHERE t.id IS NOT NULL "
1235 ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
1236 $query .= " AND ( $scond )" if $scond;
1237 $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'};
1238
1239 my $sth = execute_query(
1240 $query,
1241 $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
1242 $args{'extra_values'}? (@{ $args{'extra_values'} }): ()
1243 );
1244 my $res = 1;
1245 while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
1246 $res = 0;
1247 print STDERR "Record #$tid in $on has the same set of values as $sid\n";
1248 for ( my $i = 0; $i < @columns; $i++ ) {
1249 print STDERR "\t$columns[$i] => '$set[$i]'\n";
1250 }
1251 $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'};
1252 }
1253 return $res;
1254}
1255
1256sub load_record {
1257 my ($table, $id) = @_;
1258 my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
1259 return $sth->fetchrow_hashref('NAME_lc');
1260}
1261
1262sub delete_record {
1263 my ($table, $id) = (@_);
1264 print "Deleting record #$id in $table\n" if $opt{'verbose'};
1265 my $query = "DELETE FROM $table WHERE id = ?";
1266 $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
1267 return execute_query( $query, $id );
1268}
1269
1270sub create_record {
1271 print "Creating a record in $_[0]\n" if $opt{'verbose'};
1272 $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
1273 return $RT::Handle->Insert( @_ );
1274}
1275
1276sub update_records {
1277 my $table = shift;
1278 my $where = shift;
1279 my $what = shift;
1280
1281 my (@where_cols, @where_binds);
1282 while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
1283
1284 my (@what_cols, @what_binds);
1285 while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
1286
1287 print "Updating record(s) in $table\n" if $opt{'verbose'};
1288 my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
1289 ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
1290 $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
1291 return execute_query( $query, @what_binds, @where_binds );
1292}
1293
1294sub execute_query {
1295 my ($query, @binds) = @_;
1296
1297 print "Executing query: $query\n\n" if $opt{'verbose'};
1298
1299 my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
1300 $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
1301 return $sth;
1302}
1303
1304sub sql_concat {
1305 return $_[0] if @_ <= 1;
1306
1307 my $db_type = RT->Config->Get('DatabaseType');
1308 if ( $db_type eq 'Pg' || $db_type eq 'SQLite' ) {
1309 return '('. join( ' || ', @_ ) .')';
1310 }
1311 return sql_concat('CONCAT('. join( ', ', splice @_, 0, 2 ).')', @_);
1312}
1313
1314sub sql_str2int {
1315 my $db_type = RT->Config->Get('DatabaseType');
1316 if ( $db_type eq 'Pg' ) {
1317 return "($_[0])::integer";
1318 }
1319 return $_[0];
1320}
1321
1322{ my %cached_answer;
1323sub prompt {
1324 my $action = shift;
1325 my $msg = shift;
1326 my $token = shift || join ':', caller;
1327
1328 return 0 unless $opt{'resolve'};
1329 return 1 if $opt{'force'};
1330
1331 return $cached_answer{ $token } if exists $cached_answer{ $token };
1332
1333 print $msg, "\n";
1334 print "$action ALL records with the same defect? [N]: ";
1335 my $a = <STDIN>;
1336 return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
1337 return $cached_answer{ $token } = 0;
1338} }
1339
1340{ my %cached_answer;
1341sub prompt_action {
1342 my $actions = shift;
1343 my $msg = shift;
1344 my $token = shift || join ':', caller;
1345
1346 return '' unless $opt{'resolve'};
1347 return '' if $opt{'force'};
1348 return $cached_answer{ $token } if exists $cached_answer{ $token };
1349
1350 print $msg, "\n";
1351 print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
1352 my $a = <STDIN>;
1353 chomp $a;
1354 return $cached_answer{ $token } = '' unless $a;
1355 foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
1356 return $cached_answer{ $token } = lc substr $a, 0, 1;
1357 }
1358 return $cached_answer{ $token } = '';
1359} }
1360
1361{ my %cached_answer;
1362sub prompt_integer {
1363 my $action = shift;
1364 my $msg = shift;
1365 my $token = shift || join ':', caller;
1366
1367 return 0 unless $opt{'resolve'};
1368 return 0 if $opt{'force'};
1369
1370 return $cached_answer{ $token } if exists $cached_answer{ $token };
1371
1372 print $msg, "\n";
1373 print "$action ALL records with the same defect? [0]: ";
1374 my $a = <STDIN>; chomp $a; $a = int($a);
1375 return $cached_answer{ $token } = $a;
1376} }
1377
13781;
1379
1380__END__
1381
1382=head1 NAME
1383
1384rt-validator - check and correct validity of records in RT's database
1385
1386=head1 SYNOPSIS
1387
1388 rt-validator --check
1389 rt-validator --check --verbose
1390 rt-validator --check --verbose --resolve
1391 rt-validator --check --verbose --resolve --force
1392
1393=head1 DESCRIPTION
1394
1395This script checks integrity of records in RT's DB. May delete some invalid
1396records or ressurect accidentally deleted.
1397
1398=head1 OPTIONS
1399
1400=over
1401
1402=item check
1403
1404 mandatory.
1405
1406 it's equal to -c
1407
1408=item verbose
1409
1410 print additional info to STDOUT
1411 it's equal to -v
1412
1413=item resolve
1414
1415 enable resolver that can delete or create some records
1416
1417=item force
1418
1419 resolve without asking questions
1420
1421=item links-only
1422
1423 only run the Link validation routines, useful if you changed your Organization
1424
1425=back
1426