[usit-rt.git] / sbin / rt-validator

#!/usr/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
#                                          <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
use strict;
use warnings;

# fix lib paths, some may be relative
BEGIN {
    require File::Spec;
    my @libs = ("lib", "local/lib");
    my $bin_path;

    for my $lib (@libs) {
        unless ( File::Spec->file_name_is_absolute($lib) ) {
            unless ($bin_path) {
                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
                }
                else {
                    require FindBin;
                    no warnings "once";
                    $bin_path = $FindBin::Bin;
                }
            }
            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
        }
        unshift @INC, $lib;
    }

}

use Getopt::Long;
my %opt = ();
GetOptions(
    \%opt,
    'check|c',
    'resolve',
    'force',
    'verbose|v',
    'help|h',
);

if ( $opt{help} || !$opt{check} ) {
    require Pod::Usage;
    print Pod::Usage::pod2usage( { verbose => 2 } );
    exit;
}

usage_warning() if $opt{'resolve'} && !$opt{'force'};


sub usage_warning {
    print <<END;
This utility can fix some issues with DB by creating or updating. In some
cases there is no enough data to resurect a missing record, but records which
refers to a missing can be deleted. It's up to you to decide what to do.

In any case it's highly recommended to have a backup before resolving anything.

Press enter to continue.
END
# Read a line of text, any line of text
    <STDIN>;
}

use RT;
RT::LoadConfig();
RT::Init();

my $dbh = $RT::Handle->dbh;
my $db_type = RT->Config->Get('DatabaseType');

my %TYPE = (
    'Transactions.Field'    => 'text',
    'Transactions.OldValue' => 'text',
    'Transactions.NewValue' => 'text',
);

my @models = qw(
    ACE
    Attachment
    Attribute
    CachedGroupMember
    CustomField
    CustomFieldValue
    GroupMember
    Group
    Link
    ObjectCustomField
    ObjectCustomFieldValue
    Principal
    Queue
    ScripAction
    ScripCondition
    Scrip
    Template
    Ticket
    Transaction
    User
);

my %redo_on;
$redo_on{'Delete'} = {
    ACL => [],

    Attributes => [],

    Links => [],

    CustomFields => [],
    CustomFieldValues => [],
    ObjectCustomFields => [],
    ObjectCustomFieldValues => [],

    Queues => [],

    Scrips => [],
    ScripActions => [],
    ScripConditions => [],
    Templates => [],

    Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
    Transactions => [ 'Attachments -> other' ],

    Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
    Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
    Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],

    GroupMembers => [ 'CGM vs. GM' ],
    CachedGroupMembers => [ 'CGM vs. GM' ],
};
$redo_on{'Create'} = {
    Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
    Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
    GroupMembers => [ 'CGM vs. GM' ],
    CachedGroupMembers => [ 'CGM vs. GM' ],
};
$redo_on{'Update'} = {
    Groups => ['User Defined Group Name uniqueness'],
};

my %describe_cb;
%describe_cb = (
    Attachments => sub {
        my $row = shift;
        my $txn_id = $row->{transactionid};
        my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
        return $res .', '. describe( 'Transactions', $txn_id );
    },
    Transactions => sub {
        my $row = shift;
        return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
    },
);

{ my %cache = ();
sub m2t($) {
    my $model = shift;
    return $cache{$model} if $cache{$model};
    my $class = "RT::$model";
    my $object = $class->new( RT->SystemUser );
    return $cache{$model} = $object->Table;
} }

my (@do_check, %redo_check);

