X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FHandle.pm;h=35d218c1d09ef0c450a778dc81f298bbaef8960c;hp=7ba5ee8b088ba670c2e39804fc181458a146ec98;hb=70e31cdfd01949235897035ad818e9a7b2d0c958;hpb=ef20b2b6b1feb47ad02b5ff7525f1a0fd11d0fa4 diff --git a/rt/lib/RT/Handle.pm b/rt/lib/RT/Handle.pm index 7ba5ee8b0..35d218c1d 100644 --- a/rt/lib/RT/Handle.pm +++ b/rt/lib/RT/Handle.pm @@ -1,40 +1,40 @@ # BEGIN BPS TAGGED BLOCK {{{ -# +# # COPYRIGHT: -# -# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC -# -# +# +# This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC +# +# # (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/copyleft/gpl.html. -# -# +# 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 @@ -43,101 +43,1759 @@ # 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 }}} + =head1 NAME - RT::Handle - RT's database handle +RT::Handle - RT's database handle =head1 SYNOPSIS - use RT::Handle; + use RT; + BEGIN { RT::LoadConfig() }; + use RT::Handle; =head1 DESCRIPTION -=begin testing +C is RT specific wrapper over one of L +classes. As RT works with different types of DBs we subclass repsective handler +from L. Type of the DB is defined by L. You B load this module only when +the configs have been loaded. + +=cut -ok(require RT::Handle); +package RT::Handle; -=end testing +use strict; +use warnings; + +use File::Spec; =head1 METHODS +=head2 FinalizeDatabaseType + +Sets RT::Handle's superclass to the correct subclass of +L, using the C configuration. + =cut -package RT::Handle; +sub FinalizeDatabaseType { + my $db_type = RT->Config->Get('DatabaseType'); + my $package = "DBIx::SearchBuilder::Handle::$db_type"; -use strict; -use vars qw/@ISA/; + $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". + $@; -eval "use DBIx::SearchBuilder::Handle::$RT::DatabaseType; -\@ISA= qw(DBIx::SearchBuilder::Handle::$RT::DatabaseType);"; + @RT::Handle::ISA = ($package); -if ($@) { - die "Unable to load DBIx::SearchBuilder database handle for '$RT::DatabaseType'.". - "\n". - "Perhaps you've picked an invalid database type or spelled it incorrectly.". - "\n". $@; + # 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}; + } } =head2 Connect -Connects to RT's database handle. -Takes nothing. Calls SUPER::Connect with the needed args +Connects to RT's database using credentials and options from the RT config. +Takes nothing. =cut sub Connect { my $self = shift; + my %args = (@_); - if ($RT::DatabaseType eq 'Oracle') { + my $db_type = RT->Config->Get('DatabaseType'); + if ( $db_type eq 'Oracle' ) { $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8"; $ENV{'NLS_NCHAR'} = "AL32UTF8"; - } $self->SUPER::Connect( - User => $RT::DatabaseUser, - Password => $RT::DatabasePassword, - ); + User => RT->Config->Get('DatabaseUser'), + Password => RT->Config->Get('DatabasePassword'), + DisconnectHandleOnDestroy => 1, + %args, + ); - $self->dbh->{LongReadLen} = $RT::MaxAttachmentSize; - + if ( $db_type eq 'mysql' ) { + my $version = $self->DatabaseVersion; + ($version) = $version =~ /^(\d+\.\d+)/; + $self->dbh->do("SET NAMES 'utf8'") if $version >= 4.1; + } + + + 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; + } + + + + $self->dbh->{'LongReadLen'} = RT->Config->Get('MaxAttachmentSize'); } =head2 BuildDSN -Build the DSN for the RT database. doesn't take any parameters, draws all that -from the config file. +Build the DSN for the RT database. Doesn't take any parameters, draws all that +from the config. =cut -use File::Spec; sub BuildDSN { my $self = shift; -# Unless the database port is a positive integer, we really don't want to pass it. -$RT::DatabasePort = undef unless (defined $RT::DatabasePort && $RT::DatabasePort =~ /^(\d+)$/); -$RT::DatabaseHost = undef unless (defined $RT::DatabaseHost && $RT::DatabaseHost ne ''); -$RT::DatabaseName = File::Spec->catfile($RT::VarPath, $RT::DatabaseName) - if ($RT::DatabaseType eq 'SQLite') and - not File::Spec->file_name_is_absolute($RT::DatabaseName); + # Unless the database port is a positive integer, we really don't want to pass it. + my $db_port = RT->Config->Get('DatabasePort'); + $db_port = undef unless (defined $db_port && $db_port =~ /^(\d+)$/); + my $db_host = RT->Config->Get('DatabaseHost'); + $db_host = undef unless $db_host; + my $db_name = RT->Config->Get('DatabaseName'); + my $db_type = RT->Config->Get('DatabaseType'); + $db_name = File::Spec->catfile($RT::VarPath, $db_name) + if $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name); + + my %args = ( + Host => $db_host, + Database => $db_name, + Port => $db_port, + Driver => $db_type, + ); + 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 + +Returns the DSN for this handle. In order to get correct value you must +build DSN first, see L. + +This is method can be called as class method, in this case creates +temporary handle object, L and returns it. + +=cut + +sub DSN { + my $self = shift; + return $self->SUPER::DSN if ref $self; + + my $handle = $self->new; + $handle->BuildDSN; + return $handle->DSN; +} + +=head2 SystemDSN + +Returns a DSN suitable for database creates and drops +and user creates and drops. + +Gets RT's DSN first (see L) and then change it according +to requirements of a database system RT's using. + +=cut + +sub SystemDSN { + my $self = shift; + + my $db_name = RT->Config->Get('DatabaseName'); + my $db_type = RT->Config->Get('DatabaseType'); + + my $dsn = $self->DSN; + if ( $db_type eq 'mysql' ) { + # with mysql, you want to connect sans database to funge things + $dsn =~ s/dbname=\Q$db_name//; + } + elsif ( $db_type eq 'Pg' ) { + # with postgres, you want to connect to template1 database + $dsn =~ s/dbname=\Q$db_name/dbname=template1/; + } + return $dsn; +} + +=head2 Database compatibility and integrity checks + + + +=cut + +sub CheckIntegrity { + my $self = shift; + + unless ($RT::Handle and $RT::Handle->dbh) { + local $@; + unless ( eval { RT::ConnectToDatabase(); 1 } ) { + return (0, 'no connection', "$@"); + } + } + + require RT::CurrentUser; + 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 '". $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 '". $RT::Handle->DSN ."'"); + } + + return 1; +} + +sub CheckCompatibility { + my $self = shift; + my $dbh = shift; + my $state = shift || 'post'; + + my $db_type = RT->Config->Get('DatabaseType'); + if ( $db_type eq "mysql" ) { + # Check which version we're running + my $version = ($dbh->selectrow_array("show variables like 'version'"))[1]; + return (0, "couldn't get version of the mysql server") + unless $version; + + ($version) = $version =~ /^(\d+\.\d+)/; + return (0, "RT is unsupported on MySQL versions before 4.1. Your version is $version.") + if $version < 4.1; + + # MySQL must have InnoDB support + local $dbh->{FetchHashKeyName} = 'NAME_lc'; + my $innodb = lc($dbh->selectall_hashref("SHOW ENGINES", "engine")->{InnoDB}{support} || "no"); + if ( $innodb eq "no" ) { + return (0, "RT requires that MySQL be compiled with InnoDB table support.\n". + "See \n". + "and check that there are no 'skip-innodb' lines in your my.cnf."); + } elsif ( $innodb eq "disabled" ) { + return (0, "RT requires that MySQL InnoDB table support be enabled.\n". + "Remove the 'skip-innodb' or 'innodb = OFF' line from your my.cnf file, restart MySQL, and try again.\n"); + } + + if ( $state eq 'post' ) { + 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."); + } + + 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."); + } + } + + 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) +} + +sub CheckSphinxSE { + my $self = shift; + + my $dbh = $RT::Handle->dbh; + local $dbh->{'RaiseError'} = 0; + local $dbh->{'PrintError'} = 0; + my $has = ($dbh->selectrow_array("show variables like 'have_sphinx'"))[1]; + $has ||= ($dbh->selectrow_array( + "select 'yes' from INFORMATION_SCHEMA.PLUGINS where PLUGIN_NAME = 'sphinx' AND PLUGIN_STATUS='active'" + ))[0]; + + return 0 unless lc($has||'') eq "yes"; + return 1; +} + +=head2 Database maintanance + +=head3 CreateDatabase $DBH + +Creates a new database. This method can be used as class method. + +Takes DBI handle. Many database systems require special handle to +allow you to create a new database, so you have to use L +method during connection. + +Fetches type and name of the DB from the config. + +=cut + +sub CreateDatabase { + my $self = shift; + my $dbh = shift or return (0, "No DBI handle provided"); + my $db_type = RT->Config->Get('DatabaseType'); + my $db_name = RT->Config->Get('DatabaseName'); + + my $status; + if ( $db_type eq 'SQLite' ) { + return (1, 'Skipped as SQLite doesn\'t need any action'); + } + elsif ( $db_type eq 'Oracle' ) { + my $db_user = RT->Config->Get('DatabaseUser'); + my $db_pass = RT->Config->Get('DatabasePassword'); + $status = $dbh->do( + "CREATE USER $db_user IDENTIFIED BY $db_pass" + ." default tablespace USERS" + ." temporary tablespace TEMP" + ." quota unlimited on USERS" + ); + unless ( $status ) { + return $status, "Couldn't create user $db_user identified by $db_pass." + ."\nError: ". $dbh->errstr; + } + $status = $dbh->do( "GRANT connect, resource TO $db_user" ); + unless ( $status ) { + return $status, "Couldn't grant connect and resource to $db_user." + ."\nError: ". $dbh->errstr; + } + return (1, "Created user $db_user. All RT's objects should be in his schema."); + } + elsif ( $db_type eq 'Pg' ) { + $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"); + } + else { + $status = $dbh->do("CREATE DATABASE $db_name"); + } + return ($status, $DBI::errstr); +} + +=head3 DropDatabase $DBH + +Drops RT's database. This method can be used as class method. + +Takes DBI handle as first argument. Many database systems require +a special handle to allow you to drop a database, so you may have +to use L when acquiring the DBI handle. + +Fetches the type and name of the database from the config. + +=cut + +sub DropDatabase { + my $self = shift; + my $dbh = shift or return (0, "No DBI handle provided"); + + my $db_type = RT->Config->Get('DatabaseType'); + my $db_name = RT->Config->Get('DatabaseName'); + + if ( $db_type eq 'Oracle' ) { + my $db_user = RT->Config->Get('DatabaseUser'); + my $status = $dbh->do( "DROP USER $db_user CASCADE" ); + unless ( $status ) { + return 0, "Couldn't drop user $db_user." + ."\nError: ". $dbh->errstr; + } + return (1, "Successfully dropped user '$db_user' with his schema."); + } + elsif ( $db_type eq 'SQLite' ) { + my $path = $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); +} + +=head2 InsertACL + +=cut + +sub InsertACL { + my $self = shift; + my $dbh = shift; + my $base_path = shift || $RT::EtcPath; + + my $db_type = RT->Config->Get('DatabaseType'); + return (1) if $db_type eq 'SQLite'; + + $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, "acl.$db_type"); + $path = $self->GetVersionFile($dbh, $path); + + $path = File::Spec->catfile( $base_path, "acl") + unless $path && -e $path; + return (0, "Couldn't find ACLs for $db_type") + unless -e $path; + } else { + $path = $base_path; + } + + local *acl; + do $path || return (0, "Couldn't load ACLs: " . $@); + my @acl = acl($dbh); + foreach my $statement (@acl) { + my $sth = $dbh->prepare($statement) + or return (0, "Couldn't prepare SQL query:\n $statement\n\nERROR: ". $dbh->errstr); + unless ( $sth->execute ) { + return (0, "Couldn't run SQL query:\n $statement\n\nERROR: ". $sth->errstr); + } + } + return (1); +} + +=head2 InsertSchema + +=cut + +sub InsertSchema { + my $self = shift; + my $dbh = shift; + my $base_path = (shift || $RT::EtcPath); + + $dbh = $self->dbh if !$dbh && ref $self; + return (0, "No DBI handle provided") unless $dbh; + + my $db_type = RT->Config->Get('DatabaseType'); + + my $file; + if ( -d $base_path ) { + $file = $base_path . "/schema." . $db_type; + } else { + $file = $base_path; + } + + $file = $self->GetVersionFile( $dbh, $file ); + unless ( $file ) { + return (0, "Couldn't find schema file(s) '$file*'"); + } + unless ( -f $file && -r $file ) { + return (0, "File '$file' doesn't exist or couldn't be read"); + } + + my (@schema); + + open( my $fh_schema, '<', $file ) or die $!; + + my $has_local = 0; + open( my $fh_schema_local, "<" . $self->GetVersionFile( $dbh, $RT::LocalEtcPath . "/schema." . $db_type )) + and $has_local = 1; + + my $statement = ""; + foreach my $line ( <$fh_schema>, ($_ = ';;'), $has_local? <$fh_schema_local>: () ) { + $line =~ s/\#.*//g; + $line =~ s/--.*//g; + $statement .= $line; + if ( $line =~ /;(\s*)$/ ) { + $statement =~ s/;(\s*)$//g; + push @schema, $statement; + $statement = ""; + } + } + close $fh_schema; close $fh_schema_local; + + 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 $SIG{__WARN__} = sub {}; + my $is_local = 0; + $dbh->begin_work or return (0, "Couldn't begin transaction: ". $dbh->errstr); + foreach my $statement (@schema) { + if ( $statement =~ /^\s*;$/ ) { + $is_local = 1; next; + } + + my $sth = $dbh->prepare($statement) + or return (0, "Couldn't prepare SQL query:\n$statement\n\nERROR: ". $dbh->errstr); + unless ( $sth->execute or $is_local ) { + return (0, "Couldn't run SQL query:\n$statement\n\nERROR: ". $sth->errstr); + } + } + $dbh->commit or return (0, "Couldn't commit transaction: ". $dbh->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 - named +files and returns file name with closest version to the version of the RT DB. + +=cut + +sub GetVersionFile { + my $self = shift; + my $dbh = shift; + my $base_name = shift; + + my $db_version = ref $self + ? $self->DatabaseVersion + : do { + my $tmp = RT::Handle->new; + $tmp->dbh($dbh); + $tmp->DatabaseVersion; + }; + + require File::Glob; + my @files = File::Glob::bsd_glob("$base_name*"); + return '' unless @files; + + my %version = map { $_ =~ /\.\w+-([-\w\.]+)$/; ($1||0) => $_ } @files; + my $version; + foreach ( reverse sort cmp_version keys %version ) { + if ( cmp_version( $db_version, $_ ) >= 0 ) { + $version = $_; + last; + } + } + + return defined $version? $version{ $version } : undef; +} + +{ my %word = ( + a => -4, + alpha => -4, + b => -3, + beta => -3, + pre => -2, + rc => -1, + head => 9999, +); +sub cmp_version($$) { + my ($a, $b) = (@_); + my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef } + split /([^0-9]+)/, $a; + my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef } + split /([^0-9]+)/, $b; + @a > @b + ? push @b, (0) x (@a-@b) + : push @a, (0) x (@b-@a); + for ( my $i = 0; $i < @a; $i++ ) { + return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i]; + } + return 0; +} + +sub version_words { + return keys %word; +} + +} + + +=head2 InsertInitialData + +Inserts system objects into RT's DB, like system user or 'nobody', +internal groups and other records required. However, this method +doesn't insert any real users like 'root' and you have to use +InsertData or another way to do that. + +Takes no arguments. Returns status and message tuple. + +It's safe to call this method even if those objects already exist. + +=cut + +sub InsertInitialData { + my $self = shift; + + my @warns; + + # create RT_System user and grant him rights + { + require RT::CurrentUser; + + my $test_user = RT::User->new( RT::CurrentUser->new() ); + $test_user->Load('RT_System'); + if ( $test_user->id ) { + push @warns, "Found system user in the DB."; + } + else { + my $user = RT::User->new( RT::CurrentUser->new() ); + my ( $val, $msg ) = $user->_BootstrapCreate( + Name => 'RT_System', + RealName => 'The RT System itself', + Comments => 'Do not delete or modify this user. ' + . 'It is integral to RT\'s internal database structures', + Creator => '1', + LastUpdatedBy => '1', + ); + return ($val, $msg) unless $val; + } + DBIx::SearchBuilder::Record::Cachable->FlushCache; + } + + # init RT::SystemUser and RT::System objects + RT::InitSystemObjects(); + unless ( RT->SystemUser->id ) { + return (0, "Couldn't load system user"); + } + + # grant SuperUser right to system user + { + my $test_ace = RT::ACE->new( RT->SystemUser ); + $test_ace->LoadByCols( + PrincipalId => ACLEquivGroupId( RT->SystemUser->Id ), + PrincipalType => 'Group', + RightName => 'SuperUser', + ObjectType => 'RT::System', + ObjectId => 1, + ); + if ( $test_ace->id ) { + push @warns, "System user has global SuperUser right."; + } else { + my $ace = RT::ACE->new( RT->SystemUser ); + my ( $val, $msg ) = $ace->_BootstrapCreate( + PrincipalId => ACLEquivGroupId( RT->SystemUser->Id ), + PrincipalType => 'Group', + RightName => 'SuperUser', + ObjectType => 'RT::System', + ObjectId => 1, + ); + return ($val, $msg) unless $val; + } + DBIx::SearchBuilder::Record::Cachable->FlushCache; + } + + # system groups + # $self->loc('Everyone'); # For the string extractor to get a string to localize + # $self->loc('Privileged'); # For the string extractor to get a string to localize + # $self->loc('Unprivileged'); # For the string extractor to get a string to localize + foreach my $name (qw(Everyone Privileged Unprivileged)) { + my $group = RT::Group->new( RT->SystemUser ); + $group->LoadSystemInternalGroup( $name ); + if ( $group->id ) { + push @warns, "System group '$name' already exists."; + next; + } + + $group = RT::Group->new( RT->SystemUser ); + my ( $val, $msg ) = $group->_Create( + Domain => 'SystemInternal', + Description => 'Pseudogroup for internal use', # loc + Name => $name, + Instance => '', + ); + return ($val, $msg) unless $val; + } + + # nobody + { + my $user = RT::User->new( RT->SystemUser ); + $user->Load('Nobody'); + if ( $user->id ) { + push @warns, "Found 'Nobody' user in the DB."; + } + else { + my ( $val, $msg ) = $user->Create( + Name => 'Nobody', + RealName => 'Nobody in particular', + Comments => 'Do not delete or modify this user. It is integral ' + .'to RT\'s internal data structures', + Privileged => 0, + ); + return ($val, $msg) unless $val; + } + + if ( $user->HasRight( Right => 'OwnTicket', Object => $RT::System ) ) { + push @warns, "User 'Nobody' has global OwnTicket right."; + } else { + my ( $val, $msg ) = $user->PrincipalObj->GrantRight( + Right => 'OwnTicket', + Object => $RT::System, + ); + return ($val, $msg) unless $val; + } + } + + # rerun to get init Nobody as well + RT::InitSystemObjects(); + + # system role groups + foreach my $name (qw(Owner Requestor Cc AdminCc)) { + 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->CreateRoleGroup( + Name => $name, + Object => RT->System, + Description => 'SystemRolegroup for internal use', # loc + InsideTransaction => 0, + ); + return ($val, $msg) unless $val; + } + + push @warns, "You appear to have a functional RT database." + if @warns; + + return (1, join "\n", @warns); +} + +=head2 InsertData + +Load some sort of data into the database, takes path to a file. + +=cut + +sub InsertData { + my $self = shift; + my $datafile = shift; + my $root_password = shift; + my %args = ( + disconnect_after => 1, + @_ + ); + + # Slurp in stuff to insert from the datafile. Possible things to go in here:- + our (@Groups, @Users, @Members, @ACL, @Queues, @ScripActions, @ScripConditions, + @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final); + local (@Groups, @Users, @Members, @ACL, @Queues, @ScripActions, @ScripConditions, + @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final); + + local $@; + $RT::Logger->debug("Going to load '$datafile' data file"); + eval { require $datafile } + or return (0, "Couldn't load data from '$datafile' for import:\n\nERROR:". $@); + + if ( @Initial ) { + $RT::Logger->debug("Running initial actions..."); + foreach ( @Initial ) { + local $@; + eval { $_->(); 1 } or return (0, "One of initial functions failed: $@"); + } + $RT::Logger->debug("Done."); + } + 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'; + my $member_of = delete $item->{'MemberOf'}; + my $members = delete $item->{'Members'}; + my ( $return, $msg ) = $new_entry->_Create(%$item); + unless ( $return ) { + $RT::Logger->error( $msg ); + 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'; + 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 ."." ); + } + } + } + push @Members, map { +{Group => $new_entry->id, + Class => "RT::User", Name => $_} } + @{ $members->{Users} || [] }; + push @Members, map { +{Group => $new_entry->id, + Class => "RT::Group", Name => $_} } + @{ $members->{Groups} || [] }; + } + $RT::Logger->debug("done."); + } + 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 ( @Members ) { + $RT::Logger->debug("Adding users and groups to groups..."); + for my $item (@Members) { + my $group = RT::Group->new(RT->SystemUser); + $group->LoadUserDefinedGroup( delete $item->{Group} ); + unless ($group->Id) { + RT->Logger->error("Unable to find group '$group' to add members to"); + next; + } + + my $class = delete $item->{Class} || 'RT::User'; + my $member = $class->new( RT->SystemUser ); + $item->{Domain} = 'UserDefined' if $member->isa("RT::Group"); + $member->LoadByCols( %$item ); + unless ($member->Id) { + RT->Logger->error("Unable to find $class '".($item->{id} || $item->{Name})."' to add to ".$group->Name); + next; + } + + my ( $return, $msg) = $group->AddMember( $member->PrincipalObj->Id ); + unless ( $return ) { + $RT::Logger->error( $msg ); + } else { + $RT::Logger->debug( $return ."." ); + } + } + } + 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'}; + + # Back-compat for the old "Queue" argument + if ( exists $item->{'Queue'} ) { + $item->{'LookupType'} ||= 'RT::Queue-RT::Ticket'; + $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'}, + Disabled => 0 ); + if ($ok) { + $item->{'BasedOn'} = $basedon->Id; + } else { + $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF. Skipping BasedOn: $msg"); + delete $item->{'BasedOn'}; + } + } else { + $RT::Logger->error("Unable to load CF $item->{BasedOn} because no LookupType was specified. Skipping BasedOn"); + delete $item->{'BasedOn'}; + } + + } + + my ( $return, $msg ) = $new_entry->Create(%$item); + unless( $return ) { + $RT::Logger->error( $msg ); + next; + } + + foreach my $value ( @{$values} ) { + ( $return, $msg ) = $new_entry->AddValue(%$value); + $RT::Logger->error( $msg ) unless $return; + } + + 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" ); + } + } + } + } + + $_->{Object} = $new_entry for @{$attributes || []}; + push @Attributes, @{$attributes || []}; + } + + $RT::Logger->debug("done."); + } + if ( @ACL ) { + $RT::Logger->debug("Creating ACL..."); + for my $item (@ACL) { + + my ($princ, $object); + + # Global rights or Queue rights? + 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'}; + 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); + 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; + } + + # Group rights or user rights? + if ( $item->{'GroupDomain'} ) { + $princ = RT::Group->new(RT->SystemUser); + if ( $item->{'GroupDomain'} eq 'UserDefined' ) { + $princ->LoadUserDefinedGroup( $item->{'GroupId'} ); + } elsif ( $item->{'GroupDomain'} eq 'SystemInternal' ) { + $princ->LoadSystemInternalGroup( $item->{'GroupType'} ); + } elsif ( $item->{'GroupDomain'} eq 'RT::System-Role' ) { + $princ->LoadRoleGroup( Object => RT->System, Name => $item->{'GroupType'} ); + } elsif ( $item->{'GroupDomain'} eq 'RT::Queue-Role' && + $item->{'Queue'} ) + { + $princ->LoadRoleGroup( Object => $object, Name => $item->{'GroupType'} ); + } else { + $princ->Load( $item->{'GroupId'} ); + } + unless ( $princ->Id ) { + RT->Logger->error("Unable to load Group: GroupDomain => $item->{GroupDomain}, GroupId => $item->{GroupId}, Queue => $item->{Queue}"); + next; + } + } else { + $princ = RT::User->new(RT->SystemUser); + my ($ok, $msg) = $princ->Load( $item->{'UserId'} ); + unless ( $ok ) { + RT->Logger->error("Unable to load user: $item->{UserId} : $msg"); + next; + } + } + + # Grant it + 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."); + } + + if ( @ScripActions ) { + $RT::Logger->debug("Creating ScripActions..."); + + for my $item (@ScripActions) { + my $new_entry = RT::ScripAction->new(RT->SystemUser); + my ( $return, $msg ) = $new_entry->Create(%$item); + unless ( $return ) { + $RT::Logger->error( $msg ); + } + else { + $RT::Logger->debug( $return ."." ); + } + } + + $RT::Logger->debug("done."); + } + + if ( @ScripConditions ) { + $RT::Logger->debug("Creating ScripConditions..."); + + for my $item (@ScripConditions) { + my $new_entry = RT::ScripCondition->new(RT->SystemUser); + my ( $return, $msg ) = $new_entry->Create(%$item); + unless ( $return ) { + $RT::Logger->error( $msg ); + } + else { + $RT::Logger->debug( $return ."." ); + } + } + + $RT::Logger->debug("done."); + } + + if ( @Templates ) { + $RT::Logger->debug("Creating templates..."); + + for my $item (@Templates) { + my $new_entry = RT::Template->new(RT->SystemUser); + my ( $return, $msg ) = $new_entry->Create(%$item); + unless ( $return ) { + $RT::Logger->error( $msg ); + } + else { + $RT::Logger->debug( $return ."." ); + } + } + $RT::Logger->debug("done."); + } + if ( @Scrips ) { + $RT::Logger->debug("Creating scrips..."); + + for my $item (@Scrips) { + my $new_entry = RT::Scrip->new(RT->SystemUser); + + 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->AddToObject( + ObjectId => $q, + Stage => $item->{'Stage'}, + ); + $RT::Logger->error( "Couldn't apply scrip to $q: $msg" ) + unless $return; + } + } + $RT::Logger->debug("done."); + } + if ( @Attributes ) { + $RT::Logger->debug("Creating attributes..."); + my $sys = RT::System->new(RT->SystemUser); + + for my $item (@Attributes) { + my $obj = delete $item->{Object}; + + if ( ref $obj eq 'CODE' ) { + $obj = $obj->(); + } + + $obj ||= $sys; + my ( $return, $msg ) = $obj->AddAttribute (%$item); + unless ( $return ) { + $RT::Logger->error( $msg ); + } + else { + $RT::Logger->debug( $return ."." ); + } + } + $RT::Logger->debug("done."); + } + if ( @Final ) { + $RT::Logger->debug("Running final actions..."); + for ( @Final ) { + local $@; + eval { $_->(); }; + $RT::Logger->error( "Failed to run one of final actions: $@" ) + if $@; + } + $RT::Logger->debug("done."); + } + + # XXX: This disconnect doesn't really belong here; it's a relict from when + # this method was extracted from rt-setup-database. However, too much + # depends on it to change without significant testing. At the very least, + # we can provide a way to skip the side-effect. + if ( $args{disconnect_after} ) { + my $db_type = RT->Config->Get('DatabaseType'); + $RT::Handle->Disconnect() unless $db_type eq 'SQLite'; + } + + $RT::Logger->debug("Done setting up database content."); + +# TODO is it ok to return 1 here? If so, the previous codes in this sub +# should return (0, $msg) if error happens instead of just warning. +# anyway, we need to return something here to tell if everything is ok + return( 1, 'Done inserting data' ); +} + +=head2 ACLEquivGroupId + +Given a userid, return that user's acl equivalence group + +=cut + +sub ACLEquivGroupId { + my $id = shift; + + my $cu = RT->SystemUser; + unless ( $cu ) { + require RT::CurrentUser; + $cu = RT::CurrentUser->new; + $cu->LoadByName('RT_System'); + warn "Couldn't load RT_System user" unless $cu->id; + } + + my $equiv_group = RT::Group->new( $cu ); + $equiv_group->LoadACLEquivalenceGroup( $id ); + return $equiv_group->Id; +} + +=head2 QueryHistory + +Returns the SQL query history associated with this handle. The top level array +represents a lists of request. Each request is a hash with metadata about the +request (such as the URL) and a list of queries. You'll probably not be using this. + +=cut + +sub QueryHistory { + my $self = shift; + + return $self->{QueryHistory}; +} + +=head2 AddRequestToHistory + +Adds a web request to the query history. It must be a hash with keys Path (a +string) and Queries (an array reference of arrays, where elements are time, +sql, bind parameters, and duration). + +=cut + +sub AddRequestToHistory { + my $self = shift; + my $request = shift; + + push @{ $self->{QueryHistory} }, $request; +} + +=head2 Quote + +Returns the parameter quoted by DBI. B +Use bind parameters (C) instead. This is used only outside the scope of interacting +with the database. + +=cut + +sub Quote { + my $self = shift; + my $value = shift; + + return $self->dbh->quote($value); +} + +=head2 FillIn + +Takes a SQL query and an array reference of bind parameters and fills in the +query's C parameters. + +=cut + +sub FillIn { + my $self = shift; + my $sql = shift; + my $bind = shift; + + my $b = 0; + + # is this regex sufficient? + $sql =~ s{\?}{$self->Quote($bind->[$b++])}eg; + + 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; +} - $self->SUPER::BuildDSN(Host => $RT::DatabaseHost, - Database => $RT::DatabaseName, - Port => $RT::DatabasePort, - Driver => $RT::DatabaseType, - RequireSSL => $RT::DatabaseRequireSSL, - DisconnectHandleOnDestroy => 1 - ); - +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); } -eval "require RT::Handle_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Handle_Vendor.pm}); -eval "require RT::Handle_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Handle_Local.pm}); +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 { + my $self = shift; + my $statement = shift; + my $duration = shift; + my @bind = @_; + + require HTML::Mason::Exceptions; + 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; + my $dbh = shift || $self->dbh; + + { + local $@; + if ( + $dbh->{Driver}->{Name} eq 'Pg' + && $dbh->{'pg_server_version'} >= 90200 + && !eval { DBD::Pg->VERSION('2.19.3'); 1 } + ) { + die "You're using PostgreSQL 9.2 or newer. You have to upgrade DBD::Pg module to 2.19.3 or newer: $@"; + } + } + + my @res; + + my $sth = $dbh->table_info( '', undef, undef, "'TABLE'"); + while ( my $table = $sth->fetchrow_hashref ) { + push @res, $table->{TABLE_NAME} || $table->{table_name}; + } + + return @res; +} + +__PACKAGE__->FinalizeDatabaseType; + +RT::Base->_ImportOverlays(); 1;