lib/RT/Handle.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 =head1 NAME
  50
  51 RT::Handle - RT's database handle
  52
  53 =head1 SYNOPSIS
  54
  55     use RT;
  56     BEGIN { RT::LoadConfig() };
  57     use RT::Handle;
  58
  59 =head1 DESCRIPTION
  60
  61 C<RT::Handle> is RT specific wrapper over one of L<DBIx::SearchBuilder::Handle>
  62 classes. As RT works with different types of DBs we subclass repsective handler
  63 from L<DBIx::SearchBuilder>. Type of the DB is defined by L<RT's DatabaseType
  64 config option|RT_Config/DatabaseType>. You B<must> load this module only when
  65 the configs have been loaded.
  66
  67 =cut
  68
  69 package RT::Handle;
  70
  71 use strict;
  72 use warnings;
  73
  74 use File::Spec;
  75
  76 =head1 METHODS
  77
  78 =head2 FinalizeDatabaseType
  79
  80 Sets RT::Handle's superclass to the correct subclass of
  81 L<DBIx::SearchBuilder::Handle>, using the C<DatabaseType> configuration.
  82
  83 =cut
  84
  85 sub FinalizeDatabaseType {
  86     eval {
  87         use base "DBIx::SearchBuilder::Handle::". RT->Config->Get('DatabaseType');
  88     };
  89
  90     my $db_type = RT->Config->Get('DatabaseType');
  91     if ($@) {
  92         die "Unable to load DBIx::SearchBuilder database handle for '$db_type'.\n".
  93             "Perhaps you've picked an invalid database type or spelled it incorrectly.\n".
  94             $@;
  95     }
  96
  97     # We use COLLATE NOCASE to enforce case insensitivity on the normally
  98     # case-sensitive SQLite, LOWER() approach works, but lucks performance
  99     # due to absence of functional indexes
 100     if ($db_type eq 'SQLite') {
 101         no strict 'refs'; no warnings 'redefine';
 102         *DBIx::SearchBuilder::Handle::SQLite::CaseSensitive = sub {0};
 103     }
 104 }
 105
 106 =head2 Connect
 107
 108 Connects to RT's database using credentials and options from the RT config.
 109 Takes nothing.
 110
 111 =cut
 112
 113 sub Connect {
 114     my $self = shift;
 115     my %args = (@_);
 116
 117     my $db_type = RT->Config->Get('DatabaseType');
 118     if ( $db_type eq 'Oracle' ) {
 119         $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8";
 120         $ENV{'NLS_NCHAR'} = "AL32UTF8";
 121     }
 122
 123     $self->SUPER::Connect(
 124         User => RT->Config->Get('DatabaseUser'),
 125         Password => RT->Config->Get('DatabasePassword'),
 126         DisconnectHandleOnDestroy => 1,
 127         %args,
 128     );
 129
 130     if ( $db_type eq 'mysql' ) {
 131         my $version = $self->DatabaseVersion;
 132         ($version) = $version =~ /^(\d+\.\d+)/;
 133         $self->dbh->do("SET NAMES 'utf8'") if $version >= 4.1;
 134     }
 135     elsif ( $db_type eq 'Pg' ) {
 136         my $version = $self->DatabaseVersion;
 137         ($version) = $version =~ /^(\d+\.\d+)/;
 138         $self->dbh->do("SET bytea_output = 'escape'") if $version >= 9.0;
 139     }
 140
 141     $self->dbh->{'LongReadLen'} = RT->Config->Get('MaxAttachmentSize');
 142 }
 143
 144 =head2 BuildDSN
 145
 146 Build the DSN for the RT database. Doesn't take any parameters, draws all that
 147 from the config.
 148
 149 =cut
 150
 151
 152 sub BuildDSN {
 153     my $self = shift;
 154     # Unless the database port is a positive integer, we really don't want to pass it.
 155     my $db_port = RT->Config->Get('DatabasePort');
 156     $db_port = undef unless (defined $db_port && $db_port =~ /^(\d+)$/);
 157     my $db_host = RT->Config->Get('DatabaseHost');
 158     $db_host = undef unless $db_host;
 159     my $db_name = RT->Config->Get('DatabaseName');
 160     my $db_type = RT->Config->Get('DatabaseType');
 161     $db_name = File::Spec->catfile($RT::VarPath, $db_name)
 162         if $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name);
 163
 164     my %args = (
 165         Host       => $db_host,
 166         Database   => $db_name,
 167         Port       => $db_port,
 168         Driver     => $db_type,
 169         RequireSSL => RT->Config->Get('DatabaseRequireSSL'),
 170     );
 171     if ( $db_type eq 'Oracle' && $db_host ) {
 172         $args{'SID'} = delete $args{'Database'};
 173     }
 174     $self->SUPER::BuildDSN( %args );
 175 }
 176
 177 =head2 DSN
 178
 179 Returns the DSN for this handle. In order to get correct value you must
 180 build DSN first, see L</BuildDSN>.
 181
 182 This is method can be called as class method, in this case creates
 183 temporary handle object, L</BuildDSN builds DSN> and returns it.
 184
 185 =cut
 186
 187 sub DSN {
 188     my $self = shift;
 189     return $self->SUPER::DSN if ref $self;
 190
 191     my $handle = $self->new;
 192     $handle->BuildDSN;
 193     return $handle->DSN;
 194 }
 195
 196 =head2 SystemDSN
 197
 198 Returns a DSN suitable for database creates and drops
 199 and user creates and drops.
 200
 201 Gets RT's DSN first (see L<DSN>) and then change it according
 202 to requirements of a database system RT's using.
 203
 204 =cut
 205
 206 sub SystemDSN {
 207     my $self = shift;
 208
 209     my $db_name = RT->Config->Get('DatabaseName');
 210     my $db_type = RT->Config->Get('DatabaseType');
 211
 212     my $dsn = $self->DSN;
 213     if ( $db_type eq 'mysql' ) {
 214         # with mysql, you want to connect sans database to funge things
 215         $dsn =~ s/dbname=\Q$db_name//;
 216     }
 217     elsif ( $db_type eq 'Pg' ) {
 218         # with postgres, you want to connect to template1 database
 219         $dsn =~ s/dbname=\Q$db_name/dbname=template1/;
 220     }
 221     return $dsn;
 222 }
 223
 224 =head2 Database compatibility and integrity checks
 225
 226
 227
 228 =cut
 229
 230 sub CheckIntegrity {
 231     my $self = shift;
 232
 233     unless ($RT::Handle and $RT::Handle->dbh) {
 234         local $@;
 235         unless ( eval { RT::ConnectToDatabase(); 1 } ) {
 236             return (0, 'no connection', "$@");
 237         }
 238     }
 239
 240     require RT::CurrentUser;
 241     my $test_user = RT::CurrentUser->new;
 242     $test_user->Load('RT_System');
 243     unless ( $test_user->id ) {
 244         return (0, 'no system user', "Couldn't find RT_System user in the DB '". $RT::Handle->DSN ."'");
 245     }
 246
 247     $test_user = RT::CurrentUser->new;
 248     $test_user->Load('Nobody');
 249     unless ( $test_user->id ) {
 250         return (0, 'no nobody user', "Couldn't find Nobody user in the DB '". $RT::Handle->DSN ."'");
 251     }
 252
 253     return $RT::Handle->dbh;
 254 }
 255
 256 sub CheckCompatibility {
 257     my $self = shift;
 258     my $dbh = shift;
 259     my $state = shift || 'post';
 260
 261     my $db_type = RT->Config->Get('DatabaseType');
 262     if ( $db_type eq "mysql" ) {
 263         # Check which version we're running
 264         my $version = ($dbh->selectrow_array("show variables like 'version'"))[1];
 265         return (0, "couldn't get version of the mysql server")
 266             unless $version;
 267
 268         ($version) = $version =~ /^(\d+\.\d+)/;
 269         return (0, "RT is unsupported on MySQL versions before 4.1.  Your version is $version.")
 270             if $version < 4.1;
 271
 272         # MySQL must have InnoDB support
 273         local $dbh->{FetchHashKeyName} = 'NAME_lc';
 274         my $innodb = lc($dbh->selectall_hashref("SHOW ENGINES", "engine")->{InnoDB}{support} || "no");
 275         if ( $innodb eq "no" ) {
 276             return (0, "RT requires that MySQL be compiled with InnoDB table support.\n".
 277                 "See <http://dev.mysql.com/doc/mysql/en/innodb-storage-engine.html>\n".
 278                 "and check that there are no 'skip-innodb' lines in your my.cnf.");
 279         } elsif ( $innodb eq "disabled" ) {
 280             return (0, "RT requires that MySQL InnoDB table support be enabled.\n".
 281                 "Remove the 'skip-innodb' or 'innodb = OFF' line from your my.cnf file, restart MySQL, and try again.\n");
 282         }
 283
 284         if ( $state eq 'post' ) {
 285             my $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Tickets")->[1];
 286             unless ( $create_table =~ /(?:ENGINE|TYPE)\s*=\s*InnoDB/i ) {
 287                 return (0, "RT requires that all its tables be of InnoDB type. Upgrade RT tables.");
 288             }
 289
 290             $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Attachments")->[1];
 291             unless ( $create_table =~ /\bContent\b[^,]*BLOB/i ) {
 292                 return (0, "RT since version 3.8 has new schema for MySQL versions after 4.1.0\n"
 293                     ."Follow instructions in the UPGRADING.mysql file.");
 294             }
 295         }
 296
 297         my $max_packet = ($dbh->selectrow_array("show variables like 'max_allowed_packet'"))[1];
 298         if ($state =~ /^(create|post)$/ and $max_packet <= (1024 * 1024)) {
 299             my $max_packet = sprintf("%.1fM", $max_packet/1024/1024);
 300             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";
 301         }
 302     }
 303     return (1)
 304 }
 305
 306 sub CheckSphinxSE {
 307     my $self = shift;
 308
 309     my $dbh = $RT::Handle->dbh;
 310     local $dbh->{'RaiseError'} = 0;
 311     local $dbh->{'PrintError'} = 0;
 312     my $has = ($dbh->selectrow_array("show variables like 'have_sphinx'"))[1];
 313     $has ||= ($dbh->selectrow_array(
 314         "select 'yes' from INFORMATION_SCHEMA.PLUGINS where PLUGIN_NAME = 'sphinx' AND PLUGIN_STATUS='active'"
 315     ))[0];
 316
 317     return 0 unless lc($has||'') eq "yes";
 318     return 1;
 319 }
 320
 321 =head2 Database maintanance
 322
 323 =head3 CreateDatabase $DBH
 324
 325 Creates a new database. This method can be used as class method.
 326
 327 Takes DBI handle. Many database systems require special handle to
 328 allow you to create a new database, so you have to use L<SystemDSN>
 329 method during connection.
 330
 331 Fetches type and name of the DB from the config.
 332
 333 =cut
 334
 335 sub CreateDatabase {
 336     my $self = shift;
 337     my $dbh  = shift or return (0, "No DBI handle provided");
 338     my $db_type = RT->Config->Get('DatabaseType');
 339     my $db_name = RT->Config->Get('DatabaseName');
 340
 341     my $status;
 342     if ( $db_type eq 'SQLite' ) {
 343         return (1, 'Skipped as SQLite doesn\'t need any action');
 344     }
 345     elsif ( $db_type eq 'Oracle' ) {
 346         my $db_user = RT->Config->Get('DatabaseUser');
 347         my $db_pass = RT->Config->Get('DatabasePassword');
 348         $status = $dbh->do(
 349             "CREATE USER $db_user IDENTIFIED BY $db_pass"
 350             ." default tablespace USERS"
 351             ." temporary tablespace TEMP"
 352             ." quota unlimited on USERS"
 353         );
 354         unless ( $status ) {
 355             return $status, "Couldn't create user $db_user identified by $db_pass."
 356                 ."\nError: ". $dbh->errstr;
 357         }
 358         $status = $dbh->do( "GRANT connect, resource TO $db_user" );
 359         unless ( $status ) {
 360             return $status, "Couldn't grant connect and resource to $db_user."
 361                 ."\nError: ". $dbh->errstr;
 362         }
 363         return (1, "Created user $db_user. All RT's objects should be in his schema.");
 364     }
 365     elsif ( $db_type eq 'Pg' ) {
 366         $status = $dbh->do("CREATE DATABASE $db_name WITH ENCODING='UNICODE' TEMPLATE template0");
 367     }
 368     else {
 369         $status = $dbh->do("CREATE DATABASE $db_name");
 370     }
 371     return ($status, $DBI::errstr);
 372 }
 373
 374 =head3 DropDatabase $DBH
 375
 376 Drops RT's database. This method can be used as class method.
 377
 378 Takes DBI handle as first argument. Many database systems require
 379 a special handle to allow you to drop a database, so you may have
 380 to use L<SystemDSN> when acquiring the DBI handle.
 381
 382 Fetches the type and name of the database from the config.
 383
 384 =cut
 385
 386 sub DropDatabase {
 387     my $self = shift;
 388     my $dbh  = shift or return (0, "No DBI handle provided");
 389
 390     my $db_type = RT->Config->Get('DatabaseType');
 391     my $db_name = RT->Config->Get('DatabaseName');
 392
 393     if ( $db_type eq 'Oracle' ) {
 394         my $db_user = RT->Config->Get('DatabaseUser');
 395         my $status = $dbh->do( "DROP USER $db_user CASCADE" );
 396         unless ( $status ) {
 397             return 0, "Couldn't drop user $db_user."
 398                 ."\nError: ". $dbh->errstr;
 399         }
 400         return (1, "Successfully dropped user '$db_user' with his schema.");
 401     }
 402     elsif ( $db_type eq 'SQLite' ) {
 403         my $path = $db_name;
 404         $path = "$RT::VarPath/$path" unless substr($path, 0, 1) eq '/';
 405         unlink $path or return (0, "Couldn't remove '$path': $!");
 406         return (1);
 407     } else {
 408         $dbh->do("DROP DATABASE ". $db_name)
 409             or return (0, $DBI::errstr);
 410     }
 411     return (1);
 412 }
 413
 414 =head2 InsertACL
 415
 416 =cut
 417
 418 sub InsertACL {
 419     my $self      = shift;
 420     my $dbh       = shift;
 421     my $base_path = shift || $RT::EtcPath;
 422
 423     my $db_type = RT->Config->Get('DatabaseType');
 424     return (1) if $db_type eq 'SQLite';
 425
 426     $dbh = $self->dbh if !$dbh && ref $self;
 427     return (0, "No DBI handle provided") unless $dbh;
 428
 429     return (0, "'$base_path' doesn't exist") unless -e $base_path;
 430
 431     my $path;
 432     if ( -d $base_path ) {
 433         $path = File::Spec->catfile( $base_path, "acl.$db_type");
 434         $path = $self->GetVersionFile($dbh, $path);
 435
 436         $path = File::Spec->catfile( $base_path, "acl")
 437             unless $path && -e $path;
 438         return (0, "Couldn't find ACLs for $db_type")
 439             unless -e $path;
 440     } else {
 441         $path = $base_path;
 442     }
 443
 444     local *acl;
 445     do $path || return (0, "Couldn't load ACLs: " . $@);
 446     my @acl = acl($dbh);
 447     foreach my $statement (@acl) {
 448         my $sth = $dbh->prepare($statement)
 449             or return (0, "Couldn't prepare SQL query:\n $statement\n\nERROR: ". $dbh->errstr);
 450         unless ( $sth->execute ) {
 451             return (0, "Couldn't run SQL query:\n $statement\n\nERROR: ". $sth->errstr);
 452         }
 453     }
 454     return (1);
 455 }
 456
 457 =head2 InsertSchema
 458
 459 =cut
 460
 461 sub InsertSchema {
 462     my $self = shift;
 463     my $dbh  = shift;
 464     my $base_path = (shift || $RT::EtcPath);
 465
 466     $dbh = $self->dbh if !$dbh && ref $self;
 467     return (0, "No DBI handle provided") unless $dbh;
 468
 469     my $db_type = RT->Config->Get('DatabaseType');
 470
 471     my $file;
 472     if ( -d $base_path ) {
 473         $file = $base_path . "/schema." . $db_type;
 474     } else {
 475         $file = $base_path;
 476     }
 477
 478     $file = $self->GetVersionFile( $dbh, $file );
 479     unless ( $file ) {
 480         return (0, "Couldn't find schema file(s) '$file*'");
 481     }
 482     unless ( -f $file && -r $file ) {
 483         return (0, "File '$file' doesn't exist or couldn't be read");
 484     }
 485
 486     my (@schema);
 487
 488     open( my $fh_schema, '<', $file ) or die $!;
 489
 490     my $has_local = 0;
 491     open( my $fh_schema_local, "<" . $self->GetVersionFile( $dbh, $RT::LocalEtcPath . "/schema." . $db_type ))
 492         and $has_local = 1;
 493
 494     my $statement = "";
 495     foreach my $line ( <$fh_schema>, ($_ = ';;'), $has_local? <$fh_schema_local>: () ) {
 496         $line =~ s/\#.*//g;
 497         $line =~ s/--.*//g;
 498         $statement .= $line;
 499         if ( $line =~ /;(\s*)$/ ) {
 500             $statement =~ s/;(\s*)$//g;
 501             push @schema, $statement;
 502             $statement = "";
 503         }
 504     }
 505     close $fh_schema; close $fh_schema_local;
 506
 507     if ( $db_type eq 'Oracle' ) {
 508         my $db_user = RT->Config->Get('DatabaseUser');
 509         my $status = $dbh->do( "ALTER SESSION SET CURRENT_SCHEMA=$db_user" );
 510         unless ( $status ) {
 511             return $status, "Couldn't set current schema to $db_user."
 512                 ."\nError: ". $dbh->errstr;
 513         }
 514     }
 515
 516     local $SIG{__WARN__} = sub {};
 517     my $is_local = 0;
 518     $dbh->begin_work or return (0, "Couldn't begin transaction: ". $dbh->errstr);
 519     foreach my $statement (@schema) {
 520         if ( $statement =~ /^\s*;$/ ) {
 521             $is_local = 1; next;
 522         }
 523
 524         my $sth = $dbh->prepare($statement)
 525             or return (0, "Couldn't prepare SQL query:\n$statement\n\nERROR: ". $dbh->errstr);
 526         unless ( $sth->execute or $is_local ) {
 527             return (0, "Couldn't run SQL query:\n$statement\n\nERROR: ". $sth->errstr);
 528         }
 529     }
 530     $dbh->commit or return (0, "Couldn't commit transaction: ". $dbh->errstr);
 531     return (1);
 532 }
 533
 534 sub InsertIndexes {
 535     my $self      = shift;
 536     my $dbh       = shift;
 537     my $base_path = shift || $RT::EtcPath;
 538
 539     my $db_type = RT->Config->Get('DatabaseType');
 540
 541     $dbh = $self->dbh if !$dbh && ref $self;
 542     return (0, "No DBI handle provided") unless $dbh;
 543
 544     return (0, "'$base_path' doesn't exist") unless -e $base_path;
 545
 546     my $path;
 547     if ( -d $base_path ) {
 548         $path = File::Spec->catfile( $base_path, "indexes");
 549         return (0, "Couldn't find indexes file")
 550             unless -e $path;
 551     } else {
 552         $path = $base_path;
 553     }
 554
 555     local $@;
 556     eval { require $path; 1 }
 557         or return (0, "Couldn't execute '$path': " . $@);
 558     return (1);
 559 }
 560
 561 =head1 GetVersionFile
 562
 563 Takes base name of the file as argument, scans for <base name>-<version> named
 564 files and returns file name with closest version to the version of the RT DB.
 565
 566 =cut
 567
 568 sub GetVersionFile {
 569     my $self = shift;
 570     my $dbh = shift;
 571     my $base_name = shift;
 572
 573     my $db_version = ref $self
 574         ? $self->DatabaseVersion
 575         : do {
 576             my $tmp = RT::Handle->new;
 577             $tmp->dbh($dbh);
 578             $tmp->DatabaseVersion;
 579         };
 580
 581     require File::Glob;
 582     my @files = File::Glob::bsd_glob("$base_name*");
 583     return '' unless @files;
 584
 585     my %version = map { $_ =~ /\.\w+-([-\w\.]+)$/; ($1||0) => $_ } @files;
 586     my $version;
 587     foreach ( reverse sort cmp_version keys %version ) {
 588         if ( cmp_version( $db_version, $_ ) >= 0 ) {
 589             $version = $_;
 590             last;
 591         }
 592     }
 593
 594     return defined $version? $version{ $version } : undef;
 595 }
 596
 597 { my %word = (
 598     a     => -4,
 599     alpha => -4,
 600     b     => -3,
 601     beta  => -3,
 602     pre   => -2,
 603     rc    => -1,
 604     head  => 9999,
 605 );
 606 sub cmp_version($$) {
 607     my ($a, $b) = (@_);
 608     my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
 609         split /([^0-9]+)/, $a;
 610     my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
 611         split /([^0-9]+)/, $b;
 612     @a > @b
 613         ? push @b, (0) x (@a-@b)
 614         : push @a, (0) x (@b-@a);
 615     for ( my $i = 0; $i < @a; $i++ ) {
 616         return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
 617     }
 618     return 0;
 619 }
 620
 621 sub version_words {
 622     return keys %word;
 623 }
 624
 625 }
 626
 627
 628 =head2 InsertInitialData
 629
 630 Inserts system objects into RT's DB, like system user or 'nobody',
 631 internal groups and other records required. However, this method
 632 doesn't insert any real users like 'root' and you have to use
 633 InsertData or another way to do that.
 634
 635 Takes no arguments. Returns status and message tuple.
 636
 637 It's safe to call this method even if those objects already exist.
 638
 639 =cut
 640
 641 sub InsertInitialData {
 642     my $self    = shift;
 643
 644     my @warns;
 645
 646     # create RT_System user and grant him rights
 647     {
 648         require RT::CurrentUser;
 649
 650         my $test_user = RT::User->new( RT::CurrentUser->new() );
 651         $test_user->Load('RT_System');
 652         if ( $test_user->id ) {
 653             push @warns, "Found system user in the DB.";
 654         }
 655         else {
 656             my $user = RT::User->new( RT::CurrentUser->new() );
 657             my ( $val, $msg ) = $user->_BootstrapCreate(
 658                 Name     => 'RT_System',
 659                 RealName => 'The RT System itself',
 660                 Comments => 'Do not delete or modify this user. '
 661                     . 'It is integral to RT\'s internal database structures',
 662                 Creator  => '1',
 663                 LastUpdatedBy => '1',
 664             );
 665             return ($val, $msg) unless $val;
 666         }
 667         DBIx::SearchBuilder::Record::Cachable->FlushCache;
 668     }
 669
 670     # init RT::SystemUser and RT::System objects
 671     RT::InitSystemObjects();
 672     unless ( RT->SystemUser->id ) {
 673         return (0, "Couldn't load system user");
 674     }
 675
 676     # grant SuperUser right to system user
 677     {
 678         my $test_ace = RT::ACE->new( RT->SystemUser );
 679         $test_ace->LoadByCols(
 680             PrincipalId   => ACLEquivGroupId( RT->SystemUser->Id ),
 681             PrincipalType => 'Group',
 682             RightName     => 'SuperUser',
 683             ObjectType    => 'RT::System',
 684             ObjectId      => 1,
 685         );
 686         if ( $test_ace->id ) {
 687             push @warns, "System user has global SuperUser right.";
 688         } else {
 689             my $ace = RT::ACE->new( RT->SystemUser );
 690             my ( $val, $msg ) = $ace->_BootstrapCreate(
 691                 PrincipalId   => ACLEquivGroupId( RT->SystemUser->Id ),
 692                 PrincipalType => 'Group',
 693                 RightName     => 'SuperUser',
 694                 ObjectType    => 'RT::System',
 695                 ObjectId      => 1,
 696             );
 697             return ($val, $msg) unless $val;
 698         }
 699         DBIx::SearchBuilder::Record::Cachable->FlushCache;
 700     }
 701
 702     # system groups
 703     # $self->loc('Everyone'); # For the string extractor to get a string to localize
 704     # $self->loc('Privileged'); # For the string extractor to get a string to localize
 705     # $self->loc('Unprivileged'); # For the string extractor to get a string to localize
 706     foreach my $name (qw(Everyone Privileged Unprivileged)) {
 707         my $group = RT::Group->new( RT->SystemUser );
 708         $group->LoadSystemInternalGroup( $name );
 709         if ( $group->id ) {
 710             push @warns, "System group '$name' already exists.";
 711             next;
 712         }
 713
 714         $group = RT::Group->new( RT->SystemUser );
 715         my ( $val, $msg ) = $group->_Create(
 716             Domain      => 'SystemInternal',
 717             Description => 'Pseudogroup for internal use',  # loc
 718             Name        => $name,
 719             Instance    => '',
 720         );
 721         return ($val, $msg) unless $val;
 722     }
 723
 724     # nobody
 725     {
 726         my $user = RT::User->new( RT->SystemUser );
 727         $user->Load('Nobody');
 728         if ( $user->id ) {
 729             push @warns, "Found 'Nobody' user in the DB.";
 730         }
 731         else {
 732             my ( $val, $msg ) = $user->Create(
 733                 Name     => 'Nobody',
 734                 RealName => 'Nobody in particular',
 735                 Comments => 'Do not delete or modify this user. It is integral '
 736                     .'to RT\'s internal data structures',
 737                 Privileged => 0,
 738             );
 739             return ($val, $msg) unless $val;
 740         }
 741
 742         if ( $user->HasRight( Right => 'OwnTicket', Object => $RT::System ) ) {
 743             push @warns, "User 'Nobody' has global OwnTicket right.";
 744         } else {
 745             my ( $val, $msg ) = $user->PrincipalObj->GrantRight(
 746                 Right => 'OwnTicket',
 747                 Object => $RT::System,
 748             );
 749             return ($val, $msg) unless $val;
 750         }
 751     }
 752
 753     # rerun to get init Nobody as well
 754     RT::InitSystemObjects();
 755
 756     # system role groups
 757     foreach my $name (qw(Owner Requestor Cc AdminCc)) {
 758         my $group = RT->System->RoleGroup( $name );
 759         if ( $group->id ) {
 760             push @warns, "System role '$name' already exists.";
 761             next;
 762         }
 763
 764         $group = RT::Group->new( RT->SystemUser );
 765         my ( $val, $msg ) = $group->CreateRoleGroup(
 766             Name                => $name,
 767             Object              => RT->System,
 768             Description         => 'SystemRolegroup for internal use',  # loc
 769             InsideTransaction   => 0,
 770         );
 771         return ($val, $msg) unless $val;
 772     }
 773
 774     push @warns, "You appear to have a functional RT database."
 775         if @warns;
 776
 777     return (1, join "\n", @warns);
 778 }
 779
 780 =head2 InsertData
 781
 782 Load some sort of data into the database, takes path to a file.
 783
 784 =cut
 785
 786 sub InsertData {
 787     my $self     = shift;
 788     my $datafile = shift;
 789     my $root_password = shift;
 790     my %args     = (
 791         disconnect_after => 1,
 792         @_
 793     );
 794
 795     # Slurp in stuff to insert from the datafile. Possible things to go in here:-
 796     our (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions,
 797            @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final);
 798     local (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions,
 799            @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final);
 800
 801     local $@;
 802     $RT::Logger->debug("Going to load '$datafile' data file");
 803     eval { require $datafile }
 804       or return (0, "Couldn't load data from '$datafile' for import:\n\nERROR:". $@);
 805
 806     if ( @Initial ) {
 807         $RT::Logger->debug("Running initial actions...");
 808         foreach ( @Initial ) {
 809             local $@;
 810             eval { $_->(); 1 } or return (0, "One of initial functions failed: $@");
 811         }
 812         $RT::Logger->debug("Done.");
 813     }
 814     if ( @Groups ) {
 815         $RT::Logger->debug("Creating groups...");
 816         foreach my $item (@Groups) {
 817             my $new_entry = RT::Group->new( RT->SystemUser );
 818             $item->{'Domain'} ||= 'UserDefined';
 819             my $member_of = delete $item->{'MemberOf'};
 820             my ( $return, $msg ) = $new_entry->_Create(%$item);
 821             unless ( $return ) {
 822                 $RT::Logger->error( $msg );
 823                 next;
 824             } else {
 825                 $RT::Logger->debug($return .".");
 826             }
 827             if ( $member_of ) {
 828                 $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY';
 829                 foreach( @$member_of ) {
 830                     my $parent = RT::Group->new(RT->SystemUser);
 831                     if ( ref $_ eq 'HASH' ) {
 832                         $parent->LoadByCols( %$_ );
 833                     }
 834                     elsif ( !ref $_ ) {
 835                         $parent->LoadUserDefinedGroup( $_ );
 836                     }
 837                     else {
 838                         $RT::Logger->error(
 839                             "(Error: wrong format of MemberOf field."
 840                             ." Should be name of user defined group or"
 841                             ." hash reference with 'column => value' pairs."
 842                             ." Use array reference to add to multiple groups)"
 843                         );
 844                         next;
 845                     }
 846                     unless ( $parent->Id ) {
 847                         $RT::Logger->error("(Error: couldn't load group to add member)");
 848                         next;
 849                     }
 850                     my ( $return, $msg ) = $parent->AddMember( $new_entry->Id );
 851                     unless ( $return ) {
 852                         $RT::Logger->error( $msg );
 853                     } else {
 854                         $RT::Logger->debug( $return ."." );
 855                     }
 856                 }
 857             }
 858         }
 859         $RT::Logger->debug("done.");
 860     }
 861     if ( @Users ) {
 862         $RT::Logger->debug("Creating users...");
 863         foreach my $item (@Users) {
 864             my $member_of = delete $item->{'MemberOf'};
 865             if ( $item->{'Name'} eq 'root' && $root_password ) {
 866                 $item->{'Password'} = $root_password;
 867             }
 868             my $new_entry = RT::User->new( RT->SystemUser );
 869             my ( $return, $msg ) = $new_entry->Create(%$item);
 870             unless ( $return ) {
 871                 $RT::Logger->error( $msg );
 872             } else {
 873                 $RT::Logger->debug( $return ."." );
 874             }
 875             if ( $member_of ) {
 876                 $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY';
 877                 foreach( @$member_of ) {
 878                     my $parent = RT::Group->new($RT::SystemUser);
 879                     if ( ref $_ eq 'HASH' ) {
 880                         $parent->LoadByCols( %$_ );
 881                     }
 882                     elsif ( !ref $_ ) {
 883                         $parent->LoadUserDefinedGroup( $_ );
 884                     }
 885                     else {
 886                         $RT::Logger->error(
 887                             "(Error: wrong format of MemberOf field."
 888                             ." Should be name of user defined group or"
 889                             ." hash reference with 'column => value' pairs."
 890                             ." Use array reference to add to multiple groups)"
 891                         );
 892                         next;
 893                     }
 894                     unless ( $parent->Id ) {
 895                         $RT::Logger->error("(Error: couldn't load group to add member)");
 896                         next;
 897                     }
 898                     my ( $return, $msg ) = $parent->AddMember( $new_entry->Id );
 899                     unless ( $return ) {
 900                         $RT::Logger->error( $msg );
 901                     } else {
 902                         $RT::Logger->debug( $return ."." );
 903                     }
 904                 }
 905             }
 906         }
 907         $RT::Logger->debug("done.");
 908     }
 909     if ( @Queues ) {
 910         $RT::Logger->debug("Creating queues...");
 911         for my $item (@Queues) {
 912             my $new_entry = RT::Queue->new(RT->SystemUser);
 913             my ( $return, $msg ) = $new_entry->Create(%$item);
 914             unless ( $return ) {
 915                 $RT::Logger->error( $msg );
 916             } else {
 917                 $RT::Logger->debug( $return ."." );
 918             }
 919         }
 920         $RT::Logger->debug("done.");
 921     }
 922     if ( @CustomFields ) {
 923         $RT::Logger->debug("Creating custom fields...");
 924         for my $item ( @CustomFields ) {
 925             my $new_entry = RT::CustomField->new( RT->SystemUser );
 926             my $values    = delete $item->{'Values'};
 927
 928             # Back-compat for the old "Queue" argument
 929             if ( exists $item->{'Queue'} ) {
 930                 $item->{'LookupType'} ||= 'RT::Queue-RT::Ticket';
 931                 $RT::Logger->warn("Queue provided for non-ticket custom field")
 932                     unless $item->{'LookupType'} =~ /^RT::Queue-/;
 933                 $item->{'ApplyTo'} = delete $item->{'Queue'};
 934             }
 935
 936             my $apply_to = delete $item->{'ApplyTo'};
 937
 938             if ( $item->{'BasedOn'} ) {
 939                 if ( $item->{'LookupType'} ) {
 940                     my $basedon = RT::CustomField->new($RT::SystemUser);
 941                     my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'},
 942                                                             LookupType => $item->{'LookupType'} );
 943                     if ($ok) {
 944                         $item->{'BasedOn'} = $basedon->Id;
 945                     } else {
 946                         $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF.  Skipping BasedOn: $msg");
 947                         delete $item->{'BasedOn'};
 948                     }
 949                 } else {
 950                     $RT::Logger->error("Unable to load CF $item->{BasedOn} because no LookupType was specified.  Skipping BasedOn");
 951                     delete $item->{'BasedOn'};
 952                 }
 953
 954             }
 955
 956             my ( $return, $msg ) = $new_entry->Create(%$item);
 957             unless( $return ) {
 958                 $RT::Logger->error( $msg );
 959                 next;
 960             }
 961
 962             foreach my $value ( @{$values} ) {
 963                 ( $return, $msg ) = $new_entry->AddValue(%$value);
 964                 $RT::Logger->error( $msg ) unless $return;
 965             }
 966
 967             my $class = $new_entry->RecordClassFromLookupType;
 968             if ($class) {
 969                 if ($new_entry->IsOnlyGlobal and $apply_to) {
 970                     $RT::Logger->warn("ApplyTo provided for global custom field ".$new_entry->Name );
 971                     undef $apply_to;
 972                 }
 973                 if ( !$apply_to ) {
 974                     # Apply to all by default
 975                     my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
 976                     ( $return, $msg) = $ocf->Create( CustomField => $new_entry->Id );
 977                     $RT::Logger->error( $msg ) unless $return and $ocf->Id;
 978                 } else {
 979                     $apply_to = [ $apply_to ] unless ref $apply_to;
 980                     for my $name ( @{ $apply_to } ) {
 981                         my $obj = $class->new(RT->SystemUser);
 982                         $obj->Load($name);
 983                         if ( $obj->Id ) {
 984                             my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
 985                             ( $return, $msg ) = $ocf->Create(
 986                                 CustomField => $new_entry->Id,
 987                                 ObjectId    => $obj->Id,
 988                             );
 989                             $RT::Logger->error( $msg ) unless $return and $ocf->Id;
 990                         } else {
 991                             $RT::Logger->error("Could not find $class $name to apply ".$new_entry->Name." to" );
 992                         }
 993                     }
 994                 }
 995             }
 996         }
 997
 998         $RT::Logger->debug("done.");
 999     }