my @CHECKS;
foreach my $table ( qw(Users Groups) ) {
    push @CHECKS, "$table -> Principals" => sub {
        my $msg = "A record in $table refers to a nonexistent record in Principals."
            ." The script can either create the missing record in Principals"
            ." or delete the record in $table.";
        my ($type) = ($table =~ /^(.*)s$/);
        check_integrity(
            $table, 'id' => 'Principals', 'id',
            join_condition => 't.PrincipalType = ?',
            bind_values => [ $type ],
            action => sub {
                my $id = shift;
                return unless my $a = prompt_action( ['Delete', 'create'], $msg );

                if ( $a eq 'd' ) {
                    delete_record( $table, $id );
                }
                elsif ( $a eq 'c' ) {
                    my $principal_id = create_record( 'Principals',
                        id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
                    );
                }
                else {
                    die "Unknown action '$a'";
                }
            },
        );
    };

    push @CHECKS, "Principals -> $table" => sub {
        my $msg = "A record in Principals refers to a nonexistent record in $table."
            ." In some cases it's possible to manually resurrect such records,"
            ." but this utility can only delete records.";

        check_integrity(
            'Principals', 'id' => $table, 'id',
            condition   => 's.PrincipalType = ?',
            bind_values => [ $table =~ /^(.*)s$/ ],
            action => sub {
                my $id = shift;
                return unless prompt( 'Delete', $msg );

                delete_record( 'Principals', $id );
            },
        );
    };
}

push @CHECKS, 'User <-> ACL equivalence group' => sub {
    # from user to group
    check_integrity(
        'Users', 'id' => 'Groups', 'Instance',
        join_condition   => 't.Domain = ? AND t.Type = ?',
        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Create', "Found an user that has no ACL equivalence group."
            );

            my $gid = create_record( 'Groups',
                Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
            );
        },
    );
    # from group to user
    check_integrity(
        'Groups', 'Instance' => 'Users', 'id',
        condition   => 's.Domain = ? AND s.Type = ?',
        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found an user ACL equivalence group, but there is no user."
            );

            delete_record( 'Groups', $id );
        },
    );
    # one ACL equiv group for each user
    check_uniqueness(
        'Groups',
        columns     => ['Instance'],
        condition   => '.Domain = ? AND .Type = ?',
        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
    );
};

# check integrity of Queue role groups
push @CHECKS, 'Queues <-> Role Groups' => sub {
    # XXX: we check only that there is at least one group for a queue
    # from queue to group
    check_integrity(
        'Queues', 'id' => 'Groups', 'Instance',
        join_condition   => 't.Domain = ?',
        bind_values => [ 'RT::Queue-Role' ],
    );
    # from group to queue
    check_integrity(
        'Groups', 'Instance' => 'Queues', 'id',
        condition   => 's.Domain = ?',
        bind_values => [ 'RT::Queue-Role' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a role group of a nonexistent queue."
            );

            delete_record( 'Groups', $id );
        },
    );
};

# check integrity of Ticket role groups
push @CHECKS, 'Tickets <-> Role Groups' => sub {
    # XXX: we check only that there is at least one group for a queue
    # from queue to group
    check_integrity(
        'Tickets', 'id' => 'Groups', 'Instance',
        join_condition   => 't.Domain = ?',
        bind_values => [ 'RT::Ticket-Role' ],
    );
    # from group to ticket
    check_integrity(
        'Groups', 'Instance' => 'Tickets', 'id',
        condition   => 's.Domain = ?',
        bind_values => [ 'RT::Ticket-Role' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a role group of a nonexistent ticket."
            );

            delete_record( 'Groups', $id );
        },
    );
};

# additional CHECKS on groups
push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
    # Check that Domain, Instance and Type are unique
    check_uniqueness(
        'Groups',
        columns     => ['Domain', 'Instance', 'Type'],
        condition   => '.Domain LIKE ?',
        bind_values => [ '%-Role' ],
    );
};

push @CHECKS, 'System internal group uniqueness' => sub {
    check_uniqueness(
        'Groups',
        columns     => ['Instance', 'Type'],
        condition   => '.Domain = ?',
        bind_values => [ 'SystemInternal' ],
    );
};

# CHECK that user defined group names are unique
push @CHECKS, 'User Defined Group Name uniqueness' => sub {
    check_uniqueness(
        'Groups',
        columns         => ['Name'],
        condition       => '.Domain = ?',
        bind_values     => [ 'UserDefined' ],
        extra_tables    => ['Principals sp', 'Principals tp'],
        extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)),
        extra_values    => ['Group', 'Group'],
        action          => sub {
            return unless prompt(
                'Rename', "Found a user defined group with a non-unique Name."
            );

            my $id = shift;
            my %cols = @_;
            update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) });
        },
    );
};

