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