a8652e49d9fa56fc74ed2eb5425e9c111c01be2b
[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     unless (eval "require $package; 1;") {
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
95     @RT::Handle::ISA = ($package);
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     elsif ( $db_type eq 'mysql' ) {
369         $status = $dbh->do("CREATE DATABASE $db_name DEFAULT CHARACTER SET utf8");
370     }
371     else {
372         $status = $dbh->do("CREATE DATABASE $db_name");
373     }
374     return ($status, $DBI::errstr);
375 }
376
377 =head3 DropDatabase $DBH
378
379 Drops RT's database. This method can be used as class method.
380
381 Takes DBI handle as first argument. Many database systems require
382 a special handle to allow you to drop a database, so you may have
383 to use L<SystemDSN> when acquiring the DBI handle.
384
385 Fetches the type and name of the database from the config.
386
387 =cut
388
389 sub DropDatabase {
390     my $self = shift;
391     my $dbh  = shift or return (0, "No DBI handle provided");
392
393     my $db_type = RT->Config->Get('DatabaseType');
394     my $db_name = RT->Config->Get('DatabaseName');
395
396     if ( $db_type eq 'Oracle' ) {
397         my $db_user = RT->Config->Get('DatabaseUser');
398         my $status = $dbh->do( "DROP USER $db_user CASCADE" );
399         unless ( $status ) {
400             return 0, "Couldn't drop user $db_user."
401                 ."\nError: ". $dbh->errstr;
402         }
403         return (1, "Successfully dropped user '$db_user' with his schema.");
404     }
405     elsif ( $db_type eq 'SQLite' ) {
406         my $path = $db_name;
407         $path = "$RT::VarPath/$path" unless substr($path, 0, 1) eq '/';
408         unlink $path or return (0, "Couldn't remove '$path': $!");
409         return (1);
410     } else {
411         $dbh->do("DROP DATABASE ". $db_name)
412             or return (0, $DBI::errstr);
413     }
414     return (1);
415 }
416
417 =head2 InsertACL
418
419 =cut
420
421 sub InsertACL {
422     my $self      = shift;
423     my $dbh       = shift;
424     my $base_path = shift || $RT::EtcPath;
425
426     my $db_type = RT->Config->Get('DatabaseType');
427     return (1) if $db_type eq 'SQLite';
428
429     $dbh = $self->dbh if !$dbh && ref $self;
430     return (0, "No DBI handle provided") unless $dbh;
431
432     return (0, "'$base_path' doesn't exist") unless -e $base_path;
433
434     my $path;
435     if ( -d $base_path ) {
436         $path = File::Spec->catfile( $base_path, "acl.$db_type");
437         $path = $self->GetVersionFile($dbh, $path);
438
439         $path = File::Spec->catfile( $base_path, "acl")
440             unless $path && -e $path;
441         return (0, "Couldn't find ACLs for $db_type")
442             unless -e $path;
443     } else {
444         $path = $base_path;
445     }
446
447     local *acl;
448     do $path || return (0, "Couldn't load ACLs: " . $@);
449     my @acl = acl($dbh);
450     foreach my $statement (@acl) {
451         my $sth = $dbh->prepare($statement)
452             or return (0, "Couldn't prepare SQL query:\n $statement\n\nERROR: ". $dbh->errstr);
453         unless ( $sth->execute ) {
454             return (0, "Couldn't run SQL query:\n $statement\n\nERROR: ". $sth->errstr);
455         }
456     }
457     return (1);
458 }
459
460 =head2 InsertSchema
461
462 =cut
463
464 sub InsertSchema {
465     my $self = shift;
466     my $dbh  = shift;
467     my $base_path = (shift || $RT::EtcPath);
468
469     $dbh = $self->dbh if !$dbh && ref $self;
470     return (0, "No DBI handle provided") unless $dbh;
471
472     my $db_type = RT->Config->Get('DatabaseType');
473
474     my $file;
475     if ( -d $base_path ) {
476         $file = $base_path . "/schema." . $db_type;
477     } else {
478         $file = $base_path;
479     }
480
481     $file = $self->GetVersionFile( $dbh, $file );
482     unless ( $file ) {
483         return (0, "Couldn't find schema file(s) '$file*'");
484     }
485     unless ( -f $file && -r $file ) {
486         return (0, "File '$file' doesn't exist or couldn't be read");
487     }
488
489     my (@schema);
490
491     open( my $fh_schema, '<', $file ) or die $!;
492
493     my $has_local = 0;
494     open( my $fh_schema_local, "<" . $self->GetVersionFile( $dbh, $RT::LocalEtcPath . "/schema." . $db_type ))
495         and $has_local = 1;
496
497     my $statement = "";
498     foreach my $line ( <$fh_schema>, ($_ = ';;'), $has_local? <$fh_schema_local>: () ) {
499         $line =~ s/\#.*//g;
500         $line =~ s/--.*//g;
501         $statement .= $line;
502         if ( $line =~ /;(\s*)$/ ) {
503             $statement =~ s/;(\s*)$//g;
504             push @schema, $statement;
505             $statement = "";
506         }
507     }
508     close $fh_schema; close $fh_schema_local;
509
510     if ( $db_type eq 'Oracle' ) {
511         my $db_user = RT->Config->Get('DatabaseUser');
512         my $status = $dbh->do( "ALTER SESSION SET CURRENT_SCHEMA=$db_user" );
513         unless ( $status ) {
514             return $status, "Couldn't set current schema to $db_user."
515                 ."\nError: ". $dbh->errstr;
516         }
517     }
518
519     local $SIG{__WARN__} = sub {};
520     my $is_local = 0;
521     $dbh->begin_work or return (0, "Couldn't begin transaction: ". $dbh->errstr);
522     foreach my $statement (@schema) {
523         if ( $statement =~ /^\s*;$/ ) {
524             $is_local = 1; next;
525         }
526
527         my $sth = $dbh->prepare($statement)
528             or return (0, "Couldn't prepare SQL query:\n$statement\n\nERROR: ". $dbh->errstr);
529         unless ( $sth->execute or $is_local ) {
530             return (0, "Couldn't run SQL query:\n$statement\n\nERROR: ". $sth->errstr);
531         }
532     }
533     $dbh->commit or return (0, "Couldn't commit transaction: ". $dbh->errstr);
534     return (1);
535 }
536
537 sub InsertIndexes {
538     my $self      = shift;
539     my $dbh       = shift;
540     my $base_path = shift || $RT::EtcPath;
541
542     my $db_type = RT->Config->Get('DatabaseType');
543
544     $dbh = $self->dbh if !$dbh && ref $self;
545     return (0, "No DBI handle provided") unless $dbh;
546
547     return (0, "'$base_path' doesn't exist") unless -e $base_path;
548
549     my $path;
550     if ( -d $base_path ) {
551         $path = File::Spec->catfile( $base_path, "indexes");
552         return (0, "Couldn't find indexes file")
553             unless -e $path;
554     } else {
555         $path = $base_path;
556     }
557
558     if ( $db_type eq 'Oracle' ) {
559         my $db_user = RT->Config->Get('DatabaseUser');
560         my $status = $dbh->do( "ALTER SESSION SET CURRENT_SCHEMA=$db_user" );
561         unless ( $status ) {
562             return $status, "Couldn't set current schema to $db_user."
563                 ."\nError: ". $dbh->errstr;
564         }
565     }
566
567     local $@;
568     eval { require $path; 1 }
569         or return (0, "Couldn't execute '$path': " . $@);
570     return (1);
571 }
572
573 =head1 GetVersionFile
574
575 Takes base name of the file as argument, scans for <base name>-<version> named
576 files and returns file name with closest version to the version of the RT DB.
577
578 =cut
579
580 sub GetVersionFile {
581     my $self = shift;
582     my $dbh = shift;
583     my $base_name = shift;
584
585     my $db_version = ref $self
586         ? $self->DatabaseVersion
587         : do {
588             my $tmp = RT::Handle->new;
589             $tmp->dbh($dbh);
590             $tmp->DatabaseVersion;
591         };
592
593     require File::Glob;
594     my @files = File::Glob::bsd_glob("$base_name*");
595     return '' unless @files;
596
597     my %version = map { $_ =~ /\.\w+-([-\w\.]+)$/; ($1||0) => $_ } @files;
598     my $version;
599     foreach ( reverse sort cmp_version keys %version ) {
600         if ( cmp_version( $db_version, $_ ) >= 0 ) {
601             $version = $_;
602             last;
603         }
604     }
605
606     return defined $version? $version{ $version } : undef;
607 }
608
609 { my %word = (
610     a     => -4,
611     alpha => -4,
612     b     => -3,
613     beta  => -3,
614     pre   => -2,
615     rc    => -1,
616     head  => 9999,
617 );
618 sub cmp_version($$) {
619     my ($a, $b) = (@_);
620     my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
621         split /([^0-9]+)/, $a;
622     my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
623         split /([^0-9]+)/, $b;
624     @a > @b
625         ? push @b, (0) x (@a-@b)
626         : push @a, (0) x (@b-@a);
627     for ( my $i = 0; $i < @a; $i++ ) {
628         return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
629     }
630     return 0;
631 }
632
633 sub version_words {
634     return keys %word;
635 }
636
637 }
638
639
640 =head2 InsertInitialData
641
642 Inserts system objects into RT's DB, like system user or 'nobody',
643 internal groups and other records required. However, this method
644 doesn't insert any real users like 'root' and you have to use
645 InsertData or another way to do that.
646
647 Takes no arguments. Returns status and message tuple.
648
649 It's safe to call this method even if those objects already exist.
650
651 =cut
652
653 sub InsertInitialData {
654     my $self    = shift;
655
656     my @warns;
657
658     # create RT_System user and grant him rights
659     {
660         require RT::CurrentUser;
661
662         my $test_user = RT::User->new( RT::CurrentUser->new() );
663         $test_user->Load('RT_System');
664         if ( $test_user->id ) {
665             push @warns, "Found system user in the DB.";
666         }
667         else {
668             my $user = RT::User->new( RT::CurrentUser->new() );
669             my ( $val, $msg ) = $user->_BootstrapCreate(
670                 Name     => 'RT_System',
671                 RealName => 'The RT System itself',
672                 Comments => 'Do not delete or modify this user. '
673                     . 'It is integral to RT\'s internal database structures',
674                 Creator  => '1',
675                 LastUpdatedBy => '1',
676             );
677             return ($val, $msg) unless $val;
678         }
679         DBIx::SearchBuilder::Record::Cachable->FlushCache;
680     }
681
682     # init RT::SystemUser and RT::System objects
683     RT::InitSystemObjects();
684     unless ( RT->SystemUser->id ) {
685         return (0, "Couldn't load system user");
686     }
687
688     # grant SuperUser right to system user
689     {
690         my $test_ace = RT::ACE->new( RT->SystemUser );
691         $test_ace->LoadByCols(
692             PrincipalId   => ACLEquivGroupId( RT->SystemUser->Id ),
693             PrincipalType => 'Group',
694             RightName     => 'SuperUser',
695             ObjectType    => 'RT::System',
696             ObjectId      => 1,
697         );
698         if ( $test_ace->id ) {
699             push @warns, "System user has global SuperUser right.";
700         } else {
701             my $ace = RT::ACE->new( RT->SystemUser );
702             my ( $val, $msg ) = $ace->_BootstrapCreate(
703                 PrincipalId   => ACLEquivGroupId( RT->SystemUser->Id ),
704                 PrincipalType => 'Group',
705                 RightName     => 'SuperUser',
706                 ObjectType    => 'RT::System',
707                 ObjectId      => 1,
708             );
709             return ($val, $msg) unless $val;
710         }
711         DBIx::SearchBuilder::Record::Cachable->FlushCache;
712     }
713
714     # system groups
715     # $self->loc('Everyone'); # For the string extractor to get a string to localize
716     # $self->loc('Privileged'); # For the string extractor to get a string to localize
717     # $self->loc('Unprivileged'); # For the string extractor to get a string to localize
718     foreach my $name (qw(Everyone Privileged Unprivileged)) {
719         my $group = RT::Group->new( RT->SystemUser );
720         $group->LoadSystemInternalGroup( $name );
721         if ( $group->id ) {
722             push @warns, "System group '$name' already exists.";
723             next;
724         }
725
726         $group = RT::Group->new( RT->SystemUser );
727         my ( $val, $msg ) = $group->_Create(
728             Domain      => 'SystemInternal',
729             Description => 'Pseudogroup for internal use',  # loc
730             Name        => $name,
731             Instance    => '',
732         );
733         return ($val, $msg) unless $val;
734     }
735
736     # nobody
737     {
738         my $user = RT::User->new( RT->SystemUser );
739         $user->Load('Nobody');
740         if ( $user->id ) {
741             push @warns, "Found 'Nobody' user in the DB.";
742         }
743         else {
744             my ( $val, $msg ) = $user->Create(
745                 Name     => 'Nobody',
746                 RealName => 'Nobody in particular',
747                 Comments => 'Do not delete or modify this user. It is integral '
748                     .'to RT\'s internal data structures',
749                 Privileged => 0,
750             );
751             return ($val, $msg) unless $val;
752         }
753
754         if ( $user->HasRight( Right => 'OwnTicket', Object => $RT::System ) ) {
755             push @warns, "User 'Nobody' has global OwnTicket right.";
756         } else {
757             my ( $val, $msg ) = $user->PrincipalObj->GrantRight(
758                 Right => 'OwnTicket',
759                 Object => $RT::System,
760             );
761             return ($val, $msg) unless $val;
762         }
763     }
764
765     # rerun to get init Nobody as well
766     RT::InitSystemObjects();
767
768     # system role groups
769     foreach my $name (qw(Owner Requestor Cc AdminCc)) {
770         my $group = RT->System->RoleGroup( $name );
771         if ( $group->id ) {
772             push @warns, "System role '$name' already exists.";
773             next;
774         }
775
776         $group = RT::Group->new( RT->SystemUser );
777         my ( $val, $msg ) = $group->CreateRoleGroup(
778             Name                => $name,
779             Object              => RT->System,
780             Description         => 'SystemRolegroup for internal use',  # loc
781             InsideTransaction   => 0,
782         );
783         return ($val, $msg) unless $val;
784     }
785
786     push @warns, "You appear to have a functional RT database."
787         if @warns;
788
789     return (1, join "\n", @warns);
790 }
791
792 =head2 InsertData
793
794 Load some sort of data into the database, takes path to a file.
795
796 =cut
797
798 sub InsertData {
799     my $self     = shift;
800     my $datafile = shift;
801     my $root_password = shift;
802     my %args     = (
803         disconnect_after => 1,
804         @_
805     );
806
807     # Slurp in stuff to insert from the datafile. Possible things to go in here:-
808     our (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions,
809            @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final);
810     local (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions,
811            @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final);
812
813     local $@;
814     $RT::Logger->debug("Going to load '$datafile' data file");
815     eval { require $datafile }
816       or return (0, "Couldn't load data from '$datafile' for import:\n\nERROR:". $@);
817
818     if ( @Initial ) {
819         $RT::Logger->debug("Running initial actions...");
820         foreach ( @Initial ) {
821             local $@;
822             eval { $_->(); 1 } or return (0, "One of initial functions failed: $@");
823         }
824         $RT::Logger->debug("Done.");
825     }
826     if ( @Groups ) {
827         $RT::Logger->debug("Creating groups...");
828         foreach my $item (@Groups) {
829             my $new_entry = RT::Group->new( RT->SystemUser );
830             $item->{'Domain'} ||= 'UserDefined';
831             my $member_of = delete $item->{'MemberOf'};
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         }
871         $RT::Logger->debug("done.");
872     }
873     if ( @Users ) {
874         $RT::Logger->debug("Creating users...");
875         foreach my $item (@Users) {
876             my $member_of = delete $item->{'MemberOf'};
877             if ( $item->{'Name'} eq 'root' && $root_password ) {
878                 $item->{'Password'} = $root_password;
879             }
880             my $new_entry = RT::User->new( RT->SystemUser );
881             my ( $return, $msg ) = $new_entry->Create(%$item);
882             unless ( $return ) {
883                 $RT::Logger->error( $msg );
884             } else {
885                 $RT::Logger->debug( $return ."." );
886             }
887             if ( $member_of ) {
888                 $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY';
889                 foreach( @$member_of ) {
890                     my $parent = RT::Group->new($RT::SystemUser);
891                     if ( ref $_ eq 'HASH' ) {
892                         $parent->LoadByCols( %$_ );
893                     }
894                     elsif ( !ref $_ ) {
895                         $parent->LoadUserDefinedGroup( $_ );
896                     }
897                     else {
898                         $RT::Logger->error(
899                             "(Error: wrong format of MemberOf field."
900                             ." Should be name of user defined group or"
901                             ." hash reference with 'column => value' pairs."
902                             ." Use array reference to add to multiple groups)"
903                         );
904                         next;
905                     }
906                     unless ( $parent->Id ) {
907                         $RT::Logger->error("(Error: couldn't load group to add member)");
908                         next;
909                     }
910                     my ( $return, $msg ) = $parent->AddMember( $new_entry->Id );
911                     unless ( $return ) {
912                         $RT::Logger->error( $msg );
913                     } else {
914                         $RT::Logger->debug( $return ."." );
915                     }
916                 }
917             }
918         }
919         $RT::Logger->debug("done.");
920     }
921     if ( @Queues ) {
922         $RT::Logger->debug("Creating queues...");
923         for my $item (@Queues) {
924             my $new_entry = RT::Queue->new(RT->SystemUser);
925             my ( $return, $msg ) = $new_entry->Create(%$item);
926             unless ( $return ) {
927                 $RT::Logger->error( $msg );
928             } else {
929                 $RT::Logger->debug( $return ."." );
930             }
931         }
932         $RT::Logger->debug("done.");
933     }
934     if ( @CustomFields ) {
935         $RT::Logger->debug("Creating custom fields...");
936         for my $item ( @CustomFields ) {
937             my $new_entry = RT::CustomField->new( RT->SystemUser );
938             my $values    = delete $item->{'Values'};
939
940             # Back-compat for the old "Queue" argument
941             if ( exists $item->{'Queue'} ) {
942                 $item->{'LookupType'} ||= 'RT::Queue-RT::Ticket';
943                 $RT::Logger->warn("Queue provided for non-ticket custom field")
944                     unless $item->{'LookupType'} =~ /^RT::Queue-/;
945                 $item->{'ApplyTo'} = delete $item->{'Queue'};
946             }
947
948             my $apply_to = delete $item->{'ApplyTo'};
949
950             if ( $item->{'BasedOn'} ) {
951                 if ( $item->{'BasedOn'} =~ /^\d+$/) {
952                     # Already have an ID -- should be fine
953                 } elsif ( $item->{'LookupType'} ) {
954                     my $basedon = RT::CustomField->new($RT::SystemUser);
955                     my ($ok, $msg ) = $basedon->LoadByCols(
956                         Name => $item->{'BasedOn'},
957                         LookupType => $item->{'LookupType'},
958                         Disabled => 0 );
959                     if ($ok) {
960                         $item->{'BasedOn'} = $basedon->Id;
961                     } else {
962                         $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF.  Skipping BasedOn: $msg");
963                         delete $item->{'BasedOn'};
964                     }
965                 } else {
966                     $RT::Logger->error("Unable to load CF $item->{BasedOn} because no LookupType was specified.  Skipping BasedOn");
967                     delete $item->{'BasedOn'};
968                 }
969
970             } 
971
972             my ( $return, $msg ) = $new_entry->Create(%$item);
973             unless( $return ) {
974                 $RT::Logger->error( $msg );
975                 next;
976             }
977
978             foreach my $value ( @{$values} ) {
979                 ( $return, $msg ) = $new_entry->AddValue(%$value);
980                 $RT::Logger->error( $msg ) unless $return;
981             }
982
983             my $class = $new_entry->RecordClassFromLookupType;
984             if ($class) {
985                 if ($new_entry->IsOnlyGlobal and $apply_to) {
986                     $RT::Logger->warn("ApplyTo provided for global custom field ".$new_entry->Name );
987                     undef $apply_to;
988                 }
989                 if ( !$apply_to ) {
990                     # Apply to all by default
991                     my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
992                     ( $return, $msg) = $ocf->Create( CustomField => $new_entry->Id );
993                     $RT::Logger->error( $msg ) unless $return and $ocf->Id;
994                 } else {
995                     $apply_to = [ $apply_to ] unless ref $apply_to;
996                     for my $name ( @{ $apply_to } ) {
997                         my $obj = $class->new(RT->SystemUser);
998                         $obj->Load($name);
999                         if ( $obj->Id ) {
1000                             my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
1001                             ( $return, $msg ) = $ocf->Create(
1002                                 CustomField => $new_entry->Id,
1003                                 ObjectId    => $obj->Id,
1004                             );
1005                             $RT::Logger->error( $msg ) unless $return and $ocf->Id;
1006                         } else {
1007                             $RT::Logger->error("Could not find $class $name to apply ".$new_entry->Name." to" );
1008                         }
1009                     }
1010                 }
1011             }
1012         }
1013
1014         $RT::Logger->debug("done.");
1015     }
1016     if ( @ACL ) {
1017         $RT::Logger->debug("Creating ACL...");
1018         for my $item (@ACL) {
1019
1020             my ($princ, $object);
1021
1022             # Global rights or Queue rights?
1023             if ( $item->{'CF'} ) {
1024                 $object = RT::CustomField->new( RT->SystemUser );
1025                 my @columns = ( Name => $item->{'CF'} );
1026                 push @columns, LookupType => $item->{'LookupType'} if $item->{'LookupType'};
1027                 push @columns, Queue => $item->{'Queue'} if $item->{'Queue'} and not ref $item->{'Queue'};
1028                 my ($ok, $msg) = $object->LoadByName( @columns );
1029                 unless ( $ok ) {
1030                     RT->Logger->error("Unable to load CF ".$item->{CF}.": $msg");
1031                     next;
1032                 }
1033             } elsif ( $item->{'Queue'} ) {
1034                 $object = RT::Queue->new(RT->SystemUser);
1035                 my ($ok, $msg) = $object->Load( $item->{'Queue'} );
1036                 unless ( $ok ) {
1037                     RT->Logger->error("Unable to load queue ".$item->{Queue}.": $msg");
1038                     next;
1039                 }
1040             } elsif ( $item->{ObjectType} and $item->{ObjectId}) {
1041                 $object = $item->{ObjectType}->new(RT->SystemUser);
1042                 my ($ok, $msg) = $object->Load( $item->{ObjectId} );
1043                 unless ( $ok ) {
1044                     RT->Logger->error("Unable to load ".$item->{ObjectType}." ".$item->{ObjectId}.": $msg");
1045                     next;
1046                 }
1047             } else {
1048                 $object = $RT::System;
1049             }
1050
1051             # Group rights or user rights?
1052             if ( $item->{'GroupDomain'} ) {
1053                 $princ = RT::Group->new(RT->SystemUser);
1054                 if ( $item->{'GroupDomain'} eq 'UserDefined' ) {
1055                   $princ->LoadUserDefinedGroup( $item->{'GroupId'} );
1056                 } elsif ( $item->{'GroupDomain'} eq 'SystemInternal' ) {
1057                   $princ->LoadSystemInternalGroup( $item->{'GroupType'} );
1058                 } elsif ( $item->{'GroupDomain'} eq 'RT::System-Role' ) {
1059                   $princ->LoadRoleGroup( Object => RT->System, Name => $item->{'GroupType'} );
1060                 } elsif ( $item->{'GroupDomain'} eq 'RT::Queue-Role' &&
1061                           $item->{'Queue'} )
1062                 {
1063                   $princ->LoadRoleGroup( Object => $object, Name => $item->{'GroupType'} );
1064                 } else {
1065                   $princ->Load( $item->{'GroupId'} );
1066                 }
1067                 unless ( $princ->Id ) {
1068                     RT->Logger->error("Unable to load Group: GroupDomain => $item->{GroupDomain}, GroupId => $item->{GroupId}, Queue => $item->{Queue}");
1069                     next;
1070                 }
1071             } else {
1072                 $princ = RT::User->new(RT->SystemUser);
1073                 my ($ok, $msg) = $princ->Load( $item->{'UserId'} );
1074                 unless ( $ok ) {
1075                     RT->Logger->error("Unable to load user: $item->{UserId} : $msg");
1076                     next;
1077                 }
1078             }
1079
1080             # Grant it
1081             my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
1082                 Right => $item->{'Right'},
1083                 Object => $object
1084             );
1085             unless ( $return ) {
1086                 $RT::Logger->error( $msg );
1087             }
1088             else {
1089                 $RT::Logger->debug( $return ."." );
1090             }
1091         }
1092         $RT::Logger->debug("done.");
1093     }
1094
1095     if ( @ScripActions ) {
1096         $RT::Logger->debug("Creating ScripActions...");
1097
1098         for my $item (@ScripActions) {
1099             my $new_entry = RT::ScripAction->new(RT->SystemUser);
1100             my ( $return, $msg ) = $new_entry->Create(%$item);
1101             unless ( $return ) {
1102                 $RT::Logger->error( $msg );
1103             }
1104             else {
1105                 $RT::Logger->debug( $return ."." );
1106             }
1107         }
1108
1109         $RT::Logger->debug("done.");
1110     }
1111
1112     if ( @ScripConditions ) {
1113         $RT::Logger->debug("Creating ScripConditions...");
1114
1115         for my $item (@ScripConditions) {
1116             my $new_entry = RT::ScripCondition->new(RT->SystemUser);
1117             my ( $return, $msg ) = $new_entry->Create(%$item);
1118             unless ( $return ) {
1119                 $RT::Logger->error( $msg );
1120             }
1121             else {
1122                 $RT::Logger->debug( $return ."." );
1123             }
1124         }
1125
1126         $RT::Logger->debug("done.");
1127     }
1128
1129     if ( @Templates ) {
1130         $RT::Logger->debug("Creating templates...");
1131
1132         for my $item (@Templates) {
1133             my $new_entry = RT::Template->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         $RT::Logger->debug("done.");
1143     }
1144     if ( @Scrips ) {
1145         $RT::Logger->debug("Creating scrips...");
1146
1147         for my $item (@Scrips) {
1148             my $new_entry = RT::Scrip->new(RT->SystemUser);
1149
1150             my @queues = ref $item->{'Queue'} eq 'ARRAY'? @{ $item->{'Queue'} }: $item->{'Queue'} || 0;
1151             push @queues, 0 unless @queues; # add global queue at least
1152
1153             my ( $return, $msg ) = $new_entry->Create( %$item, Queue => shift @queues );
1154             unless ( $return ) {
1155                 $RT::Logger->error( $msg );
1156                 next;
1157             }
1158             else {
1159                 $RT::Logger->debug( $return ."." );
1160             }
1161             foreach my $q ( @queues ) {
1162                 my ($return, $msg) = $new_entry->AddToObject(
1163                     ObjectId => $q,
1164                     Stage    => $item->{'Stage'},
1165                 );
1166                 $RT::Logger->error( "Couldn't apply scrip to $q: $msg" )
1167                     unless $return;
1168             }
1169         }
1170         $RT::Logger->debug("done.");
1171     }
1172     if ( @Attributes ) {
1173         $RT::Logger->debug("Creating attributes...");
1174         my $sys = RT::System->new(RT->SystemUser);
1175
1176         for my $item (@Attributes) {
1177             my $obj = delete $item->{Object}; # XXX: make this something loadable
1178             $obj ||= $sys;
1179             my ( $return, $msg ) = $obj->AddAttribute (%$item);
1180             unless ( $return ) {
1181                 $RT::Logger->error( $msg );
1182             }
1183             else {
1184                 $RT::Logger->debug( $return ."." );
1185             }
1186         }
1187         $RT::Logger->debug("done.");
1188     }
1189     if ( @Final ) {
1190         $RT::Logger->debug("Running final actions...");
1191         for ( @Final ) {
1192             local $@;
1193             eval { $_->(); };
1194             $RT::Logger->error( "Failed to run one of final actions: $@" )
1195                 if $@;
1196         }
1197         $RT::Logger->debug("done.");
1198     }
1199
1200     # XXX: This disconnect doesn't really belong here; it's a relict from when
1201     # this method was extracted from rt-setup-database.  However, too much
1202     # depends on it to change without significant testing.  At the very least,
1203     # we can provide a way to skip the side-effect.
1204     if ( $args{disconnect_after} ) {
1205         my $db_type = RT->Config->Get('DatabaseType');
1206         $RT::Handle->Disconnect() unless $db_type eq 'SQLite';
1207     }
1208
1209     $RT::Logger->debug("Done setting up database content.");
1210
1211 # TODO is it ok to return 1 here? If so, the previous codes in this sub
1212 # should return (0, $msg) if error happens instead of just warning.
1213 # anyway, we need to return something here to tell if everything is ok
1214     return( 1, 'Done inserting data' );
1215 }
1216
1217 =head2 ACLEquivGroupId
1218
1219 Given a userid, return that user's acl equivalence group
1220
1221 =cut
1222
1223 sub ACLEquivGroupId {
1224     my $id = shift;
1225
1226     my $cu = RT->SystemUser;
1227     unless ( $cu ) {
1228         require RT::CurrentUser;
1229         $cu = RT::CurrentUser->new;
1230         $cu->LoadByName('RT_System');
1231         warn "Couldn't load RT_System user" unless $cu->id;
1232     }
1233
1234     my $equiv_group = RT::Group->new( $cu );
1235     $equiv_group->LoadACLEquivalenceGroup( $id );
1236     return $equiv_group->Id;
1237 }
1238
1239 =head2 QueryHistory
1240
1241 Returns the SQL query history associated with this handle. The top level array
1242 represents a lists of request. Each request is a hash with metadata about the
1243 request (such as the URL) and a list of queries. You'll probably not be using this.
1244
1245 =cut
1246
1247 sub QueryHistory {
1248     my $self = shift;
1249
1250     return $self->{QueryHistory};
1251 }
1252
1253 =head2 AddRequestToHistory
1254
1255 Adds a web request to the query history. It must be a hash with keys Path (a
1256 string) and Queries (an array reference of arrays, where elements are time,
1257 sql, bind parameters, and duration).
1258
1259 =cut
1260
1261 sub AddRequestToHistory {
1262     my $self    = shift;
1263     my $request = shift;
1264
1265     push @{ $self->{QueryHistory} }, $request;
1266 }
1267
1268 =head2 Quote
1269
1270 Returns the parameter quoted by DBI. B<You almost certainly do not need this.>
1271 Use bind parameters (C<?>) instead. This is used only outside the scope of interacting
1272 with the database.
1273
1274 =cut
1275
1276 sub Quote {
1277     my $self = shift;
1278     my $value = shift;
1279
1280     return $self->dbh->quote($value);
1281 }
1282
1283 =head2 FillIn
1284
1285 Takes a SQL query and an array reference of bind parameters and fills in the
1286 query's C<?> parameters.
1287
1288 =cut
1289
1290 sub FillIn {
1291     my $self = shift;
1292     my $sql  = shift;
1293     my $bind = shift;
1294
1295     my $b = 0;
1296
1297     # is this regex sufficient?
1298     $sql =~ s{\?}{$self->Quote($bind->[$b++])}eg;
1299
1300     return $sql;
1301 }
1302
1303 sub Indexes {
1304     my $self = shift;
1305
1306     my %res;
1307
1308     my $db_type = RT->Config->Get('DatabaseType');
1309     my $dbh = $self->dbh;
1310
1311     my $list;
1312     if ( $db_type eq 'mysql' ) {
1313         $list = $dbh->selectall_arrayref(
1314             'select distinct table_name, index_name from information_schema.statistics where table_schema = ?',
1315             undef, scalar RT->Config->Get('DatabaseName')
1316         );
1317     }
1318     elsif ( $db_type eq 'Pg' ) {
1319         $list = $dbh->selectall_arrayref(
1320             'select tablename, indexname from pg_indexes',
1321             undef,
1322         );
1323     }
1324     elsif ( $db_type eq 'SQLite' ) {
1325         $list = $dbh->selectall_arrayref(
1326             'select tbl_name, name from sqlite_master where type = ?',
1327             undef, 'index'
1328         );
1329     }
1330     elsif ( $db_type eq 'Oracle' ) {
1331         $list = $dbh->selectall_arrayref(
1332             'select table_name, index_name from dba_indexes where index_name NOT LIKE ? AND lower(Owner) = ?',
1333             undef, 'SYS_%$$', lc RT->Config->Get('DatabaseUser'),
1334         );
1335     }
1336     else {
1337         die "Not implemented";
1338     }
1339     push @{ $res{ lc $_->[0] } ||= [] }, lc $_->[1] foreach @$list;
1340     return %res;
1341 }
1342
1343 sub IndexesThatBeginWith {
1344     my $self = shift;
1345     my %args = (Table => undef, Columns => [], @_);
1346
1347     my %indexes = $self->Indexes;
1348
1349     my @check = @{ $args{'Columns'} };
1350
1351     my @list;
1352     foreach my $index ( @{ $indexes{ lc $args{'Table'} } || [] } ) {
1353         my %info = $self->IndexInfo( Table => $args{'Table'}, Name => $index );
1354         next if @{ $info{'Columns'} } < @check;
1355         my $check = join ',', @check;
1356         next if join( ',', @{ $info{'Columns'} } ) !~ /^\Q$check\E(?:,|$)/i;
1357
1358         push @list, \%info;
1359     }
1360     return sort { @{ $a->{'Columns'} } <=> @{ $b->{'Columns'} } } @list;
1361 }
1362
1363 sub IndexInfo {
1364     my $self = shift;
1365     my %args = (Table => undef, Name => undef, @_);
1366
1367     my $db_type = RT->Config->Get('DatabaseType');
1368     my $dbh = $self->dbh;
1369
1370     my %res = (
1371         Table => lc $args{'Table'},
1372         Name => lc $args{'Name'},
1373     );
1374     if ( $db_type eq 'mysql' ) {
1375         my $list = $dbh->selectall_arrayref(
1376             'select NON_UNIQUE, COLUMN_NAME, SUB_PART
1377             from information_schema.statistics
1378             where table_schema = ? AND LOWER(table_name) = ? AND index_name = ?
1379             ORDER BY SEQ_IN_INDEX',
1380             undef, scalar RT->Config->Get('DatabaseName'), lc $args{'Table'}, $args{'Name'},
1381         );
1382         return () unless $list && @$list;
1383         $res{'Unique'} = $list->[0][0]? 0 : 1;
1384         $res{'Functional'} = 0;
1385         $res{'Columns'} = [ map $_->[1], @$list ];
1386     }
1387     elsif ( $db_type eq 'Pg' ) {
1388         my $index = $dbh->selectrow_hashref(
1389             'select ix.*, pg_get_expr(ix.indexprs, ix.indrelid) as functions
1390             from
1391                 pg_class t, pg_class i, pg_index ix
1392             where
1393                 t.relname ilike ?
1394                 and t.relkind = ?
1395                 and i.relname ilike ?
1396                 and ix.indrelid = t.oid
1397                 and ix.indexrelid = i.oid
1398             ',
1399             undef, $args{'Table'}, 'r', $args{'Name'},
1400         );
1401         return () unless $index && keys %$index;
1402         $res{'Unique'} = $index->{'indisunique'};
1403         $res{'Functional'} = (grep $_ == 0, split ' ', $index->{'indkey'})? 1 : 0;
1404         $res{'Columns'} = [ map int($_), split ' ', $index->{'indkey'} ];
1405         my $columns = $dbh->selectall_hashref(
1406             'select a.attnum, a.attname
1407             from pg_attribute a where a.attrelid = ?',
1408             'attnum', undef, $index->{'indrelid'}
1409         );
1410         if ($index->{'functions'}) {
1411             # XXX: this is good enough for us
1412             $index->{'functions'} = [ split /,\s+/, $index->{'functions'} ];
1413         }
1414         foreach my $e ( @{ $res{'Columns'} } ) {
1415             if (exists $columns->{$e} ) {
1416                 $e = $columns->{$e}{'attname'};
1417             }
1418             elsif ( !$e ) {
1419                 $e = shift @{ $index->{'functions'} };
1420             }
1421         }
1422
1423         foreach my $column ( @{$res{'Columns'}} ) {
1424             next unless $column =~ s/^lower\( \s* \(? (\w+) \)? (?:::text)? \s* \)$/$1/ix;
1425             $res{'CaseInsensitive'}{ lc $1 } = 1;
1426         }
1427     }
1428     elsif ( $db_type eq 'SQLite' ) {
1429         my $list = $dbh->selectall_arrayref("pragma index_info('$args{'Name'}')");
1430         return () unless $list && @$list;
1431
1432         $res{'Functional'} = 0;
1433         $res{'Columns'} = [ map $_->[2], @$list ];
1434
1435         $list = $dbh->selectall_arrayref("pragma index_list('$args{'Table'}')");
1436         $res{'Unique'} = (grep lc $_->[1] eq lc $args{'Name'}, @$list)[0][2]? 1 : 0;
1437     }
1438     elsif ( $db_type eq 'Oracle' ) {
1439         my $index = $dbh->selectrow_arrayref(
1440             'select uniqueness, funcidx_status from dba_indexes
1441             where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(Owner) = ?',
1442             undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
1443         );
1444         return () unless $index && @$index;
1445         $res{'Unique'} = $index->[0] eq 'UNIQUE'? 1 : 0;
1446         $res{'Functional'} = $index->[1] ? 1 : 0;
1447
1448         my %columns = map @$_, @{ $dbh->selectall_arrayref(
1449             'select column_position, column_name from dba_ind_columns
1450             where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?',
1451             undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
1452         ) };
1453         $columns{ $_->[0] } = $_->[1] foreach @{ $dbh->selectall_arrayref(
1454             'select column_position, column_expression from dba_ind_expressions
1455             where lower(table_name) = ? AND lower(index_name) = ? AND LOWER(index_owner) = ?',
1456             undef, lc $args{'Table'}, lc $args{'Name'}, lc RT->Config->Get('DatabaseUser'),
1457         ) };
1458         $res{'Columns'} = [ map $columns{$_}, sort { $a <=> $b } keys %columns ];
1459
1460         foreach my $column ( @{$res{'Columns'}} ) {
1461             next unless $column =~ s/^lower\( \s* " (\w+) " \s* \)$/$1/ix;
1462             $res{'CaseInsensitive'}{ lc $1 } = 1;
1463         }
1464     }
1465     else {
1466         die "Not implemented";
1467     }
1468     $_ = lc $_ foreach @{ $res{'Columns'} };
1469     return %res;
1470 }
1471
1472 sub DropIndex {
1473     my $self = shift;
1474     my %args = (Table => undef, Name => undef, @_);
1475
1476     my $db_type = RT->Config->Get('DatabaseType');
1477     my $dbh = $self->dbh;
1478     local $dbh->{'PrintError'} = 0;
1479     local $dbh->{'RaiseError'} = 0;
1480
1481     my $res;
1482     if ( $db_type eq 'mysql' ) {
1483         $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} );
1484         $res = $dbh->do(
1485             'drop index '. $dbh->quote_identifier($args{'Name'}) ." on $args{'Table'}",
1486         );
1487     }
1488     elsif ( $db_type eq 'Pg' ) {
1489         $res = $dbh->do("drop index $args{'Name'} CASCADE");
1490     }
1491     elsif ( $db_type eq 'SQLite' ) {
1492         $res = $dbh->do("drop index $args{'Name'}");
1493     }
1494     elsif ( $db_type eq 'Oracle' ) {
1495         my $user = RT->Config->Get('DatabaseUser');
1496         # Check if it has constraints associated with it
1497         my ($constraint) = $dbh->selectrow_arrayref(
1498             'SELECT constraint_name, table_name FROM dba_constraints WHERE LOWER(owner) = ? AND LOWER(index_name) = ?',
1499             undef, lc $user, lc $args{'Name'}
1500         );
1501         if ($constraint) {
1502             my ($constraint_name, $table) = @{$constraint};
1503             $res = $dbh->do("ALTER TABLE $user.$table DROP CONSTRAINT $constraint_name");
1504         } else {
1505             $res = $dbh->do("DROP INDEX $user.$args{'Name'}");
1506         }
1507     }
1508     else {
1509         die "Not implemented";
1510     }
1511     my $desc = $self->IndexDescription( %args );
1512     return ($res, $res? "Dropped $desc" : "Couldn't drop $desc: ". $dbh->errstr);
1513 }
1514
1515 sub _CanonicTableNameMysql {
1516     my $self = shift;
1517     my $table = shift;
1518     return $table unless $table;
1519     # table name can be case sensitivity in DDL
1520     # use LOWER to workaround mysql "bug"
1521     return ($self->dbh->selectrow_array(
1522         'SELECT table_name
1523         FROM information_schema.tables
1524         WHERE table_schema = ? AND LOWER(table_name) = ?',
1525         undef, scalar RT->Config->Get('DatabaseName'), lc $table
1526     ))[0] || $table;
1527 }
1528
1529 sub DropIndexIfExists {
1530     my $self = shift;
1531     my %args = (Table => undef, Name => undef, @_);
1532
1533     my %indexes = $self->Indexes;
1534     return (1, ucfirst($self->IndexDescription( %args )) ." doesn't exists")
1535         unless grep $_ eq lc $args{'Name'},
1536         @{ $indexes{ lc $args{'Table'} } || []};
1537     return $self->DropIndex(%args);
1538 }
1539
1540 sub CreateIndex {
1541     my $self = shift;
1542     my %args = ( Table => undef, Name => undef, Columns => [], CaseInsensitive => {}, @_ );
1543
1544     $args{'Table'} = $self->_CanonicTableNameMysql( $args{'Table'} )
1545         if RT->Config->Get('DatabaseType') eq 'mysql';
1546
1547     my $name = $args{'Name'};
1548     unless ( $name ) {
1549         my %indexes = $self->Indexes;
1550         %indexes = map { $_ => 1 } @{ $indexes{ lc $args{'Table'} } || [] };
1551         my $i = 1;
1552         $i++ while $indexes{ lc($args{'Table'}).$i };
1553         $name = lc($args{'Table'}).$i;
1554     }
1555
1556     my @columns = @{ $args{'Columns'} };
1557     if ( $self->CaseSensitive ) {
1558         foreach my $column ( @columns ) {
1559             next unless $args{'CaseInsensitive'}{ lc $column };
1560             $column = "LOWER($column)";
1561         }
1562     }
1563
1564     my $sql = "CREATE"
1565         . ($args{'Unique'}? ' UNIQUE' : '')
1566         ." INDEX $name ON $args{'Table'}"
1567         ."(". join( ', ', @columns ) .")"
1568     ;
1569
1570     my $res = $self->dbh->do( $sql );
1571     unless ( $res ) {
1572         return (
1573             undef, "Failed to create ". $self->IndexDescription( %args )
1574                 ." (sql: $sql): ". $self->dbh->errstr
1575         );
1576     }
1577     return ($name, "Created ". $self->IndexDescription( %args ) );
1578 }
1579
1580 sub IndexDescription {
1581     my $self = shift;
1582     my %args = (@_);
1583
1584     my $desc =
1585         ($args{'Unique'}? 'unique ' : '')
1586         .'index'
1587         . ($args{'Name'}? " $args{'Name'}" : '')
1588         . ( @{$args{'Columns'}||[]}?
1589             " ("
1590             . join(', ', @{$args{'Columns'}})
1591             . (@{$args{'Optional'}||[]}? '['. join(', ', '', @{$args{'Optional'}}).']' : '' )
1592             .")"
1593             : ''
1594         )
1595         . ($args{'Table'}? " on $args{'Table'}" : '')
1596     ;
1597     return $desc;
1598 }
1599
1600 sub MakeSureIndexExists {
1601     my $self = shift;
1602     my %args = ( Table => undef, Columns => [], Optional => [], @_ );
1603
1604     my @list = $self->IndexesThatBeginWith(
1605         Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1606     );
1607     if (@list) {
1608         RT->Logger->debug( ucfirst $self->IndexDescription(
1609             Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1610         ). ' exists.' );
1611         return;
1612     }
1613
1614     @list = $self->IndexesThatBeginWith(
1615         Table => $args{'Table'}, Columns => $args{'Columns'},
1616     );
1617     if ( !@list ) {
1618         my ($status, $msg) = $self->CreateIndex(
1619             Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1620         );
1621         my $method = $status ? 'debug' : 'warning';
1622         RT->Logger->$method($msg);
1623     }
1624     else {
1625         RT->Logger->info(
1626             ucfirst $self->IndexDescription(
1627                 %{$list[0]}
1628             )
1629             .' exists, you may consider replacing it with '
1630             . $self->IndexDescription(
1631                 Table => $args{'Table'}, Columns => [@{$args{'Columns'}}, @{$args{'Optional'}}],
1632             )
1633         );
1634     }
1635 }
1636
1637 sub DropIndexesThatArePrefix {
1638     my $self = shift;
1639     my %args = ( Table => undef, Columns => [], @_ );
1640
1641     my @list = $self->IndexesThatBeginWith(
1642         Table => $args{'Table'}, Columns => [$args{'Columns'}[0]],
1643     );
1644
1645     my $checking = join ',', map lc $_, @{ $args{'Columns'} }, '';
1646     foreach my $i ( splice @list ) {
1647         my $columns = join ',', @{ $i->{'Columns'} }, '';
1648         next unless $checking =~ /^\Q$columns/i;
1649
1650         push @list, $i;
1651     }
1652     pop @list;
1653
1654     foreach my $i ( @list ) {
1655         my ($status, $msg) = $self->DropIndex(
1656             Table => $i->{'Table'}, Name => $i->{'Name'},
1657         );
1658         my $method = $status ? 'debug' : 'warning';
1659         RT->Logger->$method($msg);
1660     }
1661 }
1662
1663 # log a mason stack trace instead of a Carp::longmess because it's less painful
1664 # and uses mason component paths properly
1665 sub _LogSQLStatement {
1666     my $self = shift;
1667     my $statement = shift;
1668     my $duration = shift;
1669     my @bind = @_;
1670
1671     require HTML::Mason::Exceptions;
1672     push @{$self->{'StatementLog'}} , ([Time::HiRes::time(), $statement, [@bind], $duration, HTML::Mason::Exception->new->as_string]);
1673 }
1674
1675 # helper in a few cases where we do SQL by hand
1676 sub __MakeClauseCaseInsensitive {
1677     my $self = shift;
1678     return join ' ', @_ unless $self->CaseSensitive;
1679     my ($field, $op, $value) = $self->_MakeClauseCaseInsensitive(@_);
1680     return "$field $op $value";
1681 }
1682
1683 sub _TableNames {
1684     my $self = shift;
1685     my $dbh = shift || $self->dbh;
1686
1687     {
1688         local $@;
1689         if (
1690             $dbh->{Driver}->{Name} eq 'Pg'
1691             && $dbh->{'pg_server_version'} >= 90200
1692             && !eval { DBD::Pg->VERSION('2.19.3'); 1 }
1693         ) {
1694             die "You're using PostgreSQL 9.2 or newer. You have to upgrade DBD::Pg module to 2.19.3 or newer: $@";
1695         }
1696     }
1697
1698     my @res;
1699
1700     my $sth = $dbh->table_info( '', undef, undef, "'TABLE'");
1701     while ( my $table = $sth->fetchrow_hashref ) {
1702         push @res, $table->{TABLE_NAME} || $table->{table_name};
1703     }
1704
1705     return @res;
1706 }
1707
1708 __PACKAGE__->FinalizeDatabaseType;
1709
1710 RT::Base->_ImportOverlays();
1711
1712 1;