push @CHECKS, 'GMs -> Groups, Members' => sub {
    my $msg = "A record in GroupMembers references an object that doesn't exist."
        ." Maybe you deleted a group or principal directly from the database?"
        ." Usually it's OK to delete such records.";
    check_integrity(
        'GroupMembers', 'GroupId' => 'Groups', 'id',
        action => sub {
            my $id = shift;
            return unless prompt( 'Delete', $msg );

            delete_record( 'GroupMembers', $id );
        },
    );
    check_integrity(
        'GroupMembers', 'MemberId' => 'Principals', 'id',
        action => sub {
            my $id = shift;
            return unless prompt( 'Delete', $msg );

            delete_record( 'GroupMembers', $id );
        },
    );
};

# CGM and GM
push @CHECKS, 'CGM vs. GM' => sub {
    # all GM record should be duplicated in CGM
    check_integrity(
        GroupMembers       => ['GroupId', 'MemberId'],
        CachedGroupMembers => ['GroupId', 'MemberId'],
        join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Create',
                "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
            );

            my $gm = RT::GroupMember->new( RT->SystemUser );
            $gm->Load( $id );
            die "Couldn't load GM record #$id" unless $gm->id;
            my $cgm = create_record( 'CachedGroupMembers',
                GroupId => $gm->GroupId, MemberId => $gm->MemberId,
                ImmediateParentId => $gm->GroupId, Via => undef,
                Disabled => 0, # XXX: we should check integrity of Disabled field
            );
            update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
        },
    );
    # all first level CGM records should have a GM record
    check_integrity(
        CachedGroupMembers => ['GroupId', 'MemberId'],
        GroupMembers       => ['GroupId', 'MemberId'],
        condition     => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete',
                "Found a record in CachedGroupMembers for a (Group, Member) pair"
                ." that doesn't exist in the GroupMembers table."
            );

            delete_record( 'CachedGroupMembers', $id );
        },
    );
    # each group should have a CGM record where MemberId == GroupId
    check_integrity(
        Groups => ['id', 'id'],
        CachedGroupMembers => ['GroupId', 'MemberId'],
        join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Create',
                "Found a record in Groups that has no direct"
                ." duplicate in CachedGroupMembers table."
            );

            my $g = RT::Group->new( RT->SystemUser );
            $g->Load( $id );
            die "Couldn't load group #$id" unless $g->id;
            die "Loaded group by $id has id ". $g->id  unless $g->id == $id;
            my $cgm = create_record( 'CachedGroupMembers',
                GroupId => $id, MemberId => $id,
                ImmediateParentId => $id, Via => undef,
                Disabled => $g->Disabled,
            );
            update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
        },
    );

    # and back, each record in CGM with MemberId == GroupId without exceptions
    # should reference a group
    check_integrity(
        CachedGroupMembers => ['GroupId', 'MemberId'],
        Groups => ['id', 'id'],
        condition => "s.GroupId = s.MemberId",
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete',
                "Found a record in CachedGroupMembers for a group that doesn't exist."
            );

            delete_record( 'CachedGroupMembers', $id );
        },
    );
    # Via
    check_integrity(
        CachedGroupMembers => 'Via',
        CachedGroupMembers => 'id',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete',
                "Found a record in CachedGroupMembers with Via that references a nonexistent record."
            );

            delete_record( 'CachedGroupMembers', $id );
        },
    );

    # for every CGM where ImmediateParentId != GroupId there should be
    # matching parent record (first level) 
    check_integrity(
        CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
        CachedGroupMembers => ['GroupId', 'MemberId'],
        join_condition => 't.Via = t.id',
        condition => 's.ImmediateParentId != s.GroupId',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete',
                "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
            );

            delete_record( 'CachedGroupMembers', $id );
        },
    );

    # for every CGM where ImmediateParentId != GroupId there should be
    # matching "grand" parent record
    check_integrity(
        CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
        CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
        condition => 's.ImmediateParentId != s.GroupId',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete',
                "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
            );

            delete_record( 'CachedGroupMembers', $id );
        },
    );

    # CHECK recursive records:
    # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
    # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
    {
        my $query = <<END;
SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
    cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
FROM
    CachedGroupMembers cgm1
    CROSS JOIN GroupMembers gm2
    LEFT JOIN CachedGroupMembers cgm3 ON (
            cgm3.GroupId           = cgm1.GroupId
        AND cgm3.MemberId          = gm2.MemberId
        AND cgm3.Via               = cgm1.id
        AND cgm3.ImmediateParentId = cgm1.MemberId )
WHERE cgm1.GroupId != cgm1.MemberId
AND gm2.GroupId = cgm1.MemberId
AND cgm3.id IS NULL
END

        my $action = sub {
            my %props = @_;
            return unless prompt(
                'Create',
                "Found records in CachedGroupMembers table without recursive duplicates."
            );
            my $cgm = create_record( 'CachedGroupMembers', %props );
        };

        my $sth = execute_query( $query );
        while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
            print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
            print STDERR " but there is no cached GM record that $m is member of #$g.\n";
            $action->(
                GroupId => $g, MemberId => $m, Via => $via,
                ImmediateParentId => $ip, Disabled => $dis,
            );
        }
    }
};

