rt/lib/RT/Handle.pm

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