lib/RT/Handle.pm

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