# Tickets
push @CHECKS, 'Tickets -> other' => sub {
    check_integrity(
        'Tickets', 'EffectiveId' => 'Tickets', 'id',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete',
                "Found a ticket that's been merged into a ticket that no longer exists."
            );

            delete_record( 'Tickets', $id );
        },
    );
    check_integrity(
        'Tickets', 'Queue' => 'Queues', 'id',
    );
    check_integrity(
        'Tickets', 'Owner' => 'Users', 'id',
    );
    # XXX: check that owner is only member of owner role group
};


push @CHECKS, 'Transactions -> other' => sub {
    foreach my $model ( @models ) {
        check_integrity(
            'Transactions', 'ObjectId' => m2t($model), 'id',
            condition   => 's.ObjectType = ?',
            bind_values => [ "RT::$model" ],
            action => sub {
                my $id = shift;
                return unless prompt(
                    'Delete', "Found a transaction without object."
                );

                delete_record( 'Transactions', $id );
            },
        );
    }
    # type = CustomField
    check_integrity(
        'Transactions', 'Field' => 'CustomFields', 'id',
        condition   => 's.Type = ?',
        bind_values => [ 'CustomField' ],
    );
    # type = Take, Untake, Force, Steal or Give
    check_integrity(
        'Transactions', 'OldValue' => 'Users', 'id',
        condition   => 's.Type IN (?, ?, ?, ?, ?)',
        bind_values => [ qw(Take Untake Force Steal Give) ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a transaction regarding Owner changes,"
                ." but the User with id stored in OldValue column doesn't exist anymore."
            );

            delete_record( 'Transactions', $id );
        },
    );
    check_integrity(
        'Transactions', 'NewValue' => 'Users', 'id',
        condition   => 's.Type IN (?, ?, ?, ?, ?)',
        bind_values => [ qw(Take Untake Force Steal Give) ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a transaction regarding Owner changes,"
                ." but the User with id stored in NewValue column doesn't exist anymore."
            );

            delete_record( 'Transactions', $id );
        },
    );
    # type = DelWatcher
    check_integrity(
        'Transactions', 'OldValue' => 'Principals', 'id',
        condition   => 's.Type = ?',
        bind_values => [ 'DelWatcher' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a transaction describing watcher changes,"
                ." but the User with id stored in OldValue column doesn't exist anymore."
            );

            delete_record( 'Transactions', $id );
        },
    );
    # type = AddWatcher
    check_integrity(
        'Transactions', 'NewValue' => 'Principals', 'id',
        condition   => 's.Type = ?',
        bind_values => [ 'AddWatcher' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a transaction describing watcher changes,"
                ." but the User with id stored in NewValue column doesn't exist anymore."
            );

            delete_record( 'Transactions', $id );
        },
    );

