Fixed relative path for rt-libs.
[usit-rt.git] / sbin / rt-validator
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 }}}
49 use strict;
50 use warnings;
51
52 # fix lib paths, some may be relative
53 BEGIN { # 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
69 use Getopt::Long;
70 my %opt = ();
71 GetOptions(
72     \%opt,
73     'check|c',
74     'resolve',
75     'force',
76     'verbose|v',
77     'help|h',
78     'links-only',
79 );
80
81 if ( $opt{help} || !$opt{check} ) {
82     require Pod::Usage;
83     print Pod::Usage::pod2usage( { verbose => 2 } );
84     exit 2;
85 }
86
87 usage_warning() if $opt{'resolve'} && !$opt{'force'};
88
89 sub usage_warning {
90     print <<END;
91 This utility can fix some issues with DB by creating or updating. In some
92 cases there is not enough data to resurect a missing record, but records which
93 refer to a missing record can be deleted. It's up to you to decide what to do.
94
95 In any case it's highly recommended to have a backup before resolving anything.
96
97 Press enter to continue.
98 END
99 # Read a line of text, any line of text
100     <STDIN>;
101 }
102
103 use RT;
104 RT::LoadConfig();
105 RT::Init();
106
107 my $dbh = $RT::Handle->dbh;
108 my $db_type = RT->Config->Get('DatabaseType');
109
110 my %TYPE = (
111     'Transactions.Field'    => 'text',
112     'Transactions.OldValue' => 'text',
113     'Transactions.NewValue' => 'text',
114 );
115
116 my @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
140 my %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
181 my %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 = ();
196 sub 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
204 my (@do_check, %redo_check);
205
206 my @CHECKS;
207 foreach 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
255 push @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
298 push @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
325 push @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
352 push @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
362 push @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
372 push @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
393 push @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
420 push @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;
558 SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
559     cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
560 FROM
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 )
568 WHERE cgm1.GroupId != cgm1.MemberId
569 AND gm2.GroupId = cgm1.MemberId
570 AND cgm3.id IS NULL
571 END
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
598 push @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
623 push @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
749 push @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
779 push @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
798 push @CHECKS, Templates => sub {
799     return check_integrity(
800         'Templates', 'Queue' => 'Queues', 'id',
801     );
802 };
803
804 push @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
824 push @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
838 push @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;
849 SELECT m.id, g.id, g.Instance
850 FROM
851     Groups g JOIN $table m ON g.id = m.$column
852 WHERE
853     g.Domain = ?
854     AND g.Type = ?
855 END
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
895 push @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
924 push @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
978 push @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
1011 push @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
1049 push @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
1103 my %CHECKS = @CHECKS;
1104
1105 @do_check = do { my $i = 1; grep $i++%2, @CHECKS };
1106
1107 if ($opt{'links-only'}) {
1108     @do_check = grep { /^Links:/ } @do_check;
1109 }
1110
1111 my $status = 1;
1112 while ( 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 }
1122 exit 1 unless $status;
1123 exit 0;
1124
1125 =head2 check_integrity
1126
1127 Takes two (table name, column(s)) pairs. First pair
1128 is reference we check and second is destination that
1129 must exist. Array reference can be used for multiple
1130 columns.
1131
1132 Returns 0 if a record is missing or 1 otherwise.
1133
1134 =cut
1135
1136 sub 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
1187 sub 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
1199 sub 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
1214 sub 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
1256 sub 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
1262 sub 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
1270 sub 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
1276 sub 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
1294 sub 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
1304 sub 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
1314 sub 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;
1323 sub 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;
1341 sub 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;
1362 sub 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
1378 1;
1379
1380 __END__
1381
1382 =head1 NAME
1383
1384 rt-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
1395 This script checks integrity of records in RT's DB. May delete some invalid
1396 records 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