#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
C<RT::Handle> is RT specific wrapper over one of L<DBIx::SearchBuilder::Handle>
classes. As RT works with different types of DBs we subclass repsective handler
-from L<DBIx::SerachBuilder>. Type of the DB is defined by C<DatabasseType> RT's
-config option. You B<must> load this module only when the configs have been
-loaded.
+from L<DBIx::SearchBuilder>. Type of the DB is defined by L<RT's DatabaseType
+config option|RT_Config/DatabaseType>. You B<must> load this module only when
+the configs have been loaded.
=cut
=cut
sub FinalizeDatabaseType {
- eval {
- use base "DBIx::SearchBuilder::Handle::". RT->Config->Get('DatabaseType');
- };
+ my $db_type = RT->Config->Get('DatabaseType');
+ my $package = "DBIx::SearchBuilder::Handle::$db_type";
- if ($@) {
- die "Unable to load DBIx::SearchBuilder database handle for '". RT->Config->Get('DatabaseType') ."'.\n".
+ $package->require or
+ die "Unable to load DBIx::SearchBuilder database handle for '$db_type'.\n".
"Perhaps you've picked an invalid database type or spelled it incorrectly.\n".
$@;
+
+ @RT::Handle::ISA = ($package);
+
+ # We use COLLATE NOCASE to enforce case insensitivity on the normally
+ # case-sensitive SQLite, LOWER() approach works, but lucks performance
+ # due to absence of functional indexes
+ if ($db_type eq 'SQLite') {
+ no strict 'refs'; no warnings 'redefine';
+ *DBIx::SearchBuilder::Handle::SQLite::CaseSensitive = sub {0};
}
}
}
- if ( $db_type eq 'Pg' ) {
+ elsif ( $db_type eq 'Pg' ) {
my $version = $self->DatabaseVersion;
($version) = $version =~ /^(\d+\.\d+)/;
+ $self->dbh->{pg_server_prepare} = 0 if $version > 9.1; #and we're using a deb-7 version DBD::Pg?
$self->dbh->do("SET bytea_output = 'escape'") if $version >= 9.0;
+
+ # Force UTF8, even when database encoding is not UTF8
+ # DBD::Pg used to do this for us prior to v3
+ $self->dbh->do('SET client_encoding TO UTF8;');
+ $self->dbh->{pg_enable_utf8} = -1;
}
Database => $db_name,
Port => $db_port,
Driver => $db_type,
- RequireSSL => RT->Config->Get('DatabaseRequireSSL'),
);
if ( $db_type eq 'Oracle' && $db_host ) {
$args{'SID'} = delete $args{'Database'};
}
$self->SUPER::BuildDSN( %args );
+
+ if (RT->Config->Get('DatabaseExtraDSN')) {
+ my %extra = RT->Config->Get('DatabaseExtraDSN');
+ $self->{'dsn'} .= ";$_=$extra{$_}"
+ for sort keys %extra;
+ }
+ return $self->{'dsn'};
}
=head2 DSN
sub CheckIntegrity {
my $self = shift;
- $self = new $self unless ref $self;
unless ($RT::Handle and $RT::Handle->dbh) {
local $@;
my $test_user = RT::CurrentUser->new;
$test_user->Load('RT_System');
unless ( $test_user->id ) {
- return (0, 'no system user', "Couldn't find RT_System user in the DB '". $self->DSN ."'");
+ return (0, 'no system user', "Couldn't find RT_System user in the DB '". $RT::Handle->DSN ."'");
}
$test_user = RT::CurrentUser->new;
$test_user->Load('Nobody');
unless ( $test_user->id ) {
- return (0, 'no nobody user', "Couldn't find Nobody user in the DB '". $self->DSN ."'");
+ return (0, 'no nobody user', "Couldn't find Nobody user in the DB '". $RT::Handle->DSN ."'");
}
return 1;
}
if ( $state eq 'post' ) {
- my $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Tickets")->[1];
- unless ( $create_table =~ /(?:ENGINE|TYPE)\s*=\s*InnoDB/i ) {
+ my $show_table = sub { $dbh->selectrow_arrayref("SHOW CREATE TABLE $_[0]")->[1] };
+ unless ( $show_table->("Tickets") =~ /(?:ENGINE|TYPE)\s*=\s*InnoDB/i ) {
return (0, "RT requires that all its tables be of InnoDB type. Upgrade RT tables.");
}
- $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Attachments")->[1];
- unless ( $create_table =~ /\bContent\b[^,]*BLOB/i ) {
+ unless ( $show_table->("Attachments") =~ /\bContent\b[^,]*BLOB/i ) {
return (0, "RT since version 3.8 has new schema for MySQL versions after 4.1.0\n"
."Follow instructions in the UPGRADING.mysql file.");
}
}
- my $max_packet = ($dbh->selectrow_array("show variables like 'max_allowed_packet'"))[1];
- if ($state =~ /^(create|post)$/ and $max_packet <= (1024 * 1024)) {
- my $max_packet = sprintf("%.1fM", $max_packet/1024/1024);
- warn "max_allowed_packet is set to $max_packet, which limits the maximum attachment or email size that RT can process. Consider adjusting MySQL's max_allowed_packet setting.\n";
+ if ($state =~ /^(create|post)$/) {
+ my $show_var = sub { $dbh->selectrow_arrayref("SHOW VARIABLES LIKE ?",{},$_[0])->[1] };
+
+ my $max_packet = $show_var->("max_allowed_packet");
+ if ($max_packet <= (5 * 1024 * 1024)) {
+ $max_packet = sprintf("%.1fM", $max_packet/1024/1024);
+ warn "max_allowed_packet is set to $max_packet, which limits the maximum attachment or email size that RT can process. Consider adjusting MySQL's max_allowed_packet setting.\n";
+ }
+
+ my $full_version = $show_var->("version");
+ if ($full_version =~ /^5\.(\d+)\.(\d+)$/ and (($1 == 6 and $2 >= 20) or $1 > 6)) {
+ my $redo_log_size = $show_var->("innodb_log_file_size");
+ $redo_log_size *= $show_var->("innodb_log_files_in_group")
+ if $full_version =~ /^5\.(\d+)\.(\d+)$/ and (($1 == 6 and $2 >= 22) or $1 > 6);
+
+ if ($redo_log_size / 10 < 5 * 1024 * 1024) {
+ $redo_log_size = sprintf("%.1fM",$redo_log_size/1024/1024);
+ warn "innodb_log_file_size is set to $redo_log_size; attachments can only be 10% of this value on MySQL 5.6. Consider adjusting MySQL's innodb_log_file_size setting.\n";
+ }
+ }
}
}
return (1)
$status = $dbh->do("CREATE DATABASE $db_name WITH ENCODING='UNICODE' TEMPLATE template0");
}
elsif ( $db_type eq 'mysql' ) {
- $status = $dbh->do("CREATE DATABASE $db_name DEFAULT CHARACTER SET utf8");
+ $status = $dbh->do("CREATE DATABASE `$db_name` DEFAULT CHARACTER SET utf8");
}
else {
$status = $dbh->do("CREATE DATABASE $db_name");
$path = "$RT::VarPath/$path" unless substr($path, 0, 1) eq '/';
unlink $path or return (0, "Couldn't remove '$path': $!");
return (1);
+ } elsif ( $db_type eq 'mysql' ) {
+ $dbh->do("DROP DATABASE `$db_name`")
+ or return (0, $DBI::errstr);
} else {
$dbh->do("DROP DATABASE ". $db_name)
or return (0, $DBI::errstr);
return (1);
}
+sub InsertIndexes {
+ my $self = shift;
+ my $dbh = shift;
+ my $base_path = shift || $RT::EtcPath;
+
+ my $db_type = RT->Config->Get('DatabaseType');
+
+ $dbh = $self->dbh if !$dbh && ref $self;
+ return (0, "No DBI handle provided") unless $dbh;
+
+ return (0, "'$base_path' doesn't exist") unless -e $base_path;
+
+ my $path;
+ if ( -d $base_path ) {
+ $path = File::Spec->catfile( $base_path, "indexes");
+ return (0, "Couldn't find indexes file")
+ unless -e $path;
+ } else {
+ $path = $base_path;
+ }
+
+ if ( $db_type eq 'Oracle' ) {
+ my $db_user = RT->Config->Get('DatabaseUser');
+ my $status = $dbh->do( "ALTER SESSION SET CURRENT_SCHEMA=$db_user" );
+ unless ( $status ) {
+ return $status, "Couldn't set current schema to $db_user."
+ ."\nError: ". $dbh->errstr;
+ }
+ }
+
+ local $@;
+ eval { require $path; 1 }
+ or return (0, "Couldn't execute '$path': " . $@);
+ return (1);
+}
+
=head1 GetVersionFile
Takes base name of the file as argument, scans for <base name>-<version> named
$group = RT::Group->new( RT->SystemUser );
my ( $val, $msg ) = $group->_Create(
- Type => $name,
Domain => 'SystemInternal',
Description => 'Pseudogroup for internal use', # loc
- Name => '',
+ Name => $name,
Instance => '',
);
return ($val, $msg) unless $val;
# system role groups
foreach my $name (qw(Owner Requestor Cc AdminCc)) {
- my $group = RT::Group->new( RT->SystemUser );
- $group->LoadSystemRoleGroup( $name );
+ my $group = RT->System->RoleGroup( $name );
if ( $group->id ) {
push @warns, "System role '$name' already exists.";
next;
}
$group = RT::Group->new( RT->SystemUser );
- my ( $val, $msg ) = $group->_Create(
- Type => $name,
- Domain => 'RT::System-Role',
- Description => 'SystemRolegroup for internal use', # loc
- Name => '',
- Instance => '',
+ my ( $val, $msg ) = $group->CreateRoleGroup(
+ Name => $name,
+ Object => RT->System,
+ Description => 'SystemRolegroup for internal use', # loc
+ InsideTransaction => 0,
);
return ($val, $msg) unless $val;
}
if ( @Groups ) {
$RT::Logger->debug("Creating groups...");
foreach my $item (@Groups) {
+ my $attributes = delete $item->{ Attributes };
my $new_entry = RT::Group->new( RT->SystemUser );
- $item->{Domain} ||= 'UserDefined';
+ $item->{'Domain'} ||= 'UserDefined';
my $member_of = delete $item->{'MemberOf'};
my $members = delete $item->{'Members'};
my ( $return, $msg ) = $new_entry->_Create(%$item);
next;
} else {
$RT::Logger->debug($return .".");
+ $_->{Object} = $new_entry for @{$attributes || []};
+ push @Attributes, @{$attributes || []};
}
if ( $member_of ) {
$member_of = [ $member_of ] unless ref $member_of eq 'ARRAY';
if ( @Users ) {
$RT::Logger->debug("Creating users...");
foreach my $item (@Users) {
+ my $member_of = delete $item->{'MemberOf'};
if ( $item->{'Name'} eq 'root' && $root_password ) {
$item->{'Password'} = $root_password;
}
+ my $attributes = delete $item->{ Attributes };
my $new_entry = RT::User->new( RT->SystemUser );
my ( $return, $msg ) = $new_entry->Create(%$item);
unless ( $return ) {
$RT::Logger->error( $msg );
} else {
$RT::Logger->debug( $return ."." );
+ $_->{Object} = $new_entry for @{$attributes || []};
+ push @Attributes, @{$attributes || []};
+ }
+ if ( $member_of ) {
+ $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY';
+ foreach( @$member_of ) {
+ my $parent = RT::Group->new($RT::SystemUser);
+ if ( ref $_ eq 'HASH' ) {
+ $parent->LoadByCols( %$_ );
+ }
+ elsif ( !ref $_ ) {
+ $parent->LoadUserDefinedGroup( $_ );
+ }
+ else {
+ $RT::Logger->error(
+ "(Error: wrong format of MemberOf field."
+ ." Should be name of user defined group or"
+ ." hash reference with 'column => value' pairs."
+ ." Use array reference to add to multiple groups)"
+ );
+ next;
+ }
+ unless ( $parent->Id ) {
+ $RT::Logger->error("(Error: couldn't load group to add member)");
+ next;
+ }
+ my ( $return, $msg ) = $parent->AddMember( $new_entry->Id );
+ unless ( $return ) {
+ $RT::Logger->error( $msg );
+ } else {
+ $RT::Logger->debug( $return ."." );
+ }
+ }
}
}
$RT::Logger->debug("done.");
if ( @Queues ) {
$RT::Logger->debug("Creating queues...");
for my $item (@Queues) {
+ my $attributes = delete $item->{ Attributes };
my $new_entry = RT::Queue->new(RT->SystemUser);
my ( $return, $msg ) = $new_entry->Create(%$item);
unless ( $return ) {
$RT::Logger->error( $msg );
} else {
$RT::Logger->debug( $return ."." );
+ $_->{Object} = $new_entry for @{$attributes || []};
+ push @Attributes, @{$attributes || []};
}
}
$RT::Logger->debug("done.");
if ( @CustomFields ) {
$RT::Logger->debug("Creating custom fields...");
for my $item ( @CustomFields ) {
+ my $attributes = delete $item->{ Attributes };
my $new_entry = RT::CustomField->new( RT->SystemUser );
my $values = delete $item->{'Values'};
- my @queues;
- # if ref then it's list of queues, so we do things ourself
- if ( exists $item->{'Queue'} && ref $item->{'Queue'} ) {
+ # Back-compat for the old "Queue" argument
+ if ( exists $item->{'Queue'} ) {
$item->{'LookupType'} ||= 'RT::Queue-RT::Ticket';
- @queues = @{ delete $item->{'Queue'} };
+ $RT::Logger->warn("Queue provided for non-ticket custom field")
+ unless $item->{'LookupType'} =~ /^RT::Queue-/;
+ $item->{'ApplyTo'} = delete $item->{'Queue'};
}
+ my $apply_to = delete $item->{'ApplyTo'};
+
if ( $item->{'BasedOn'} ) {
if ( $item->{'BasedOn'} =~ /^\d+$/) {
# Already have an ID -- should be fine
} elsif ( $item->{'LookupType'} ) {
my $basedon = RT::CustomField->new($RT::SystemUser);
- my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'},
- LookupType => $item->{'LookupType'} );
+ my ($ok, $msg ) = $basedon->LoadByCols(
+ Name => $item->{'BasedOn'},
+ LookupType => $item->{'LookupType'},
+ Disabled => 0 );
if ($ok) {
$item->{'BasedOn'} = $basedon->Id;
} else {
}
foreach my $value ( @{$values} ) {
- my ( $return, $msg ) = $new_entry->AddValue(%$value);
+ ( $return, $msg ) = $new_entry->AddValue(%$value);
$RT::Logger->error( $msg ) unless $return;
}
- # apply by default
- if ( !@queues && !exists $item->{'Queue'} && $item->{LookupType} ) {
- my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
- $ocf->Create( CustomField => $new_entry->Id );
- }
-
- for my $q (@queues) {
- my $q_obj = RT::Queue->new(RT->SystemUser);
- $q_obj->Load($q);
- unless ( $q_obj->Id ) {
- $RT::Logger->error("Could not find queue ". $q );
- next;
+ my $class = $new_entry->RecordClassFromLookupType;
+ if ($class) {
+ if ($new_entry->IsOnlyGlobal and $apply_to) {
+ $RT::Logger->warn("ApplyTo provided for global custom field ".$new_entry->Name );
+ undef $apply_to;
+ }
+ if ( !$apply_to ) {
+ # Apply to all by default
+ my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
+ ( $return, $msg) = $ocf->Create( CustomField => $new_entry->Id );
+ $RT::Logger->error( $msg ) unless $return and $ocf->Id;
+ } else {
+ $apply_to = [ $apply_to ] unless ref $apply_to;
+ for my $name ( @{ $apply_to } ) {
+ my $obj = $class->new(RT->SystemUser);
+ $obj->Load($name);
+ if ( $obj->Id ) {
+ my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
+ ( $return, $msg ) = $ocf->Create(
+ CustomField => $new_entry->Id,
+ ObjectId => $obj->Id,
+ );
+ $RT::Logger->error( $msg ) unless $return and $ocf->Id;
+ } else {
+ $RT::Logger->error("Could not find $class $name to apply ".$new_entry->Name." to" );
+ }
+ }
}
- my $OCF = RT::ObjectCustomField->new(RT->SystemUser);
- ( $return, $msg ) = $OCF->Create(
- CustomField => $new_entry->Id,
- ObjectId => $q_obj->Id,
- );
- $RT::Logger->error( $msg ) unless $return and $OCF->Id;
}
+
+ $_->{Object} = $new_entry for @{$attributes || []};
+ push @Attributes, @{$attributes || []};
}
$RT::Logger->debug("done.");
if ( $item->{'CF'} ) {
$object = RT::CustomField->new( RT->SystemUser );
my @columns = ( Name => $item->{'CF'} );
+ push @columns, LookupType => $item->{'LookupType'} if $item->{'LookupType'};
+ push @columns, ObjectId => $item->{'ObjectId'} if $item->{'ObjectId'};
push @columns, Queue => $item->{'Queue'} if $item->{'Queue'} and not ref $item->{'Queue'};
- $object->LoadByName( @columns );
+ my ($ok, $msg) = $object->LoadByName( @columns );
+ unless ( $ok ) {
+ RT->Logger->error("Unable to load CF ".$item->{CF}.": $msg");
+ next;
+ }
} elsif ( $item->{'Queue'} ) {
$object = RT::Queue->new(RT->SystemUser);
- $object->Load( $item->{'Queue'} );
+ my ($ok, $msg) = $object->Load( $item->{'Queue'} );
+ unless ( $ok ) {
+ RT->Logger->error("Unable to load queue ".$item->{Queue}.": $msg");
+ next;
+ }
+ } elsif ( $item->{ObjectType} and $item->{ObjectId}) {
+ $object = $item->{ObjectType}->new(RT->SystemUser);
+ my ($ok, $msg) = $object->Load( $item->{ObjectId} );
+ unless ( $ok ) {
+ RT->Logger->error("Unable to load ".$item->{ObjectType}." ".$item->{ObjectId}.": $msg");
+ next;
+ }
} else {
$object = $RT::System;
}
- $RT::Logger->error("Couldn't load object") and next unless $object and $object->Id;
-
# Group rights or user rights?
if ( $item->{'GroupDomain'} ) {
$princ = RT::Group->new(RT->SystemUser);
} elsif ( $item->{'GroupDomain'} eq 'SystemInternal' ) {
$princ->LoadSystemInternalGroup( $item->{'GroupType'} );
} elsif ( $item->{'GroupDomain'} eq 'RT::System-Role' ) {
- $princ->LoadSystemRoleGroup( $item->{'GroupType'} );
+ $princ->LoadRoleGroup( Object => RT->System, Name => $item->{'GroupType'} );
} elsif ( $item->{'GroupDomain'} eq 'RT::Queue-Role' &&
$item->{'Queue'} )
{
- $princ->LoadQueueRoleGroup( Type => $item->{'GroupType'},
- Queue => $object->id);
+ $princ->LoadRoleGroup( Object => $object, Name => $item->{'GroupType'} );
} else {
$princ->Load( $item->{'GroupId'} );
}
}
# Grant it
- my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
- Right => $item->{'Right'},
- Object => $object
- );
- unless ( $return ) {
- $RT::Logger->error( $msg );
- }
- else {
- $RT::Logger->debug( $return ."." );
+ my @rights = ref($item->{'Right'}) eq 'ARRAY' ? @{$item->{'Right'}} : $item->{'Right'};
+ foreach my $right ( @rights ) {
+ my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
+ Right => $right,
+ Object => $object
+ );
+ unless ( $return ) {
+ $RT::Logger->error( $msg );
+ }
+ else {
+ $RT::Logger->debug( $return ."." );
+ }
}
}
$RT::Logger->debug("done.");
my @queues = ref $item->{'Queue'} eq 'ARRAY'? @{ $item->{'Queue'} }: $item->{'Queue'} || 0;
push @queues, 0 unless @queues; # add global queue at least
+ my ( $return, $msg ) = $new_entry->Create( %$item, Queue => shift @queues );
+ unless ( $return ) {
+ $RT::Logger->error( $msg );
+ next;
+ }
+ else {
+ $RT::Logger->debug( $return ."." );
+ }
foreach my $q ( @queues ) {
- my ( $return, $msg ) = $new_entry->Create( %$item, Queue => $q );
- unless ( $return ) {
- $RT::Logger->error( $msg );
- }
- else {
- $RT::Logger->debug( $return ."." );
- }
+ my ($return, $msg) = $new_entry->AddToObject(
+ ObjectId => $q,
+ Stage => $item->{'Stage'},
+ );
+ $RT::Logger->error( "Couldn't apply scrip to $q: $msg" )
+ unless $return;
}
}
$RT::Logger->debug("done.");
my $sys = RT::System->new(RT->SystemUser);
for my $item (@Attributes) {
- my $obj = delete $item->{Object}; # XXX: make this something loadable
+ my $obj = delete $item->{Object};
+
+ if ( ref $obj eq 'CODE' ) {
+ $obj = $obj->();
+ }
+
$obj ||= $sys;
my ( $return, $msg ) = $obj->AddAttribute (%$item);
unless ( $return ) {
return $sql;
}
+sub Indexes {
+ my $self = shift;
+
+ my %res;
+
+ my $db_type = RT->Config->Get('DatabaseType');
+ my $dbh = $self->dbh;
+
+ my $list;
+ if ( $db_type eq 'mysql' ) {
+ $list = $dbh->selectall_arrayref(
+ 'select distinct table_name, index_name from information_schema.statistics where table_schema = ?',
+ undef, scalar RT->Config->Get('DatabaseName')
+ );
+ }
+ elsif ( $db_type eq 'Pg' ) {
+ $list = $dbh->selectall_arrayref(
+ 'select tablename, indexname from pg_indexes',
+ undef,
+ );
+ }
+ elsif ( $db_type eq 'SQLite' ) {
+ $list = $dbh->selectall_arrayref(
+ 'select tbl_name, name from sqlite_master where type = ?',
+ undef, 'index'
+ );
+ }
+ elsif ( $db_type eq 'Oracle' ) {
+ $list = $dbh->selectall_arrayref(
+ 'select table_name, index_name from all_indexes where index_name NOT LIKE ? AND lower(Owner) = ?',
+ undef, 'SYS_%$$', lc RT->Config->Get('DatabaseUser'),
+ );
+ }
+ else {
+ die "Not implemented";
+ }
+ push @{ $res{ lc $_->[0] } ||= [] }, lc $_->[1] foreach @$list;
+ return %res;
+}
+
+sub IndexesThatBeginWith {
+ my $self = shift;
+ my %args = (Table => undef, Columns => [], @_);
+
+ my %indexes = $self->Indexes;
+
+ my @check = @{ $args{'Columns'} };
+
+ my @list;
+ foreach my $index ( @{ $indexes{ lc $args{'Table'} } || [] } ) {
+ my %info = $self->IndexInfo( Table => $args{'Table'}, Name => $index );
+ next if @{ $info{'Columns'} } < @check;
+ my $check = join ',', @check;
+ next if join( ',', @{ $info{'Columns'} } ) !~ /^\Q$check\E(?:,|$)/i;
+
+ push @list, \%info;
+ }
+ return sort { @{ $a->{'Columns'} } <=> @{ $b->{'Columns'} } } @list;
+}
+
+sub IndexInfo {
+ my $self = shift;
+ my %args = (Table => undef, Name => undef, @_);
+
+ my $db_type = RT->Config->Get('DatabaseType');
+ my $dbh = $self->dbh;
+
+ my %res = (
+ Table => lc $args{'Table'},
+ Name => lc $args{'Name'},
+ );
+ if ( $db_type eq 'mysql' ) {
+ my $list = $dbh->selectall_arrayref(
+ 'select NON_UNIQUE, COLUMN_NAME, SUB_PART
+ from information_schema.statistics
+ where table_schema = ? AND LOWER(table_name) = ? AND index_name = ?
+ ORDER BY SEQ_IN_INDEX',
+ undef, scalar RT->Config->Get('DatabaseName'), lc $args{'Table'}, $args{'Name'},
+ );
+ return () unless $list && @$list;
+ $res{'Unique'} = $list->[0][0]? 0 : 1;
+ $res{'Functional'} = 0;
+ $res{'Columns'} = [ map $_->[1], @$list ];
+ }
+ elsif ( $db_type eq 'Pg' ) {
+ my $index = $dbh->selectrow_hashref(
+ 'select ix.*, pg_get_expr(ix.indexprs, ix.indrelid) as functions
+ from
+ pg_class t, pg_class i, pg_index ix
+ where
+ t.relname ilike ?
+ and t.relkind = ?
+ and i.relname ilike ?
+ and ix.indrelid = t.oid
+ and ix.indexrelid = i.oid
+ ',
+ undef, $args{'Table'}, 'r', $args{'Name'},
+ );
+ return () unless $index && keys %$index;
+ $res{'Unique'} = $index->{'indisunique'};
+ $res{'Functional'} = (grep $_ == 0, split ' ', $index->{'indkey'})? 1 : 0;
+ $res{'Columns'} = [ map int($_), split ' ', $index->{'indkey'} ];
+ my $columns = $dbh->selectall_hashref(
+ 'select a.attnum, a.attname
+ from pg_attribute a where a.attrelid = ?',
+ 'attnum', undef, $index->{'indrelid'}
+ );
+ if ($index->{'functions'}) {
+ # XXX: this is good enough for us
+ $index->{'functions'} = [ split /,\s+/, $index->{'functions'} ];
+ }
+ foreach my $e ( @{ $res{'Columns'} } ) {
+ if (exists $columns->{$e} ) {
+ $e = $columns->{$e}{'attname'};
+ }
+ elsif ( !$e ) {
+ $e = shift @{ $index->{'functions'} };
+ }
+ }
+
+ foreach my $column ( @{$res{'Columns'}} ) {
+ next unless $column =~ s/^lower\( \s* \(? (\w+) \)? (?:::text)? \s* \)$/$1/ix;
+ $res{'CaseInsensitive'}{ lc $1 } = 1;
+ }
+ }
+ elsif ( $db_type eq 'SQLite' ) {
+ my $list = $dbh->selectall_arrayref("pragma index_info('$args{'Name'}')");
+ return () unless $list && @$list;
+
+ $res{'Functional'} = 0;
+ $res{'Columns'} = [ map $_->[2], @$list ];
+
+ $list = $dbh->selectall_arrayref("pragma index_list('$args{'Table'}')");
+ $res{'Unique'} = (grep lc $_->[1] eq lc $args{'Name'}, @$list)[0][2]? 1 : 0;
+ }
+ elsif ( $db_type eq 'Oracle' ) {
+ my $index = $dbh->selectrow_arrayref(
+ 'select uniqueness, funcidx_status from all_indexes
+ where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(Owner) = ?',
+ undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
+ );
+ return () unless $index && @$index;
+ $res{'Unique'} = $index->[0] eq 'UNIQUE'? 1 : 0;
+ $res{'Functional'} = $index->[1] ? 1 : 0;
+
+ my %columns = map @$_, @{ $dbh->selectall_arrayref(
+ 'select column_position, column_name from all_ind_columns
+ where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?',
+ undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
+ ) };
+ $columns{ $_->[0] } = $_->[1] foreach @{ $dbh->selectall_arrayref(
+ 'select column_position, column_expression from all_ind_expressions
+ where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?',
+ undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
+ ) };
+ $res{'Columns'} = [ map $columns{$_}, sort { $a <=> $b } keys %columns ];
+
+ foreach my $column ( @{$res{'Columns'}} ) {
+ next unless $column =~ s/^lower\( \s* " (\w+) " \s* \)$/$1/ix;
+ $res{'CaseInsensitive'}{ lc $1 } = 1;
+ }
+ }
+ else {
+ die "Not implemented";
+ }
+ $_ = lc $_ foreach @{ $res{'Columns'} };
+ return %res;
+}
+
+sub DropIndex {
+ my $self = shift;
+ my %args = (Table => undef, Name => undef, @_);
+
+ my $db_type = RT->Config->Get('DatabaseType');
+ my $dbh = $self->dbh;
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 0;
+
+ my $res;
+ if ( $db_type eq 'mysql' ) {
+ $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} );
+ $res = $dbh->do(
+ 'drop index '. $dbh->quote_identifier($args{'Name'}) ." on $args{'Table'}",
+ );
+ }
+ elsif ( $db_type eq 'Pg' ) {
+ $res = $dbh->do("drop index $args{'Name'} CASCADE");
+ }
+ elsif ( $db_type eq 'SQLite' ) {
+ $res = $dbh->do("drop index $args{'Name'}");
+ }
+ elsif ( $db_type eq 'Oracle' ) {
+ my $user = RT->Config->Get('DatabaseUser');
+ # Check if it has constraints associated with it
+ my ($constraint) = $dbh->selectrow_arrayref(
+ 'SELECT constraint_name, table_name FROM all_constraints WHERE LOWER(owner) = ? AND LOWER(index_name) = ?',
+ undef, lc $user, lc $args{'Name'}
+ );
+ if ($constraint) {
+ my ($constraint_name, $table) = @{$constraint};
+ $res = $dbh->do("ALTER TABLE $user.$table DROP CONSTRAINT $constraint_name");
+ } else {
+ $res = $dbh->do("DROP INDEX $user.$args{'Name'}");
+ }
+ }
+ else {
+ die "Not implemented";
+ }
+ my $desc = $self->IndexDescription( %args );
+ return ($res, $res? "Dropped $desc" : "Couldn't drop $desc: ". $dbh->errstr);
+}
+
+sub _CanonicTableNameMysql {
+ my $self = shift;
+ my $table = shift;
+ return $table unless $table;
+ # table name can be case sensitivity in DDL
+ # use LOWER to workaround mysql "bug"
+ return ($self->dbh->selectrow_array(
+ 'SELECT table_name
+ FROM information_schema.tables
+ WHERE table_schema = ? AND LOWER(table_name) = ?',
+ undef, scalar RT->Config->Get('DatabaseName'), lc $table
+ ))[0] || $table;
+}
+
+sub DropIndexIfExists {
+ my $self = shift;
+ my %args = (Table => undef, Name => undef, @_);
+
+ my %indexes = $self->Indexes;
+ return (1, ucfirst($self->IndexDescription( %args )) ." doesn't exists")
+ unless grep $_ eq lc $args{'Name'},
+ @{ $indexes{ lc $args{'Table'} } || []};
+ return $self->DropIndex(%args);
+}
+
+sub CreateIndex {
+ my $self = shift;
+ my %args = ( Table => undef, Name => undef, Columns => [], CaseInsensitive => {}, @_ );
+
+ $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} )
+ if RT->Config->Get('DatabaseType') eq 'mysql';
+
+ my $name = $args{'Name'};
+ unless ( $name ) {
+ my %indexes = $self->Indexes;
+ %indexes = map { $_ => 1 } @{ $indexes{ lc $args{'Table'} } || [] };
+ my $i = 1;
+ $i++ while $indexes{ lc($args{'Table'}).$i };
+ $name = lc($args{'Table'}).$i;
+ }
+
+ my @columns = @{ $args{'Columns'} };
+ if ( $self->CaseSensitive ) {
+ foreach my $column ( @columns ) {
+ next unless $args{'CaseInsensitive'}{ lc $column };
+ $column = "LOWER($column)";
+ }
+ }
+
+ my $sql = "CREATE"
+ . ($args{'Unique'}? ' UNIQUE' : '')
+ ." INDEX $name ON $args{'Table'}"
+ ."(". join( ', ', @columns ) .")"
+ ;
+
+ my $res = $self->dbh->do( $sql );
+ unless ( $res ) {
+ return (
+ undef, "Failed to create ". $self->IndexDescription( %args )
+ ." (sql: $sql): ". $self->dbh->errstr
+ );
+ }
+ return ($name, "Created ". $self->IndexDescription( %args ) );
+}
+
+sub IndexDescription {
+ my $self = shift;
+ my %args = (@_);
+
+ my $desc =
+ ($args{'Unique'}? 'unique ' : '')
+ .'index'
+ . ($args{'Name'}? " $args{'Name'}" : '')
+ . ( @{$args{'Columns'}||[]}?
+ " ("
+ . join(', ', @{$args{'Columns'}})
+ . (@{$args{'Optional'}||[]}? '['. join(', ', '', @{$args{'Optional'}}).']' : '' )
+ .")"
+ : ''
+ )
+ . ($args{'Table'}? " on $args{'Table'}" : '')
+ ;
+ return $desc;
+}
+
+sub MakeSureIndexExists {
+ my $self = shift;
+ my %args = ( Table => undef, Columns => [], Optional => [], @_ );
+
+ my @list = $self->IndexesThatBeginWith(
+ Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
+ );
+ if (@list) {
+ RT->Logger->debug( ucfirst $self->IndexDescription(
+ Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
+ ). ' exists.' );
+ return;
+ }
+
+ @list = $self->IndexesThatBeginWith(
+ Table => $args{'Table'}, Columns => $args{'Columns'},
+ );
+ if ( !@list ) {
+ my ($status, $msg) = $self->CreateIndex(
+ Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
+ );
+ my $method = $status ? 'debug' : 'warning';
+ RT->Logger->$method($msg);
+ }
+ else {
+ RT->Logger->info(
+ ucfirst $self->IndexDescription(
+ %{$list[0]}
+ )
+ .' exists, you may consider replacing it with '
+ . $self->IndexDescription(
+ Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
+ )
+ );
+ }
+}
+
+sub DropIndexesThatArePrefix {
+ my $self = shift;
+ my %args = ( Table => undef, Columns => [], @_ );
+
+ my @list = $self->IndexesThatBeginWith(
+ Table => $args{'Table'}, Columns => [$args{'Columns'}[0]],
+ );
+
+ my $checking = join ',', map lc $_, @{ $args{'Columns'} }, '';
+ foreach my $i ( splice @list ) {
+ my $columns = join ',', @{ $i->{'Columns'} }, '';
+ next unless $checking =~ /^\Q$columns/i;
+
+ push @list, $i;
+ }
+ pop @list;
+
+ foreach my $i ( @list ) {
+ my ($status, $msg) = $self->DropIndex(
+ Table => $i->{'Table'}, Name => $i->{'Name'},
+ );
+ my $method = $status ? 'debug' : 'warning';
+ RT->Logger->$method($msg);
+ }
+}
+
# log a mason stack trace instead of a Carp::longmess because it's less painful
# and uses mason component paths properly
sub _LogSQLStatement {
push @{$self->{'StatementLog'}} , ([Time::HiRes::time(), $statement, [@bind], $duration, HTML::Mason::Exception->new->as_string]);
}
+# helper in a few cases where we do SQL by hand
+sub __MakeClauseCaseInsensitive {
+ my $self = shift;
+ return join ' ', @_ unless $self->CaseSensitive;
+ my ($field, $op, $value) = $self->_MakeClauseCaseInsensitive(@_);
+ return "$field $op $value";
+}
sub _TableNames {
my $self = shift;
projects / freeside.git / blobdiff