# XXX: Links need more love, uri is stored instead of id
#    # type = DeleteLink
#    check_integrity(
#        'Transactions', 'OldValue' => 'Links', 'id',
#        condition   => 's.Type = ?',
#        bind_values => [ 'DeleteLink' ],
#    );
#    # type = AddLink
#    check_integrity(
#        'Transactions', 'NewValue' => 'Links', 'id',
#        condition   => 's.Type = ?',
#        bind_values => [ 'AddLink' ],
#    );

    # type = Set, Field = Queue
    check_integrity(
        'Transactions', 'NewValue' => 'Queues', 'id',
        condition   => 's.Type = ? AND s.Field = ?',
        bind_values => [ 'Set', 'Queue' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a transaction describing a queue change,"
                ." but the Queue with id stored in the NewValue column doesn't exist anymore."
            );

            delete_record( 'Transactions', $id );
        },
    );
    check_integrity(
        'Transactions', 'OldValue' => 'Queues', 'id',
        condition   => 's.Type = ? AND s.Field = ?',
        bind_values => [ 'Set', 'Queue' ],
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found a transaction describing a queue change,"
                ." but the Queue with id stored in the OldValue column doesn't exist anymore."
            );

            delete_record( 'Transactions', $id );
        },
    );
    # Reminders
    check_integrity(
        'Transactions', 'NewValue' => 'Tickets', 'id',
        join_condition => 't.Type = ?',
        condition      => 's.Type IN (?, ?, ?)',
        bind_values    => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
    );
};

# Attachments
push @CHECKS, 'Attachments -> other' => sub {
    check_integrity(
        Attachments  => 'TransactionId', Transactions => 'id',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found an attachment without a transaction."
            );
            delete_record( 'Attachments', $id );
        },
    );
    check_integrity(
        Attachments => 'Parent', Attachments => 'id',
        action => sub {
            my $id = shift;
            return unless prompt(
                'Delete', "Found an sub-attachment without its parent attachment."
            );
            delete_record( 'Attachments', $id );
        },
    );
    check_integrity(
        Attachments => 'Parent',
        Attachments => 'id',
        join_condition => 's.TransactionId = t.TransactionId',
    );
};

push @CHECKS, 'CustomFields and friends' => sub {
    #XXX: ObjectCustomFields needs more love
    check_integrity(
        'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
    );
    check_integrity(
        'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
    );
    foreach my $model ( @models ) {
        check_integrity(
            'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
            condition   => 's.ObjectType = ?',
            bind_values => [ "RT::$model" ],
        );
    }
};

push @CHECKS, Templates => sub {
    check_integrity(
        'Templates', 'Queue' => 'Queues', 'id',
    );
};

push @CHECKS, Scrips => sub {
    check_integrity(
        'Scrips', 'Queue' => 'Queues', 'id',
    );
    check_integrity(
        'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
    );
    check_integrity(
        'Scrips', 'ScripAction' => 'ScripActions', 'id',
    );
    check_integrity(
        'Scrips', 'Template' => 'Templates', 'id',
    );
};

push @CHECKS, Attributes => sub {
    foreach my $model ( @models ) {
        check_integrity(
            'Attributes', 'ObjectId' => m2t($model), 'id',
            condition   => 's.ObjectType = ?',
            bind_values => [ "RT::$model" ],
        );
    }
};

# Fix situations when Creator or LastUpdatedBy references ACL equivalence
# group of a user instead of user
push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
    my %fix = ();
    foreach my $model ( @models ) {
        my $class = "RT::$model";
        my $object = $class->new( RT->SystemUser );
        foreach my $column ( qw(LastUpdatedBy Creator) ) {
            next unless $object->_Accessible( $column, 'auto' );

            my $table = m2t($model);
            my $query = <<END;
SELECT m.id, g.id, g.Instance
FROM
    Groups g JOIN $table m ON g.id = m.$column
WHERE
    g.Domain = ?
    AND g.Type = ?
END
            my $action = sub {
                my ($gid, $uid) = @_;
                return unless prompt(
                    'Update',
                    "Looks like there were a bug in old versions of RT back in 2006\n"
                    ."that has been fixed. If other checks are ok then it's ok to update\n"
                    ."these records to point them to users instead of groups"
                );
                $fix{ $table }{ $column }{ $gid } = $uid;
            };

            my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
            while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
                print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
                print STDERR " when must reference user.\n";
                $action->( $gid, $uid );
                if ( keys( %fix ) > 1000 ) {
                    $sth->finish;
                    last;
                }
            }
        }
    }

    if ( keys %fix ) {
        foreach my $table ( keys %fix ) {
            foreach my $column ( keys %{ $fix{ $table } } ) {
                my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
                while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
                    update_records( $table, { $column => $gid }, { $column => $uid } );
                }
            }
        }
        $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
    }
};

