+ return $res;
+};
+
+push @CHECKS, 'Links: wrong organization' => sub {
+ my $res = 1;
+ my @URI_USES = (
+ { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
+ { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
+ { model => 'Link', column => 'Target' },
+ { model => 'Link', column => 'Base' },
+ );
+
+ my $right_org = RT->Config->Get('Organization');
+ my @rt_uris = rt_uri_modules();
+ foreach my $package (@rt_uris) {
+
+ my $rt_uri = $package->new( $RT::SystemUser );
+ my $scheme = $rt_uri->Scheme;
+ my $prefix = $rt_uri->LocalURIPrefix;
+
+ foreach my $use ( @URI_USES ) {
+ my $table = m2t( $use->{'model'} );
+ my $column = $use->{'column'};
+
+ my $query = "SELECT id, $column FROM $table WHERE"
+ . " $column LIKE ? AND $column NOT LIKE ?";
+ my @binds = (sql_escape_like($scheme) ."://%", sql_escape_like($prefix) ."%");
+
+ while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
+ $query .= " AND $k = ?";
+ push @binds, $v;
+ }
+ my $sth = execute_query( $query, @binds );
+ while ( my ($id, $value) = $sth->fetchrow_array ) {
+ $res = 0;
+ print STDERR "Record #$id in $table. Value of $column column most probably is an incorrect link\n";
+ my ($wrong_org) = ( $value =~ m{^\Q$scheme\E://(.+)/[^/]+/[0-9]*$} );
+ next unless my $replace_with = prompt(
+ 'Replace',
+ "Column $column in $table is a link. There is record #$id that has a"
+ ." local scheme of '$scheme', but its organization is '$wrong_org'"
+ ." instead of '$right_org'. Most probably the Organization was"
+ ." changed from '$wrong_org' to '$right_org' at some point. It is"
+ ." generally a good idea to replace these wrong links.\n",
+ "Links: wrong organization $wrong_org"
+ );
+
+ print "Updating record(s) in $table\n" if $opt{'verbose'};
+ my $wrong_prefix = $scheme . '://'. $wrong_org;
+ my $query = "UPDATE $table SET $column = ". sql_concat('?', "SUBSTR($column, ?)")
+ ." WHERE $column LIKE ?";
+ execute_query( $query, $prefix, length($wrong_prefix)+1, sql_escape_like($wrong_prefix) .'/%' );
+
+ $redo_check{'Links: wrong organization'} = 1;
+ $redo_check{'Links: LocalX for non-ticket'} = 1;
+ last; # plenty of chances we covered all cases with one update
+ }
+ }
+ } # end foreach my $package (@rt_uris)
+ return $res;
+};
+
+push @CHECKS, 'Links: LocalX for non-ticket' => sub {
+ my $res = 1;
+ my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
+ my $scheme = $rt_uri->Scheme;
+ my $prefix = $rt_uri->LocalURIPrefix;
+ my $table = m2t('Link');
+
+ foreach my $dir ( 'Target', 'Base' ) {
+ # we look only at links with correct organization, previouse check deals
+ # with incorrect orgs
+ my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir NOT LIKE ?";
+ my @binds = (sql_escape_like($prefix) ."/%", sql_escape_like($prefix) ."/ticket/%");
+
+ my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
+ while ( my ($id, $value) = $sth->fetchrow_array ) {
+ $res = 0;
+ print STDERR "Record #$id in $table. Value of Local$dir is not 0\n";
+ next unless my $replace_with = prompt(
+ 'Replace',
+ "Column Local$dir in $table should be 0 if $dir column is not link"
+ ." to a ticket. It's ok to replace with 0.\n",
+ );
+
+ print "Updating record(s) in $table\n" if $opt{'verbose'};
+ execute_query( "UPDATE $table SET Local$dir = 0 WHERE $where", @binds );
+ $redo_check{'Links: wrong organization'} = 1;
+
+ last; # we covered all cases with one update
+ }
+ }
+ return $res;
+};
+
+push @CHECKS, 'Links: LocalX != X' => sub {
+ my $res = 1;
+ my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
+ my $scheme = $rt_uri->Scheme;
+ my $prefix = $rt_uri->LocalURIPrefix .'/ticket/';
+ my $table = m2t('Link');
+
+ foreach my $dir ( 'Target', 'Base' ) {
+ # we limit to $dir = */ticket/* so it doesn't conflict with previouse check
+ # previouse check is more important as there was a bug in RT when Local$dir
+ # was set for not tickets
+ # XXX: we have issue with MergedInto links - "LocalX !~ X"
+ my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir != ". sql_concat('?', "Local$dir")
+ ." AND Type != ?";
+ my @binds = (sql_escape_like($prefix) ."%", $prefix, 'MergedInto');
+
+ my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
+ while ( my ($id, $value) = $sth->fetchrow_array ) {
+ $res = 0;
+ print STDERR "Record #$id in $table. Value of $dir doesn't match ticket id in Local$dir\n";
+ next unless my $replace_with = prompt(
+ 'Replace',
+ "For ticket links column $dir in $table table should end with"
+ ." ticket id from Local$dir. It's probably ok to fix $dir column.\n",
+ );
+
+ print "Updating record(s) in $table\n" if $opt{'verbose'};
+ execute_query(
+ "UPDATE $table SET $dir = ". sql_concat('?', "Local$dir") ." WHERE $where",
+ $prefix, @binds
+ );
+
+ last; # we covered all cases with one update
+ }
+ }
+ return $res;