2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
7 # <sales@bestpractical.com>
9 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
31 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
48 # END BPS TAGGED BLOCK }}}
52 # fix lib paths, some may be relative
55 my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
59 unless ( File::Spec->file_name_is_absolute($lib) ) {
61 if ( File::Spec->file_name_is_absolute(__FILE__) ) {
62 $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
67 $bin_path = $FindBin::Bin;
70 $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
87 usage() unless $opt{'check'};
88 usage_warning() if $opt{'resolve'} && !$opt{'force'};
98 $0 --check --verbose --resolve
99 $0 --check --verbose --resolve --force
101 --check - is mandatory argument, you can use -c, as well.
102 --verbose - print additional info to STDOUT
103 --resolve - enable resolver that can delete or create some records
104 --force - resolve without asking questions
108 This script checks integrity of records in RT's DB. May delete some invalid
109 records or ressurect accidentally deleted.
117 This utility can fix some issues with DB by creating or updating. In some
118 cases there is no enough data to resurect a missing record, but records which
119 refers to a missing can be deleted. It's up to you to decide what to do.
121 In any case it's highly recommended to have a backup before resolving anything.
123 Press enter to continue.
132 my $dbh = $RT::Handle->dbh;
133 my $db_type = RT->Config->Get('DatabaseType');
136 'Transactions.Field' => 'text',
137 'Transactions.OldValue' => 'text',
138 'Transactions.NewValue' => 'text',
152 ObjectCustomFieldValue
165 $redo_on{'Delete'} = {
173 CustomFieldValues => [],
174 ObjectCustomFields => [],
175 ObjectCustomFieldValues => [],
181 ScripConditions => [],
184 Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
185 Transactions => [ 'Attachments -> other' ],
187 Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
188 Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
189 Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
191 GroupMembers => [ 'CGM vs. GM' ],
192 CachedGroupMembers => [ 'CGM vs. GM' ],
194 $redo_on{'Create'} = {
195 Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
196 Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
197 GroupMembers => [ 'CGM vs. GM' ],
198 CachedGroupMembers => [ 'CGM vs. GM' ],
205 my $txn_id = $row->{transactionid};
206 my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
207 return $res .', '. describe( 'Transactions', $txn_id );
209 Transactions => sub {
211 return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
218 return $cache{$model} if $cache{$model};
219 my $class = "RT::$model";
220 my $object = $class->new( $RT::SystemUser );
221 return $cache{$model} = $object->Table;
224 my (@do_check, %redo_check);
227 foreach my $table ( qw(Users Groups) ) {
228 push @CHECKS, "$table -> Principals" => sub {
229 my $msg = "A record in $table refers not existing record in Principals."
230 ." The script can either create missing record in Principals"
231 ." or delete record in $table.";
232 my ($type) = ($table =~ /^(.*)s$/);
234 $table, 'id' => 'Principals', 'id',
235 join_condition => 't.PrincipalType = ?',
236 bind_values => [ $type ],
239 return unless my $a = prompt_action( ['Delete', 'create'], $msg );
242 delete_record( $table, $id );
244 elsif ( $a eq 'c' ) {
245 my $principal_id = create_record( 'Principals',
246 id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
250 die "Unknown action '$a'";
256 push @CHECKS, "Principals -> $table" => sub {
257 my $msg = "A record in Principals refers not existing record in $table."
258 ." In some cases it's possible to resurrect manually such records,"
259 ." but this utility can only delete";
262 'Principals', 'id' => $table, 'id',
263 condition => 's.PrincipalType = ?',
264 bind_values => [ $table =~ /^(.*)s$/ ],
267 return unless prompt( 'Delete', $msg );
269 delete_record( 'Principals', $id );
275 push @CHECKS, 'User <-> ACL equivalence group' => sub {
278 'Users', 'id' => 'Groups', 'Instance',
279 join_condition => 't.Domain = ? AND t.Type = ?',
280 bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
283 return unless prompt(
284 'Create', "Found an user that has no ACL equivalence group."
287 my $gid = create_record( 'Groups',
288 Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
294 'Groups', 'Instance' => 'Users', 'id',
295 condition => 's.Domain = ? AND s.Type = ?',
296 bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
299 return unless prompt(
300 'Delete', "Found an user ACL equivalence group, but there is no user."
303 delete_record( 'Groups', $id );
306 # one ACL equiv group for each user
309 columns => ['Instance'],
310 condition => '.Domain = ? AND .Type = ?',
311 bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
315 # check integrity of Queue role groups
316 push @CHECKS, 'Queues <-> Role Groups' => sub {
317 # XXX: we check only that there is at least one group for a queue
318 # from queue to group
320 'Queues', 'id' => 'Groups', 'Instance',
321 join_condition => 't.Domain = ?',
322 bind_values => [ 'RT::Queue-Role' ],
324 # from group to queue
326 'Groups', 'Instance' => 'Queues', 'id',
327 condition => 's.Domain = ?',
328 bind_values => [ 'RT::Queue-Role' ],
331 return unless prompt(
332 'Delete', "Found role group of not existant queue."
335 delete_record( 'Groups', $id );
340 # check integrity of Ticket role groups
341 push @CHECKS, 'Tickets <-> Role Groups' => sub {
342 # XXX: we check only that there is at least one group for a queue
343 # from queue to group
345 'Tickets', 'id' => 'Groups', 'Instance',
346 join_condition => 't.Domain = ?',
347 bind_values => [ 'RT::Ticket-Role' ],
349 # from group to ticket
351 'Groups', 'Instance' => 'Tickets', 'id',
352 condition => 's.Domain = ?',
353 bind_values => [ 'RT::Ticket-Role' ],
356 return unless prompt(
357 'Delete', "Found a role group of not existant ticket."
360 delete_record( 'Groups', $id );
365 # additional CHECKS on groups
366 push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
367 # Check that Domain, Instance and Type are unique
370 columns => ['Domain', 'Instance', 'Type'],
371 condition => '.Domain LIKE ?',
372 bind_values => [ '%-Role' ],
377 push @CHECKS, 'GMs -> Groups, Members' => sub {
378 my $msg = "A record in GroupMembers references an object that doesn't exist."
379 ." May be you deleted a group or principal directly from DB?"
380 ." Usually it's ok to delete such records.";
382 'GroupMembers', 'GroupId' => 'Groups', 'id',
385 return unless prompt( 'Delete', $msg );
387 delete_record( 'GroupMembers', $id );
391 'GroupMembers', 'MemberId' => 'Principals', 'id',
394 return unless prompt( 'Delete', $msg );
396 delete_record( 'GroupMembers', $id );
402 push @CHECKS, 'CGM vs. GM' => sub {
403 # all GM record should be duplicated in CGM
405 GroupMembers => ['GroupId', 'MemberId'],
406 CachedGroupMembers => ['GroupId', 'MemberId'],
407 join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
410 return unless prompt(
412 "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
415 my $gm = RT::GroupMember->new( $RT::SystemUser );
417 die "Couldn't load GM record #$id" unless $gm->id;
418 my $cgm = create_record( 'CachedGroupMembers',
419 GroupId => $gm->GroupId, MemberId => $gm->MemberId,
420 ImmediateParentId => $gm->GroupId, Via => undef,
421 Disabled => 0, # XXX: we should check integrity of Disabled field
423 update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
426 # all first level CGM records should have a GM record
428 CachedGroupMembers => ['GroupId', 'MemberId'],
429 GroupMembers => ['GroupId', 'MemberId'],
430 condition => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
433 return unless prompt(
435 "Found a record in CachedGroupMembers for a (Group, Member) pair"
436 ." that doesn't exist in GroupMembers table."
439 delete_record( 'CachedGroupMembers', $id );
442 # each group should have a CGM record where MemberId == GroupId
444 Groups => ['id', 'id'],
445 CachedGroupMembers => ['GroupId', 'MemberId'],
446 join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
449 return unless prompt(
451 "Found a record in Groups that has no direct"
452 ." duplicate in CachedGroupMembers table."
455 my $g = RT::Group->new( $RT::SystemUser );
457 die "Couldn't load group #$id" unless $g->id;
458 die "Loaded group by $id has id ". $g->id unless $g->id == $id;
459 my $cgm = create_record( 'CachedGroupMembers',
460 GroupId => $id, MemberId => $id,
461 ImmediateParentId => $id, Via => undef,
462 Disabled => $g->Disabled,
464 update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
468 # and back, each record in CGM with MemberId == GroupId without exceptions
469 # should reference a group
471 CachedGroupMembers => ['GroupId', 'MemberId'],
472 Groups => ['id', 'id'],
473 condition => "s.GroupId = s.MemberId",
476 return unless prompt(
478 "Found a record in CachedGroupMembers for a group that doesn't exist."
481 delete_record( 'CachedGroupMembers', $id );
486 CachedGroupMembers => 'Via',
487 CachedGroupMembers => 'id',
490 return unless prompt(
492 "Found a record in CachedGroupMembers with Via referencing not existing record."
495 delete_record( 'CachedGroupMembers', $id );
499 # for every CGM where ImmediateParentId != GroupId there should be
500 # matching parent record (first level)
502 CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
503 CachedGroupMembers => ['GroupId', 'MemberId'],
504 join_condition => 't.Via = t.id',
505 condition => 's.ImmediateParentId != s.GroupId',
508 return unless prompt(
510 "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
513 delete_record( 'CachedGroupMembers', $id );
517 # for every CGM where ImmediateParentId != GroupId there should be
518 # matching "grand" parent record
520 CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
521 CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
522 condition => 's.ImmediateParentId != s.GroupId',
525 return unless prompt(
527 "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
530 delete_record( 'CachedGroupMembers', $id );
534 # CHECK recursive records:
535 # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
536 # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
539 SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
540 cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
542 CachedGroupMembers cgm1
543 CROSS JOIN GroupMembers gm2
544 LEFT JOIN CachedGroupMembers cgm3 ON (
545 cgm3.GroupId = cgm1.GroupId
546 AND cgm3.MemberId = gm2.MemberId
547 AND cgm3.Via = cgm1.id
548 AND cgm3.ImmediateParentId = cgm1.MemberId )
549 WHERE cgm1.GroupId != cgm1.MemberId
550 AND gm2.GroupId = cgm1.MemberId
556 return unless prompt(
558 "Found records in CachedGroupMembers table without recursive duplicates."
560 my $cgm = create_record( 'CachedGroupMembers', %props );
563 my $sth = execute_query( $query );
564 while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
565 print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
566 print STDERR " but there is no cached GM record that $m is member of #$g.\n";
568 GroupId => $g, MemberId => $m, Via => $via,
569 ImmediateParentId => $ip, Disabled => $dis,
576 push @CHECKS, 'Tickets -> other' => sub {
578 'Tickets', 'EffectiveId' => 'Tickets', 'id',
581 return unless prompt(
583 "Found a ticket that's been merged into a ticket that don't exist anymore."
586 delete_record( 'Tickets', $id );
590 'Tickets', 'Queue' => 'Queues', 'id',
593 'Tickets', 'Owner' => 'Users', 'id',
595 # XXX: check that owner is only member of owner role group
599 push @CHECKS, 'Transactions -> other' => sub {
600 foreach my $model ( @models ) {
602 'Transactions', 'ObjectId' => m2t($model), 'id',
603 condition => 's.ObjectType = ?',
604 bind_values => [ "RT::$model" ],
607 return unless prompt(
608 'Delete', "Found a transaction without object."
611 delete_record( 'Transactions', $id );
617 'Transactions', 'Field' => 'CustomFields', 'id',
618 condition => 's.Type = ?',
619 bind_values => [ 'CustomField' ],
621 # type = Take, Untake, Force, Steal or Give
623 'Transactions', 'OldValue' => 'Users', 'id',
624 condition => 's.Type IN (?, ?, ?, ?, ?)',
625 bind_values => [ qw(Take Untake Force Steal Give) ],
628 return unless prompt(
629 'Delete', "Found a transaction regarding changes of Owner,"
630 ." but User with id stored in OldValue column doesn't exist anymore."
633 delete_record( 'Transactions', $id );
637 'Transactions', 'NewValue' => 'Users', 'id',
638 condition => 's.Type IN (?, ?, ?, ?, ?)',
639 bind_values => [ qw(Take Untake Force Steal Give) ],
642 return unless prompt(
643 'Delete', "Found a transaction regarding changes of Owner,"
644 ." but User with id stored in NewValue column doesn't exist anymore."
647 delete_record( 'Transactions', $id );
652 'Transactions', 'OldValue' => 'Principals', 'id',
653 condition => 's.Type = ?',
654 bind_values => [ 'DelWatcher' ],
657 return unless prompt(
658 'Delete', "Found a transaction describing watchers change,"
659 ." but User with id stored in OldValue column doesn't exist anymore."
662 delete_record( 'Transactions', $id );
667 'Transactions', 'NewValue' => 'Principals', 'id',
668 condition => 's.Type = ?',
669 bind_values => [ 'AddWatcher' ],
672 return unless prompt(
673 'Delete', "Found a transaction describing watchers change,"
674 ." but User with id stored in NewValue column doesn't exist anymore."
677 delete_record( 'Transactions', $id );
681 # XXX: Links need more love, uri is stored instead of id
682 # # type = DeleteLink
684 # 'Transactions', 'OldValue' => 'Links', 'id',
685 # condition => 's.Type = ?',
686 # bind_values => [ 'DeleteLink' ],
690 # 'Transactions', 'NewValue' => 'Links', 'id',
691 # condition => 's.Type = ?',
692 # bind_values => [ 'AddLink' ],
695 # type = Set, Field = Queue
697 'Transactions', 'NewValue' => 'Queues', 'id',
698 condition => 's.Type = ? AND s.Field = ?',
699 bind_values => [ 'Set', 'Queue' ],
702 return unless prompt(
703 'Delete', "Found a transaction describing queue change,"
704 ." but Queue with id stored in NewValue column doesn't exist anymore."
707 delete_record( 'Transactions', $id );
711 'Transactions', 'OldValue' => 'Queues', 'id',
712 condition => 's.Type = ? AND s.Field = ?',
713 bind_values => [ 'Set', 'Queue' ],
716 return unless prompt(
717 'Delete', "Found a transaction describing queue change,"
718 ." but Queue with id stored in OldValue column doesn't exist anymore."
721 delete_record( 'Transactions', $id );
726 'Transactions', 'NewValue' => 'Tickets', 'id',
727 join_condition => 't.Type = ?',
728 condition => 's.Type IN (?, ?, ?)',
729 bind_values => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
734 push @CHECKS, 'Attachments -> other' => sub {
736 Attachments => 'TransactionId', Transactions => 'id',
739 return unless prompt(
740 'Delete', "Found an attachment without a transaction."
742 delete_record( 'Attachments', $id );
746 Attachments => 'Parent', Attachments => 'id',
749 return unless prompt(
750 'Delete', "Found an sub-attachment without its parent attachment."
752 delete_record( 'Attachments', $id );
756 Attachments => 'Parent',
758 join_condition => 's.TransactionId = t.TransactionId',
762 push @CHECKS, 'CustomFields and friends' => sub {
763 #XXX: ObjectCustomFields needs more love
765 'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
768 'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
770 foreach my $model ( @models ) {
772 'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
773 condition => 's.ObjectType = ?',
774 bind_values => [ "RT::$model" ],
779 push @CHECKS, Templates => sub {
781 'Templates', 'Queue' => 'Queues', 'id',
785 push @CHECKS, Scrips => sub {
787 'Scrips', 'Queue' => 'Queues', 'id',
790 'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
793 'Scrips', 'ScripAction' => 'ScripActions', 'id',
796 'Scrips', 'Template' => 'Templates', 'id',
800 push @CHECKS, Attributes => sub {
801 foreach my $model ( @models ) {
803 'Attributes', 'ObjectId' => m2t($model), 'id',
804 condition => 's.ObjectType = ?',
805 bind_values => [ "RT::$model" ],
810 # Fix situations when Creator or LastUpdatedBy references ACL equivalence
811 # group of a user instead of user
812 push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
814 foreach my $model ( @models ) {
815 my $class = "RT::$model";
816 my $object = $class->new( $RT::SystemUser );
817 foreach my $column ( qw(LastUpdatedBy Creator) ) {
818 next unless $object->_Accessible( $column, 'auto' );
820 my $table = m2t($model);
822 SELECT m.id, g.id, g.Instance
824 Groups g JOIN $table m ON g.id = m.$column
830 my ($gid, $uid) = @_;
831 return unless prompt(
833 "Looks like there were a bug in old versions of RT back in 2006\n"
834 ."that has been fixed. If other checks are ok then it's ok to update\n"
835 ."these records to point them to users instead of groups"
837 $fix{ $table }{ $column }{ $gid } = $uid;
840 my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
841 while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
842 print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
843 print STDERR " when must reference user.\n";
844 $action->( $gid, $uid );
845 if ( keys( %fix ) > 1000 ) {
854 foreach my $table ( keys %fix ) {
855 foreach my $column ( keys %{ $fix{ $table } } ) {
856 my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
857 while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
858 update_records( $table, { $column => $gid }, { $column => $uid } );
862 $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
866 push @CHECKS, 'LastUpdatedBy and Creator' => sub {
867 foreach my $model ( @models ) {
868 my $class = "RT::$model";
869 my $object = $class->new( $RT::SystemUser );
870 my $table = $object->Table;
871 foreach my $column ( qw(LastUpdatedBy Creator) ) {
872 next unless $object->_Accessible( $column, 'auto' );
874 $table, $column => 'Users', 'id',
876 my ($id, %prop) = @_;
877 return unless my $replace_with = prompt_integer(
879 "Column $column should point to a user, but there is record #$id in table $table\n"
880 ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
881 ."Note that id you enter is not checked. You can peak any user from your DB, but it's\n"
882 ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
883 ."or something like that.",
884 "$table.$column -> user #$prop{$column}"
886 update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
892 my %CHECKS = @CHECKS;
894 @do_check = do { my $i = 1; grep $i++%2, @CHECKS };
896 while ( my $check = shift @do_check ) {
897 $CHECKS{ $check }->();
899 foreach my $redo ( keys %redo_check ) {
900 die "check $redo doesn't exist" unless $CHECKS{ $redo };
901 delete $redo_check{ $redo };
902 next if grep $_ eq $redo, @do_check; # don't do twice
903 push @do_check, $redo;
907 sub check_integrity {
908 my ($stable, @scols) = (shift, shift);
909 my ($ttable, @tcols) = (shift, shift);
912 @scols = @{ $scols[0] } if ref $scols[0];
913 @tcols = @{ $tcols[0] } if ref $tcols[0];
915 print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
918 my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
919 ." FROM $stable s LEFT JOIN $ttable t"
921 ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
923 . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
924 ." WHERE t.id IS NULL"
925 ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
927 $query .= " AND ( $args{'condition'} )" if $args{'condition'};
929 my @binds = @{ $args{'bind_values'} || [] };
930 if ( $tcols[0] eq 'id' && @tcols == 1 ) {
931 my $type = $TYPE{"$stable.$scols[0]"} || 'number';
932 if ( $type eq 'number' ) {
933 $query .= " AND s.$scols[0] != ?"
935 elsif ( $type eq 'text' ) {
936 $query .= " AND s.$scols[0] NOT LIKE ?"
941 my $sth = execute_query( $query, @binds );
942 while ( my ($sid, @set) = $sth->fetchrow_array ) {
943 print STDERR "Record #$sid in $stable references not existent record in $ttable\n";
944 for ( my $i = 0; $i < @scols; $i++ ) {
945 print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
947 print STDERR "\t". describe( $stable, $sid ) ."\n";
948 $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
953 my ($table, $id) = @_;
954 return '' unless my $cb = $describe_cb{ $table };
956 my $row = load_record( $table, $id );
957 unless ( $row->{id} ) {
959 return "$table doesn't exist";
961 return $cb->( $row );
964 sub columns_eq_cond {
965 my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
966 my $ltype = $TYPE{"$lt.$lc"} || 'number';
967 my $rtype = $TYPE{"$rt.$rc"} || 'number';
968 return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
970 if ( $rtype eq 'text' ) {
971 return "$ra.$rc LIKE CAST($la.$lc AS text)";
973 elsif ( $ltype eq 'text' ) {
974 return "$la.$lc LIKE CAST($ra.$rc AS text)";
976 else { die "don't know how to cast" }
979 sub check_uniqueness {
983 my @columns = @{ $args{'columns'} };
985 print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
989 if ( $scond = $tcond = $args{'condition'} ) {
990 $scond =~ s/(\s|^)\./$1s./g;
991 $tcond =~ s/(\s|^)\./$1t./g;
994 my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
995 ." FROM $on s LEFT JOIN $on t "
996 ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
997 . ($tcond? " AND ( $tcond )": "")
998 ." WHERE t.id IS NOT NULL "
999 ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
1000 $query .= " AND ( $scond )" if $scond;
1002 my $sth = execute_query(
1004 $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): ()
1006 while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
1007 print STDERR "Record #$tid in $on has the same set of values as $sid\n";
1008 for ( my $i = 0; $i < @columns; $i++ ) {
1009 print STDERR "\t$columns[$i] => '$set[$i]'\n";
1015 my ($table, $id) = @_;
1016 my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
1017 return $sth->fetchrow_hashref('NAME_lc');
1021 my ($table, $id) = (@_);
1022 print "Deleting record #$id in $table\n" if $opt{'verbose'};
1023 my $query = "DELETE FROM $table WHERE id = ?";
1024 $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
1025 return execute_query( $query, $id );
1029 print "Creating a record in $_[0]\n" if $opt{'verbose'};
1030 $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
1031 return $RT::Handle->Insert( @_ );
1034 sub update_records {
1039 my (@where_cols, @where_binds);
1040 while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
1042 my (@what_cols, @what_binds);
1043 while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
1045 print "Updating record(s) in $table\n" if $opt{'verbose'};
1046 my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
1047 ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
1048 $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
1049 return execute_query( $query, @what_binds, @where_binds );
1053 my ($query, @binds) = @_;
1055 print "Executing query: $query\n\n" if $opt{'verbose'};
1057 my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
1058 $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
1062 { my %cached_answer;
1066 my $token = shift || join ':', caller;
1068 return 0 unless $opt{'resolve'};
1069 return 1 if $opt{'force'};
1071 return $cached_answer{ $token } if exists $cached_answer{ $token };
1074 print "$action ALL records with the same defect? [N]: ";
1076 return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
1077 return $cached_answer{ $token } = 0;
1080 { my %cached_answer;
1082 my $actions = shift;
1084 my $token = shift || join ':', caller;
1086 return '' unless $opt{'resolve'};
1087 return '' if $opt{'force'};
1088 return $cached_answer{ $token } if exists $cached_answer{ $token };
1091 print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
1094 return $cached_answer{ $token } = '' unless $a;
1095 foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
1096 return $cached_answer{ $token } = lc substr $a, 0, 1;
1098 return $cached_answer{ $token } = '';
1101 { my %cached_answer;
1102 sub prompt_integer {
1105 my $token = shift || join ':', caller;
1107 return 0 unless $opt{'resolve'};
1108 return 0 if $opt{'force'};
1110 return $cached_answer{ $token } if exists $cached_answer{ $token };
1113 print "$action ALL records with the same defect? [0]: ";
1114 my $a = <STDIN>; chomp $a; $a = int($a);
1115 return $cached_answer{ $token } = $a;