push @CHECKS, 'LastUpdatedBy and Creator' => sub {
    foreach my $model ( @models ) {
        my $class = "RT::$model";
        my $object = $class->new( RT->SystemUser );
        my $table = $object->Table;
        foreach my $column ( qw(LastUpdatedBy Creator) ) {
            next unless $object->_Accessible( $column, 'auto' );
            check_integrity(
                $table, $column => 'Users', 'id',
                action => sub {
                    my ($id, %prop) = @_;
                    return unless my $replace_with = prompt_integer(
                        'Replace',
                        "Column $column should point to a user, but there is record #$id in table $table\n"
                        ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
                        ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
                        ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
                        ."or something like that.",
                        "$table.$column -> user #$prop{$column}"
                    );
                    update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
                },
            );
        }
    }
};
my %CHECKS = @CHECKS;

@do_check = do { my $i = 1; grep $i++%2, @CHECKS };

while ( my $check = shift @do_check ) {
    $CHECKS{ $check }->();

    foreach my $redo ( keys %redo_check ) {
        die "check $redo doesn't exist" unless $CHECKS{ $redo };
        delete $redo_check{ $redo };
        next if grep $_ eq $redo, @do_check; # don't do twice
        push @do_check, $redo;
    }
}

sub check_integrity {
    my ($stable, @scols) = (shift, shift);
    my ($ttable, @tcols) = (shift, shift);
    my %args = @_;

    @scols = @{ $scols[0] } if ref $scols[0];
    @tcols = @{ $tcols[0] } if ref $tcols[0];

    print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
        if $opt{'verbose'};

    my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
        ." FROM $stable s LEFT JOIN $ttable t"
        ." ON (". join(
            ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
        ) .")"
        . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
        ." WHERE t.id IS NULL"
        ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);

    $query .= " AND ( $args{'condition'} )" if $args{'condition'};

    my @binds = @{ $args{'bind_values'} || [] };
    if ( $tcols[0] eq 'id' && @tcols == 1 ) {
        my $type = $TYPE{"$stable.$scols[0]"} || 'number';
        if ( $type eq 'number' ) {
            $query .= " AND s.$scols[0] != ?"
        }
        elsif ( $type eq 'text' ) {
            $query .= " AND s.$scols[0] NOT LIKE ?"
        }
        push @binds, 0;
    }

    my $sth = execute_query( $query, @binds );
    while ( my ($sid, @set) = $sth->fetchrow_array ) {
        print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n";
        for ( my $i = 0; $i < @scols; $i++ ) {
            print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
        }
        print STDERR "\t". describe( $stable, $sid ) ."\n";
        $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
    }
}

sub describe {
    my ($table, $id) = @_;
    return '' unless my $cb = $describe_cb{ $table };

    my $row = load_record( $table, $id );
    unless ( $row->{id} ) {
        $table =~ s/s$//;
        return "$table doesn't exist";
    }
    return $cb->( $row );
}

sub columns_eq_cond {
    my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
    my $ltype = $TYPE{"$lt.$lc"} || 'number';
    my $rtype = $TYPE{"$rt.$rc"} || 'number';
    return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;

    if ( $rtype eq 'text' ) {
        return "$ra.$rc LIKE CAST($la.$lc AS text)";
    }
    elsif ( $ltype eq 'text' ) {
        return "$la.$lc LIKE CAST($ra.$rc AS text)";
    }
    else { die "don't know how to cast" }
}

