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