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