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