1000     if ( @ACL ) {
1001         $RT::Logger->debug("Creating ACL...");
1002         for my $item (@ACL) {
1003
1004             my ($princ, $object);
1005
1006             # Global rights or Queue rights?
1007             if ( $item->{'CF'} ) {
1008                 $object = RT::CustomField->new( RT->SystemUser );
1009                 my @columns = ( Name => $item->{'CF'} );
1010                 push @columns, LookupType => $item->{'LookupType'} if $item->{'LookupType'};
1011                 push @columns, Queue => $item->{'Queue'} if $item->{'Queue'} and not ref $item->{'Queue'};
1012                 my ($ok, $msg) = $object->LoadByName( @columns );
1013                 unless ( $ok ) {
1014                     RT->Logger->error("Unable to load CF ".$item->{CF}.": $msg");
1015                     next;
1016                 }
1017             } elsif ( $item->{'Queue'} ) {
1018                 $object = RT::Queue->new(RT->SystemUser);
1019                 my ($ok, $msg) = $object->Load( $item->{'Queue'} );
1020                 unless ( $ok ) {
1021                     RT->Logger->error("Unable to load queue ".$item->{Queue}.": $msg");
1022                     next;
1023                 }
1024             } elsif ( $item->{ObjectType} and $item->{ObjectId}) {
1025                 $object = $item->{ObjectType}->new(RT->SystemUser);
1026                 my ($ok, $msg) = $object->Load( $item->{ObjectId} );
1027                 unless ( $ok ) {
1028                     RT->Logger->error("Unable to load ".$item->{ObjectType}." ".$item->{ObjectId}.": $msg");
1029                     next;
1030                 }
1031             } else {
1032                 $object = $RT::System;
1033             }
1034
1035             # Group rights or user rights?
1036             if ( $item->{'GroupDomain'} ) {
1037                 $princ = RT::Group->new(RT->SystemUser);
1038                 if ( $item->{'GroupDomain'} eq 'UserDefined' ) {
1039                   $princ->LoadUserDefinedGroup( $item->{'GroupId'} );
1040                 } elsif ( $item->{'GroupDomain'} eq 'SystemInternal' ) {
1041                   $princ->LoadSystemInternalGroup( $item->{'GroupType'} );
1042                 } elsif ( $item->{'GroupDomain'} eq 'RT::System-Role' ) {
1043                   $princ->LoadRoleGroup( Object => RT->System, Name => $item->{'GroupType'} );
1044                 } elsif ( $item->{'GroupDomain'} eq 'RT::Queue-Role' &&
1045                           $item->{'Queue'} )
1046                 {
1047                   $princ->LoadRoleGroup( Object => $object, Name => $item->{'GroupType'} );
1048                 } else {
1049                   $princ->Load( $item->{'GroupId'} );
1050                 }
1051                 unless ( $princ->Id ) {
1052                     RT->Logger->error("Unable to load Group: GroupDomain => $item->{GroupDomain}, GroupId => $item->{GroupId}, Queue => $item->{Queue}");
1053                     next;
1054                 }
1055             } else {
1056                 $princ = RT::User->new(RT->SystemUser);
1057                 my ($ok, $msg) = $princ->Load( $item->{'UserId'} );
1058                 unless ( $ok ) {
1059                     RT->Logger->error("Unable to load user: $item->{UserId} : $msg");
1060                     next;
1061                 }
1062             }
1063
1064             # Grant it
1065             my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
1066                 Right => $item->{'Right'},
1067                 Object => $object
1068             );
1069             unless ( $return ) {
1070                 $RT::Logger->error( $msg );
1071             }
1072             else {
1073                 $RT::Logger->debug( $return ."." );
1074             }
1075         }
1076         $RT::Logger->debug("done.");
1077     }
1078
1079     if ( @ScripActions ) {
1080         $RT::Logger->debug("Creating ScripActions...");
1081
1082         for my $item (@ScripActions) {
1083             my $new_entry = RT::ScripAction->new(RT->SystemUser);
1084             my ( $return, $msg ) = $new_entry->Create(%$item);
1085             unless ( $return ) {
1086                 $RT::Logger->error( $msg );
1087             }
1088             else {
1089                 $RT::Logger->debug( $return ."." );
1090             }
1091         }
1092
1093         $RT::Logger->debug("done.");
1094     }
1095
1096     if ( @ScripConditions ) {
1097         $RT::Logger->debug("Creating ScripConditions...");
1098
1099         for my $item (@ScripConditions) {
1100             my $new_entry = RT::ScripCondition->new(RT->SystemUser);
1101             my ( $return, $msg ) = $new_entry->Create(%$item);
1102             unless ( $return ) {
1103                 $RT::Logger->error( $msg );
1104             }
1105             else {
1106                 $RT::Logger->debug( $return ."." );
1107             }
1108         }
1109
1110         $RT::Logger->debug("done.");
1111     }
1112
1113     if ( @Templates ) {
1114         $RT::Logger->debug("Creating templates...");
1115
1116         for my $item (@Templates) {
1117             my $new_entry = RT::Template->new(RT->SystemUser);
1118             my ( $return, $msg ) = $new_entry->Create(%$item);
1119             unless ( $return ) {
1120                 $RT::Logger->error( $msg );
1121             }
1122             else {
1123                 $RT::Logger->debug( $return ."." );
1124             }
1125         }
1126         $RT::Logger->debug("done.");
1127     }
1128     if ( @Scrips ) {
1129         $RT::Logger->debug("Creating scrips...");
1130
1131         for my $item (@Scrips) {
1132             my $new_entry = RT::Scrip->new(RT->SystemUser);
1133
1134             my @queues = ref $item->{'Queue'} eq 'ARRAY'? @{ $item->{'Queue'} }: $item->{'Queue'} || 0;
1135             push @queues, 0 unless @queues; # add global queue at least
1136
1137             my ( $return, $msg ) = $new_entry->Create( %$item, Queue => shift @queues );
1138             unless ( $return ) {
1139                 $RT::Logger->error( $msg );
1140                 next;
1141             }
1142             else {
1143                 $RT::Logger->debug( $return ."." );
1144             }
1145             foreach my $q ( @queues ) {
1146                 my ($return, $msg) = $new_entry->AddToObject(
1147                     ObjectId => $q,
1148                     Stage    => $item->{'Stage'},
1149                 );
1150                 $RT::Logger->error( "Couldn't apply scrip to $q: $msg" )
1151                     unless $return;
1152             }
1153         }
1154         $RT::Logger->debug("done.");
1155     }
1156     if ( @Attributes ) {
1157         $RT::Logger->debug("Creating attributes...");
1158         my $sys = RT::System->new(RT->SystemUser);
1159
1160         for my $item (@Attributes) {
1161             my $obj = delete $item->{Object}; # XXX: make this something loadable
1162             $obj ||= $sys;
1163             my ( $return, $msg ) = $obj->AddAttribute (%$item);
1164             unless ( $return ) {
1165                 $RT::Logger->error( $msg );
1166             }
1167             else {
1168                 $RT::Logger->debug( $return ."." );
1169             }
1170         }
1171         $RT::Logger->debug("done.");
1172     }
1173     if ( @Final ) {
1174         $RT::Logger->debug("Running final actions...");
1175         for ( @Final ) {
1176             local $@;
1177             eval { $_->(); };
1178             $RT::Logger->error( "Failed to run one of final actions: $@" )
1179                 if $@;
1180         }
1181         $RT::Logger->debug("done.");
1182     }
1183
1184     # XXX: This disconnect doesn't really belong here; it's a relict from when
1185     # this method was extracted from rt-setup-database.  However, too much
1186     # depends on it to change without significant testing.  At the very least,
1187     # we can provide a way to skip the side-effect.
1188     if ( $args{disconnect_after} ) {
1189         my $db_type = RT->Config->Get('DatabaseType');
1190         $RT::Handle->Disconnect() unless $db_type eq 'SQLite';
1191     }
1192
1193     $RT::Logger->debug("Done setting up database content.");
1194
1195 # TODO is it ok to return 1 here? If so, the previous codes in this sub
1196 # should return (0, $msg) if error happens instead of just warning.
1197 # anyway, we need to return something here to tell if everything is ok
1198     return( 1, 'Done inserting data' );
1199 }
1200
1201 =head2 ACLEquivGroupId
1202
1203 Given a userid, return that user's acl equivalence group
1204
1205 =cut
1206
1207 sub ACLEquivGroupId {
1208     my $id = shift;
1209
1210     my $cu = RT->SystemUser;
1211     unless ( $cu ) {
1212         require RT::CurrentUser;
1213         $cu = RT::CurrentUser->new;
1214         $cu->LoadByName('RT_System');
1215         warn "Couldn't load RT_System user" unless $cu->id;
1216     }
1217
1218     my $equiv_group = RT::Group->new( $cu );
1219     $equiv_group->LoadACLEquivalenceGroup( $id );
1220     return $equiv_group->Id;
1221 }
1222
1223 =head2 QueryHistory
1224
1225 Returns the SQL query history associated with this handle. The top level array
1226 represents a lists of request. Each request is a hash with metadata about the
1227 request (such as the URL) and a list of queries. You'll probably not be using this.
1228
1229 =cut
1230
1231 sub QueryHistory {
1232     my $self = shift;
1233
1234     return $self->{QueryHistory};
1235 }
1236
1237 =head2 AddRequestToHistory
1238
1239 Adds a web request to the query history. It must be a hash with keys Path (a
1240 string) and Queries (an array reference of arrays, where elements are time,
1241 sql, bind parameters, and duration).
1242
1243 =cut
1244
1245 sub AddRequestToHistory {
1246     my $self    = shift;
1247     my $request = shift;
1248
1249     push @{ $self->{QueryHistory} }, $request;
1250 }
1251
1252 =head2 Quote
1253
1254 Returns the parameter quoted by DBI. B<You almost certainly do not need this.>
1255 Use bind parameters (C<?>) instead. This is used only outside the scope of interacting
1256 with the database.
1257
1258 =cut
1259
1260 sub Quote {
1261     my $self = shift;
1262     my $value = shift;
1263
1264     return $self->dbh->quote($value);
1265 }
1266
1267 =head2 FillIn
1268
1269 Takes a SQL query and an array reference of bind parameters and fills in the
1270 query's C<?> parameters.
1271
1272 =cut
1273
1274 sub FillIn {
1275     my $self = shift;
1276     my $sql  = shift;
1277     my $bind = shift;
1278
1279     my $b = 0;
1280
1281     # is this regex sufficient?
1282     $sql =~ s{\?}{$self->Quote($bind->[$b++])}eg;
1283
1284     return $sql;
1285 }
1286
1287 sub Indexes {
1288     my $self = shift;
1289
1290     my %res;
1291
1292     my $db_type = RT->Config->Get('DatabaseType');
1293     my $dbh = $self->dbh;
1294
1295     my $list;
1296     if ( $db_type eq 'mysql' ) {
1297         $list = $dbh->selectall_arrayref(
1298             'select distinct table_name, index_name from information_schema.statistics where table_schema = ?',
1299             undef, scalar RT->Config->Get('DatabaseName')
1300         );
1301     }
1302     elsif ( $db_type eq 'Pg' ) {
1303         $list = $dbh->selectall_arrayref(
1304             'select tablename, indexname from pg_indexes where schemaname = ?',
1305             undef, 'public'
1306         );
1307     }
1308     elsif ( $db_type eq 'SQLite' ) {
1309         $list = $dbh->selectall_arrayref(
1310             'select tbl_name, name from sqlite_master where type = ?',
1311             undef, 'index'
1312         );
1313     }
1314     elsif ( $db_type eq 'Oracle' ) {
1315         $list = $dbh->selectall_arrayref(
1316             'select table_name, index_name from dba_indexes where index_name NOT LIKE ? AND lower(Owner) = ?',
1317             undef, 'SYS_%$$', lc RT->Config->Get('DatabaseUser'),
1318         );
1319     }
1320     else {
1321         die "Not implemented";
1322     }
1323     push @{ $res{ lc $_->[0] } ||= [] }, lc $_->[1] foreach @$list;
1324     return %res;
1325 }
1326
1327 sub IndexesThatBeginWith {
1328     my $self = shift;
1329     my %args = (Table => undef, Columns => [], @_);
1330
1331     my %indexes = $self->Indexes;
1332
1333     my @check = @{ $args{'Columns'} };
1334
1335     my @list;
1336     foreach my $index ( @{ $indexes{ lc $args{'Table'} } || [] } ) {
1337         my %info = $self->IndexInfo( Table => $args{'Table'}, Name => $index );
1338         next if @{ $info{'Columns'} } < @check;
1339         my $check = join ',', @check;
1340         next if join( ',', @{ $info{'Columns'} } ) !~ /^\Q$check\E(?:,|$)/i;
1341
1342         push @list, \%info;
1343     }
1344     return sort { @{ $a->{'Columns'} } <=> @{ $b->{'Columns'} } } @list;
1345 }
1346
1347 sub IndexInfo {
1348     my $self = shift;
1349     my %args = (Table => undef, Name => undef, @_);
1350
1351     my $db_type = RT->Config->Get('DatabaseType');
1352     my $dbh = $self->dbh;
1353
1354     my %res = (
1355         Table => lc $args{'Table'},
1356         Name => lc $args{'Name'},
1357     );
1358     if ( $db_type eq 'mysql' ) {
1359         my $list = $dbh->selectall_arrayref(
1360             'select NON_UNIQUE, COLUMN_NAME, SUB_PART
1361             from information_schema.statistics
1362             where table_schema = ? AND LOWER(table_name) = ? AND index_name = ?
1363             ORDER BY SEQ_IN_INDEX',
1364             undef, scalar RT->Config->Get('DatabaseName'), lc $args{'Table'}, $args{'Name'},
1365         );
1366         return () unless $list && @$list;
1367         $res{'Unique'} = $list->[0][0]? 0 : 1;
1368         $res{'Functional'} = 0;
1369         $res{'Columns'} = [ map $_->[1], @$list ];
1370     }
1371     elsif ( $db_type eq 'Pg' ) {
1372         my $index = $dbh->selectrow_hashref(
1373             'select ix.*, pg_get_expr(ix.indexprs, ix.indrelid) as functions
1374             from
1375                 pg_class t, pg_class i, pg_index ix
1376             where
1377                 t.relname ilike ?
1378                 and t.relkind = ?
1379                 and i.relname ilike ?
1380                 and ix.indrelid = t.oid
1381                 and ix.indexrelid = i.oid
1382             ',
1383             undef, $args{'Table'}, 'r', $args{'Name'},
1384         );
1385         return () unless $index && keys %$index;
1386         $res{'Unique'} = $index->{'indisunique'};
1387         $res{'Functional'} = (grep $_ == 0, split ' ', $index->{'indkey'})? 1 : 0;
1388         $res{'Columns'} = [ map int($_), split ' ', $index->{'indkey'} ];
1389         my $columns = $dbh->selectall_hashref(
1390             'select a.attnum, a.attname
1391             from pg_attribute a where a.attrelid = ?',
1392             'attnum', undef, $index->{'indrelid'}
1393         );
1394         if ($index->{'functions'}) {
1395             # XXX: this is good enough for us
1396             $index->{'functions'} = [ split /,\s+/, $index->{'functions'} ];
1397         }
1398         foreach my $e ( @{ $res{'Columns'} } ) {
1399             if (exists $columns->{$e} ) {
1400                 $e = $columns->{$e}{'attname'};
1401             }
1402             elsif ( !$e ) {
1403                 $e = shift @{ $index->{'functions'} };
1404             }
1405         }
1406
1407         foreach my $column ( @{$res{'Columns'}} ) {
1408             next unless $column =~ s/^lower\( \s* \(? (\w+) \)? (?:::text)? \s* \)$/$1/ix;
1409             $res{'CaseInsensitive'}{ lc $1 } = 1;
1410         }
1411     }
1412     elsif ( $db_type eq 'SQLite' ) {
1413         my $list = $dbh->selectall_arrayref("pragma index_info('$args{'Name'}')");
1414         return () unless $list && @$list;
1415
1416         $res{'Functional'} = 0;
1417         $res{'Columns'} = [ map $_->[2], @$list ];
1418
1419         $list = $dbh->selectall_arrayref("pragma index_list('$args{'Table'}')");
1420         $res{'Unique'} = (grep lc $_->[1] eq lc $args{'Name'}, @$list)[0][2]? 1 : 0;
1421     }
1422     elsif ( $db_type eq 'Oracle' ) {
1423         my $index = $dbh->selectrow_hashref(
1424             'select uniqueness, funcidx_status from dba_indexes
1425             where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(Owner) = ?',
1426             undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
1427         );
1428         return () unless $index && keys %$index;
1429         $res{'Unique'} = $index->{'uniqueness'} eq 'UNIQUE'? 1 : 0;
1430         $res{'Functional'} = $index->{'funcidx_status'}? 1 : 0;
1431
1432         my %columns = map @$_, @{ $dbh->selectall_arrayref(
1433             'select column_position, column_name from dba_ind_columns
1434             where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?',
1435             undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
1436         ) };
1437         $columns{ $_->[0] } = $_->[1] foreach @{ $dbh->selectall_arrayref(
1438             'select column_position, column_expression from dba_ind_expressions
1439             where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?',
1440             undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
1441         ) };
1442         $res{'Columns'} = [ map $columns{$_}, sort { $a <=> $b } keys %columns ];
1443
1444         foreach my $column ( @{$res{'Columns'}} ) {
1445             next unless $column =~ s/^lower\( \s* " (\w+) " \s* \)$/$1/ix;
1446             $res{'CaseInsensitive'}{ lc $1 } = 1;
1447         }
1448     }
1449     else {
1450         die "Not implemented";
1451     }
1452     $_ = lc $_ foreach @{ $res{'Columns'} };
1453     return %res;
1454 }
1455
1456 sub DropIndex {
1457     my $self = shift;
1458     my %args = (Table => undef, Name => undef, @_);
1459
1460     my $db_type = RT->Config->Get('DatabaseType');
1461     my $dbh = $self->dbh;
1462     local $dbh->{'PrintError'} = 0;
1463     local $dbh->{'RaiseError'} = 0;
1464
1465     my $res;
1466     if ( $db_type eq 'mysql' ) {
1467         $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} );
1468         $res = $dbh->do(
1469             'drop index '. $dbh->quote_identifier($args{'Name'}) ." on $args{'Table'}",
1470         );
1471     }
1472     elsif ( $db_type eq 'Pg' ) {
1473         $res = $dbh->do("drop index $args{'Name'} CASCADE");
1474     }
1475     elsif ( $db_type eq 'SQLite' ) {
1476         $res = $dbh->do("drop index $args{'Name'}");
1477     }
1478     elsif ( $db_type eq 'Oracle' ) {
1479         my $user = RT->Config->Get('DatabaseUser');
1480         $res = $dbh->do("drop index $user.$args{'Name'}");
1481     }
1482     else {
1483         die "Not implemented";
1484     }
1485     my $desc = $self->IndexDescription( %args );
1486     return ($res, $res? "Dropped $desc" : "Couldn't drop $desc: ". $dbh->errstr);
1487 }
1488
1489 sub _CanonicTableNameMysql {
1490     my $self = shift;
1491     my $table = shift;
1492     return $table unless $table;
1493     # table name can be case sensitivity in DDL
1494     # use LOWER to workaround mysql "bug"
1495     return ($self->dbh->selectrow_array(
1496         'SELECT table_name
1497         FROM information_schema.tables
1498         WHERE table_schema = ? AND LOWER(table_name) = ?',
1499         undef, scalar RT->Config->Get('DatabaseName'), lc $table
1500     ))[0] || $table;
1501 }
1502
1503 sub DropIndexIfExists {
1504     my $self = shift;
1505     my %args = (Table => undef, Name => undef, @_);
1506
1507     my %indexes = $self->Indexes;
1508     return (1, ucfirst($self->IndexDescription( %args )) ." doesn't exists")
1509         unless grep $_ eq lc $args{'Name'},
1510         @{ $indexes{ lc $args{'Table'} } || []};
1511     return $self->DropIndex(%args);
1512 }
1513
1514 sub CreateIndex {
1515     my $self = shift;
1516     my %args = ( Table => undef, Name => undef, Columns => [], CaseInsensitive => {}, @_ );
1517
1518     $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} )
1519         if RT->Config->Get('DatabaseType') eq 'mysql';
1520
1521     my $name = $args{'Name'};
1522     unless ( $name ) {
1523         my %indexes = $self->Indexes;
1524         %indexes = map { $_ => 1 } @{ $indexes{ lc $args{'Table'} } || [] };
1525         my $i = 1;
1526         $i++ while $indexes{ lc($args{'Table'}).$i };
1527         $name = lc($args{'Table'}).$i;
1528     }
1529
1530     my @columns = @{ $args{'Columns'} };
1531     if ( $self->CaseSensitive ) {
1532         foreach my $column ( @columns ) {
1533             next unless $args{'CaseInsensitive'}{ lc $column };
1534             $column = "LOWER($column)";
1535         }
1536     }
1537
1538     my $sql = "CREATE"
1539         . ($args{'Unique'}? ' UNIQUE' : '')
1540         ." INDEX $name ON $args{'Table'}"
1541         ."(". join( ', ', @columns ) .")"
1542     ;
1543
1544     my $res = $self->dbh->do( $sql );
1545     unless ( $res ) {
1546         return (
1547             undef, "Failed to create ". $self->IndexDescription( %args )
1548                 ." (sql: $sql): ". $self->dbh->errstr
1549         );
1550     }
1551     return ($name, "Created ". $self->IndexDescription( %args ) );
1552 }
1553
1554 sub IndexDescription {
1555     my $self = shift;
1556     my %args = (@_);
1557
1558     my $desc =
1559         ($args{'Unique'}? 'unique ' : '')
1560         .'index'
1561         . ($args{'Name'}? " $args{'Name'}" : '')
1562         . ( @{$args{'Columns'}||[]}?
1563             " ("
1564             . join(', ', @{$args{'Columns'}})
1565             . (@{$args{'Optional'}||[]}? '['. join(', ', '', @{$args{'Optional'}}).']' : '' )
1566             .")"
1567             : ''
1568         )
1569         . ($args{'Table'}? " on $args{'Table'}" : '')
1570     ;
1571     return $desc;
1572 }
1573
1574 sub MakeSureIndexExists {
1575     my $self = shift;
1576     my %args = ( Table => undef, Columns => [], Optional => [], @_ );
1577
1578     my @list = $self->IndexesThatBeginWith(
1579         Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1580     );
1581     if (@list) {
1582         RT->Logger->debug( ucfirst $self->IndexDescription(
1583             Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1584         ). ' exists.' );
1585         return;
1586     }
1587
1588     @list = $self->IndexesThatBeginWith(
1589         Table => $args{'Table'}, Columns => $args{'Columns'},
1590     );
1591     if ( !@list ) {
1592         my ($status, $msg) = $self->CreateIndex(
1593             Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1594         );
1595         my $method = $status ? 'debug' : 'warning';
1596         RT->Logger->$method($msg);
1597     }
1598     else {
1599         RT->Logger->info(
1600             ucfirst $self->IndexDescription(
1601                 %{$list[0]}
1602             )
1603             .' exists, you may consider replacing it with '
1604             . $self->IndexDescription(
1605                 Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1606             )
1607         );
1608     }
1609 }
1610
1611 sub DropIndexesThatArePrefix {
1612     my $self = shift;
1613     my %args = ( Table => undef, Columns => [], @_ );
1614
1615     my @list = $self->IndexesThatBeginWith(
1616         Table => $args{'Table'}, Columns => [$args{'Columns'}[0]],
1617     );
1618
1619     my $checking = join ',', map lc $_, @{ $args{'Columns'} }, '';
1620     foreach my $i ( splice @list ) {
1621         my $columns = join ',', @{ $i->{'Columns'} }, '';
1622         next unless $checking =~ /^\Q$columns/i;
1623
1624         push @list, $i;
1625     }
1626     pop @list;
1627
1628     foreach my $i ( @list ) {
1629         my ($status, $msg) = $self->DropIndex(
1630             Table => $i->{'Table'}, Name => $i->{'Name'},
1631         );
1632         my $method = $status ? 'debug' : 'warning';
1633         RT->Logger->$method($msg);
1634     }
1635 }
1636
1637 # log a mason stack trace instead of a Carp::longmess because it's less painful
1638 # and uses mason component paths properly
1639 sub _LogSQLStatement {
1640     my $self = shift;
1641     my $statement = shift;
1642     my $duration = shift;
1643     my @bind = @_;
1644
1645     require HTML::Mason::Exceptions;
1646     push @{$self->{'StatementLog'}} , ([Time::HiRes::time(), $statement, [@bind], $duration, HTML::Mason::Exception->new->as_string]);
1647 }
1648
1649 # helper in a few cases where we do SQL by hand
1650 sub __MakeClauseCaseInsensitive {
1651     my $self = shift;
1652     return join ' ', @_ unless $self->CaseSensitive;
1653     my ($field, $op, $value) = $self->_MakeClauseCaseInsensitive(@_);
1654     return "$field $op $value";
1655 }
1656
1657 sub _TableNames {
1658     my $self = shift;
1659     my $dbh = shift || $self->dbh;
1660
1661     {
1662         local $@;
1663         if (
1664             $dbh->{Driver}->{Name} eq 'Pg'
1665             && $dbh->{'pg_server_version'} >= 90200
1666             && !eval { DBD::Pg->VERSION('2.19.3'); 1 }
1667         ) {
1668             die "You're using PostgreSQL 9.2 or newer. You have to upgrade DBD::Pg module to 2.19.3 or newer: $@";
1669         }
1670     }
1671
1672     my @res;
1673
1674     my $sth = $dbh->table_info( '', undef, undef, "'TABLE'");
1675     while ( my $table = $sth->fetchrow_hashref ) {
1676         push @res, $table->{TABLE_NAME} || $table->{table_name};
1677     }
1678
1679     return @res;
1680 }
1681
1682 __PACKAGE__->FinalizeDatabaseType;
1683
1684 RT::Base->_ImportOverlays();
1685
1686 1;