sub check_uniqueness {
    my $on = shift;
    my %args = @_;

    my @columns = @{ $args{'columns'} };

    print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
        if $opt{'verbose'};

    my ($scond, $tcond);
    if ( $scond = $tcond = $args{'condition'} ) {
        $scond =~ s/(\s|^)\./$1s./g;
        $tcond =~ s/(\s|^)\./$1t./g;
    }

    my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
        ." FROM $on s LEFT JOIN $on t "
        ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
        . ($tcond? " AND ( $tcond )": "")
        . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "")
        ." WHERE t.id IS NOT NULL "
        ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
    $query .= " AND ( $scond )" if $scond;
    $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'};

    my $sth = execute_query(
        $query,
        $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
        $args{'extra_values'}? (@{ $args{'extra_values'} }): ()
    );
    while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
        print STDERR "Record #$tid in $on has the same set of values as $sid\n";
        for ( my $i = 0; $i < @columns; $i++ ) {
            print STDERR "\t$columns[$i] => '$set[$i]'\n";
        }
        $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'};
    }
}

sub load_record {
    my ($table, $id) = @_;
    my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
    return $sth->fetchrow_hashref('NAME_lc');
}

sub delete_record {
    my ($table, $id) = (@_);
    print "Deleting record #$id in $table\n" if $opt{'verbose'};
    my $query = "DELETE FROM $table WHERE id = ?";
    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
    return execute_query( $query, $id );
}

sub create_record {
    print "Creating a record in $_[0]\n" if $opt{'verbose'};
    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
    return $RT::Handle->Insert( @_ );
}

sub update_records {
    my $table = shift;
    my $where = shift;
    my $what = shift;

    my (@where_cols, @where_binds);
    while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }

    my (@what_cols, @what_binds);
    while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }

    print "Updating record(s) in $table\n" if $opt{'verbose'};
    my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
        ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
    return execute_query( $query, @what_binds, @where_binds );
}

sub execute_query {
    my ($query, @binds) = @_;

    print "Executing query: $query\n\n" if $opt{'verbose'};

    my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
    $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
    return $sth;
}

{ my %cached_answer;
sub prompt {
    my $action = shift;
    my $msg = shift;
    my $token = shift || join ':', caller;

    return 0 unless $opt{'resolve'};
    return 1 if $opt{'force'};

    return $cached_answer{ $token } if exists $cached_answer{ $token };

    print $msg, "\n";
    print "$action ALL records with the same defect? [N]: ";
    my $a = <STDIN>;
    return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
    return $cached_answer{ $token } = 0;
} }

{ my %cached_answer;
sub prompt_action {
    my $actions = shift;
    my $msg = shift;
    my $token = shift || join ':', caller;

    return '' unless $opt{'resolve'};
    return '' if $opt{'force'};
    return $cached_answer{ $token } if exists $cached_answer{ $token };

    print $msg, "\n";
    print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
    my $a = <STDIN>;
    chomp $a;
    return $cached_answer{ $token } = '' unless $a;
    foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
        return $cached_answer{ $token } = lc substr $a, 0, 1;
    }
    return $cached_answer{ $token } = '';
} }

{ my %cached_answer;
sub prompt_integer {
    my $action = shift;
    my $msg = shift;
    my $token = shift || join ':', caller;

    return 0 unless $opt{'resolve'};
    return 0 if $opt{'force'};

    return $cached_answer{ $token } if exists $cached_answer{ $token };

    print $msg, "\n";
    print "$action ALL records with the same defect? [0]: ";
    my $a = <STDIN>; chomp $a; $a = int($a);
    return $cached_answer{ $token } = $a;
} }

1;

__END__

=head1 NAME

rt-validator - check and correct validity of records in RT's database

=head1 SYNOPSIS

    rt-validator --check 
    rt-validator --check --verbose
    rt-validator --check --verbose --resolve
    rt-validator --check --verbose --resolve --force

=head1 DESCRIPTION

This script checks integrity of records in RT's DB. May delete some invalid
records or ressurect accidentally deleted.

=head1 OPTIONS

=over

=item check

    mandatory.
    
    it's equal to -c

=item verbose

    print additional info to STDOUT
    it's equal to -v

=item resolve

    enable resolver that can delete or create some records

=item force

    resolve without asking questions

=back