rt/lib/RT/Handle.pm

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