Merge branch 'patch-1' of https://github.com/gjones2/Freeside
[freeside.git] / rt / lib / RT / Handle.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
6 #                                          <sales@bestpractical.com>
7 #
8 # (Except where explicitly superseded by other copyright notices)
9 #
10 #
11 # LICENSE:
12 #
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
16 # from www.gnu.org.
17 #
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28 #
29 #
30 # CONTRIBUTION SUBMISSION POLICY:
31 #
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
37 #
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
46 #
47 # END BPS TAGGED BLOCK }}}
48
49 =head1 NAME
50
51 RT::Handle - RT's database handle
52
53 =head1 SYNOPSIS
54
55     use RT;
56     BEGIN { RT::LoadConfig() };
57     use RT::Handle;
58
59 =head1 DESCRIPTION
60
61 C<RT::Handle> is RT specific wrapper over one of L<DBIx::SearchBuilder::Handle>
62 classes. As RT works with different types of DBs we subclass repsective handler
63 from L<DBIx::SerachBuilder>. Type of the DB is defined by C<DatabasseType> RT's
64 config option. You B<must> load this module only when the configs have been
65 loaded.
66
67 =cut
68
69 package RT::Handle;
70
71 use strict;
72 use warnings;
73
74 use File::Spec;
75
76 =head1 METHODS
77
78 =head2 FinalizeDatabaseType
79
80 Sets RT::Handle's superclass to the correct subclass of
81 L<DBIx::SearchBuilder::Handle>, using the C<DatabaseType> configuration.
82
83 =cut
84
85 sub FinalizeDatabaseType {
86     eval {
87         use base "DBIx::SearchBuilder::Handle::". RT->Config->Get('DatabaseType');
88     };
89
90     if ($@) {
91         die "Unable to load DBIx::SearchBuilder database handle for '". RT->Config->Get('DatabaseType') ."'.\n".
92             "Perhaps you've picked an invalid database type or spelled it incorrectly.\n".
93             $@;
94     }
95 }
96
97 =head2 Connect
98
99 Connects to RT's database using credentials and options from the RT config.
100 Takes nothing.
101
102 =cut
103
104 sub Connect {
105     my $self = shift;
106     my %args = (@_);
107
108     my $db_type = RT->Config->Get('DatabaseType');
109     if ( $db_type eq 'Oracle' ) {
110         $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8";
111         $ENV{'NLS_NCHAR'} = "AL32UTF8";
112     }
113
114     $self->SUPER::Connect(
115         User => RT->Config->Get('DatabaseUser'),
116         Password => RT->Config->Get('DatabasePassword'),
117         %args,
118     );
119
120     if ( $db_type eq 'mysql' ) {
121         my $version = $self->DatabaseVersion;
122         ($version) = $version =~ /^(\d+\.\d+)/;
123         $self->dbh->do("SET NAMES 'utf8'") if $version >= 4.1;
124     }
125
126
127     if ( $db_type eq 'Pg' ) {
128         my $version = $self->DatabaseVersion;
129         ($version) = $version =~ /^(\d+\.\d+)/;
130         $self->dbh->do("SET bytea_output = 'escape'") if $version >= 9.0;
131     }
132
133
134
135     $self->dbh->{'LongReadLen'} = RT->Config->Get('MaxAttachmentSize');
136 }
137
138 =head2 BuildDSN
139
140 Build the DSN for the RT database. Doesn't take any parameters, draws all that
141 from the config.
142
143 =cut
144
145
146 sub BuildDSN {
147     my $self = shift;
148     # Unless the database port is a positive integer, we really don't want to pass it.
149     my $db_port = RT->Config->Get('DatabasePort');
150     $db_port = undef unless (defined $db_port && $db_port =~ /^(\d+)$/);
151     my $db_host = RT->Config->Get('DatabaseHost');
152     $db_host = undef unless $db_host;
153     my $db_name = RT->Config->Get('DatabaseName');
154     my $db_type = RT->Config->Get('DatabaseType');
155     $db_name = File::Spec->catfile($RT::VarPath, $db_name)
156         if $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name);
157
158     my %args = (
159         Host       => $db_host,
160         Database   => $db_name,
161         Port       => $db_port,
162         Driver     => $db_type,
163         RequireSSL => RT->Config->Get('DatabaseRequireSSL'),
164         DisconnectHandleOnDestroy => 1,
165     );
166     if ( $db_type eq 'Oracle' && $db_host ) {
167         $args{'SID'} = delete $args{'Database'};
168     }
169     $self->SUPER::BuildDSN( %args );
170 }
171
172 =head2 DSN
173
174 Returns the DSN for this handle. In order to get correct value you must
175 build DSN first, see L</BuildDSN>.
176
177 This is method can be called as class method, in this case creates
178 temporary handle object, L</BuildDSN builds DSN> and returns it.
179
180 =cut
181
182 sub DSN {
183     my $self = shift;
184     return $self->SUPER::DSN if ref $self;
185
186     my $handle = $self->new;
187     $handle->BuildDSN;
188     return $handle->DSN;
189 }
190
191 =head2 SystemDSN
192
193 Returns a DSN suitable for database creates and drops
194 and user creates and drops.
195
196 Gets RT's DSN first (see L<DSN>) and then change it according
197 to requirements of a database system RT's using.
198
199 =cut
200
201 sub SystemDSN {
202     my $self = shift;
203
204     my $db_name = RT->Config->Get('DatabaseName');
205     my $db_type = RT->Config->Get('DatabaseType');
206
207     my $dsn = $self->DSN;
208     if ( $db_type eq 'mysql' ) {
209         # with mysql, you want to connect sans database to funge things
210         $dsn =~ s/dbname=\Q$db_name//;
211     }
212     elsif ( $db_type eq 'Pg' ) {
213         # with postgres, you want to connect to template1 database
214         $dsn =~ s/dbname=\Q$db_name/dbname=template1/;
215     }
216     return $dsn;
217 }
218
219 =head2 Database compatibility and integrity checks
220
221
222
223 =cut
224
225 sub CheckIntegrity {
226     my $self = shift;
227     $self = new $self unless ref $self;
228
229     unless ($RT::Handle and $RT::Handle->dbh) {
230         local $@;
231         unless ( eval { RT::ConnectToDatabase(); 1 } ) {
232             return (0, 'no connection', "$@");
233         }
234     }
235
236     require RT::CurrentUser;
237     my $test_user = RT::CurrentUser->new;
238     $test_user->Load('RT_System');
239     unless ( $test_user->id ) {
240         return (0, 'no system user', "Couldn't find RT_System user in the DB '". $self->DSN ."'");
241     }
242
243     $test_user = RT::CurrentUser->new;
244     $test_user->Load('Nobody');
245     unless ( $test_user->id ) {
246         return (0, 'no nobody user', "Couldn't find Nobody user in the DB '". $self->DSN ."'");
247     }
248
249     return $RT::Handle->dbh;
250 }
251
252 sub CheckCompatibility {
253     my $self = shift;
254     my $dbh = shift;
255     my $state = shift || 'post';
256
257     my $db_type = RT->Config->Get('DatabaseType');
258     if ( $db_type eq "mysql" ) {
259         # Check which version we're running
260         my $version = ($dbh->selectrow_array("show variables like 'version'"))[1];
261         return (0, "couldn't get version of the mysql server")
262             unless $version;
263
264         ($version) = $version =~ /^(\d+\.\d+)/;
265         return (0, "RT is unsupported on MySQL versions before 4.0.x, it's $version")
266             if $version < 4;
267
268         # MySQL must have InnoDB support
269         my $innodb = ($dbh->selectrow_array("show variables like 'have_innodb'"))[1];
270         if ( lc $innodb eq "no" ) {
271             return (0, "RT requires that MySQL be compiled with InnoDB table support.\n".
272                 "See http://dev.mysql.com/doc/mysql/en/InnoDB.html");
273         } elsif ( lc $innodb eq "disabled" ) {
274             return (0, "RT requires that MySQL InnoDB table support be enabled.\n".
275                 "Remove the 'skip-innodb' line from your my.cnf file, restart MySQL, and try again.\n");
276         }
277
278         if ( $state eq 'post' ) {
279             my $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Tickets")->[1];
280             unless ( $create_table =~ /(?:ENGINE|TYPE)\s*=\s*InnoDB/i ) {
281                 return (0, "RT requires that all its tables be of InnoDB type. Upgrade RT tables.");
282             }
283         }
284         if ( $version >= 4.1 && $state eq 'post' ) {
285             my $create_table = $dbh->selectrow_arrayref("SHOW CREATE TABLE Attachments")->[1];
286             unless ( $create_table =~ /\bContent\b[^,]*BLOB/i ) {
287                 return (0, "RT since version 3.8 has new schema for MySQL versions after 4.1.0\n"
288                     ."Follow instructions in the UPGRADING.mysql file.");
289             }
290         }
291     }
292     return (1)
293 }
294
295 sub CheckSphinxSE {
296     my $self = shift;
297
298     my $dbh = $RT::Handle->dbh;
299     local $dbh->{'RaiseError'} = 0;
300     local $dbh->{'PrintError'} = 0;
301     my $has = ($dbh->selectrow_array("show variables like 'have_sphinx'"))[1];
302     $has ||= ($dbh->selectrow_array(
303         "select 'yes' from INFORMATION_SCHEMA.PLUGINS where PLUGIN_NAME = 'sphinx' AND PLUGIN_STATUS='active'"
304     ))[0];
305
306     return 0 unless lc($has||'') eq "yes";
307     return 1;
308 }
309
310 =head2 Database maintanance
311
312 =head3 CreateDatabase $DBH
313
314 Creates a new database. This method can be used as class method.
315
316 Takes DBI handle. Many database systems require special handle to
317 allow you to create a new database, so you have to use L<SystemDSN>
318 method during connection.
319
320 Fetches type and name of the DB from the config.
321
322 =cut
323
324 sub CreateDatabase {
325     my $self = shift;
326     my $dbh  = shift or return (0, "No DBI handle provided");
327     my $db_type = RT->Config->Get('DatabaseType');
328     my $db_name = RT->Config->Get('DatabaseName');
329
330     my $status;
331     if ( $db_type eq 'SQLite' ) {
332         return (1, 'Skipped as SQLite doesn\'t need any action');
333     }
334     elsif ( $db_type eq 'Oracle' ) {
335         my $db_user = RT->Config->Get('DatabaseUser');
336         my $db_pass = RT->Config->Get('DatabasePassword');
337         $status = $dbh->do(
338             "CREATE USER $db_user IDENTIFIED BY $db_pass"
339             ." default tablespace USERS"
340             ." temporary tablespace TEMP"
341             ." quota unlimited on USERS"
342         );
343         unless ( $status ) {
344             return $status, "Couldn't create user $db_user identified by $db_pass."
345                 ."\nError: ". $dbh->errstr;
346         }
347         $status = $dbh->do( "GRANT connect, resource TO $db_user" );
348         unless ( $status ) {
349             return $status, "Couldn't grant connect and resource to $db_user."
350                 ."\nError: ". $dbh->errstr;
351         }
352         return (1, "Created user $db_user. All RT's objects should be in his schema.");
353     }
354     elsif ( $db_type eq 'Pg' ) {
355         $status = $dbh->do("CREATE DATABASE $db_name WITH ENCODING='UNICODE' TEMPLATE template0");
356     }
357     else {
358         $status = $dbh->do("CREATE DATABASE $db_name");
359     }
360     return ($status, $DBI::errstr);
361 }
362
363 =head3 DropDatabase $DBH
364
365 Drops RT's database. This method can be used as class method.
366
367 Takes DBI handle as first argument. Many database systems require
368 a special handle to allow you to drop a database, so you may have
369 to use L<SystemDSN> when acquiring the DBI handle.
370
371 Fetches the type and name of the database from the config.
372
373 =cut
374
375 sub DropDatabase {
376     my $self = shift;
377     my $dbh  = shift or return (0, "No DBI handle provided");
378
379     my $db_type = RT->Config->Get('DatabaseType');
380     my $db_name = RT->Config->Get('DatabaseName');
381
382     if ( $db_type eq 'Oracle' ) {
383         my $db_user = RT->Config->Get('DatabaseUser');
384         my $status = $dbh->do( "DROP USER $db_user CASCADE" );
385         unless ( $status ) {
386             return 0, "Couldn't drop user $db_user."
387                 ."\nError: ". $dbh->errstr;
388         }
389         return (1, "Successfully dropped user '$db_user' with his schema.");
390     }
391     elsif ( $db_type eq 'SQLite' ) {
392         my $path = $db_name;
393         $path = "$RT::VarPath/$path" unless substr($path, 0, 1) eq '/';
394         unlink $path or return (0, "Couldn't remove '$path': $!");
395         return (1);
396     } else {
397         $dbh->do("DROP DATABASE ". $db_name)
398             or return (0, $DBI::errstr);
399     }
400     return (1);
401 }
402
403 =head2 InsertACL
404
405 =cut
406
407 sub InsertACL {
408     my $self      = shift;
409     my $dbh       = shift;
410     my $base_path = shift || $RT::EtcPath;
411
412     my $db_type = RT->Config->Get('DatabaseType');
413     return (1) if $db_type eq 'SQLite';
414
415     $dbh = $self->dbh if !$dbh && ref $self;
416     return (0, "No DBI handle provided") unless $dbh;
417
418     return (0, "'$base_path' doesn't exist") unless -e $base_path;
419
420     my $path;
421     if ( -d $base_path ) {
422         $path = File::Spec->catfile( $base_path, "acl.$db_type");
423         $path = $self->GetVersionFile($dbh, $path);
424
425         $path = File::Spec->catfile( $base_path, "acl")
426             unless $path && -e $path;
427         return (0, "Couldn't find ACLs for $db_type")
428             unless -e $path;
429     } else {
430         $path = $base_path;
431     }
432
433     local *acl;
434     do $path || return (0, "Couldn't load ACLs: " . $@);
435     my @acl = acl($dbh);
436     foreach my $statement (@acl) {
437         my $sth = $dbh->prepare($statement)
438             or return (0, "Couldn't prepare SQL query:\n $statement\n\nERROR: ". $dbh->errstr);
439         unless ( $sth->execute ) {
440             return (0, "Couldn't run SQL query:\n $statement\n\nERROR: ". $sth->errstr);
441         }
442     }
443     return (1);
444 }
445
446 =head2 InsertSchema
447
448 =cut
449
450 sub InsertSchema {
451     my $self = shift;
452     my $dbh  = shift;
453     my $base_path = (shift || $RT::EtcPath);
454
455     $dbh = $self->dbh if !$dbh && ref $self;
456     return (0, "No DBI handle provided") unless $dbh;
457
458     my $db_type = RT->Config->Get('DatabaseType');
459
460     my $file;
461     if ( -d $base_path ) {
462         $file = $base_path . "/schema." . $db_type;
463     } else {
464         $file = $base_path;
465     }
466
467     $file = $self->GetVersionFile( $dbh, $file );
468     unless ( $file ) {
469         return (0, "Couldn't find schema file(s) '$file*'");
470     }
471     unless ( -f $file && -r $file ) {
472         return (0, "File '$file' doesn't exist or couldn't be read");
473     }
474
475     my (@schema);
476
477     open( my $fh_schema, '<', $file ) or die $!;
478
479     my $has_local = 0;
480     open( my $fh_schema_local, "<" . $self->GetVersionFile( $dbh, $RT::LocalEtcPath . "/schema." . $db_type ))
481         and $has_local = 1;
482
483     my $statement = "";
484     foreach my $line ( <$fh_schema>, ($_ = ';;'), $has_local? <$fh_schema_local>: () ) {
485         $line =~ s/\#.*//g;
486         $line =~ s/--.*//g;
487         $statement .= $line;
488         if ( $line =~ /;(\s*)$/ ) {
489             $statement =~ s/;(\s*)$//g;
490             push @schema, $statement;
491             $statement = "";
492         }
493     }
494     close $fh_schema; close $fh_schema_local;
495
496     if ( $db_type eq 'Oracle' ) {
497         my $db_user = RT->Config->Get('DatabaseUser');
498         my $status = $dbh->do( "ALTER SESSION SET CURRENT_SCHEMA=$db_user" );
499         unless ( $status ) {
500             return $status, "Couldn't set current schema to $db_user."
501                 ."\nError: ". $dbh->errstr;
502         }
503     }
504
505     local $SIG{__WARN__} = sub {};
506     my $is_local = 0;
507     $dbh->begin_work or return (0, "Couldn't begin transaction: ". $dbh->errstr);
508     foreach my $statement (@schema) {
509         if ( $statement =~ /^\s*;$/ ) {
510             $is_local = 1; next;
511         }
512
513         my $sth = $dbh->prepare($statement)
514             or return (0, "Couldn't prepare SQL query:\n$statement\n\nERROR: ". $dbh->errstr);
515         unless ( $sth->execute or $is_local ) {
516             return (0, "Couldn't run SQL query:\n$statement\n\nERROR: ". $sth->errstr);
517         }
518     }
519     $dbh->commit or return (0, "Couldn't commit transaction: ". $dbh->errstr);
520     return (1);
521 }
522
523 =head1 GetVersionFile
524
525 Takes base name of the file as argument, scans for <base name>-<version> named
526 files and returns file name with closest version to the version of the RT DB.
527
528 =cut
529
530 sub GetVersionFile {
531     my $self = shift;
532     my $dbh = shift;
533     my $base_name = shift;
534
535     my $db_version = ref $self
536         ? $self->DatabaseVersion
537         : do {
538             my $tmp = RT::Handle->new;
539             $tmp->dbh($dbh);
540             $tmp->DatabaseVersion;
541         };
542
543     require File::Glob;
544     my @files = File::Glob::bsd_glob("$base_name*");
545     return '' unless @files;
546
547     my %version = map { $_ =~ /\.\w+-([-\w\.]+)$/; ($1||0) => $_ } @files;
548     my $version;
549     foreach ( reverse sort cmp_version keys %version ) {
550         if ( cmp_version( $db_version, $_ ) >= 0 ) {
551             $version = $_;
552             last;
553         }
554     }
555
556     return defined $version? $version{ $version } : undef;
557 }
558
559 { my %word = (
560     a     => -4,
561     alpha => -4,
562     b     => -3,
563     beta  => -3,
564     pre   => -2,
565     rc    => -1,
566     head  => 9999,
567 );
568 sub cmp_version($$) {
569     my ($a, $b) = (@_);
570     my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
571         split /([^0-9]+)/, $a;
572     my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
573         split /([^0-9]+)/, $b;
574     @a > @b
575         ? push @b, (0) x (@a-@b)
576         : push @a, (0) x (@b-@a);
577     for ( my $i = 0; $i < @a; $i++ ) {
578         return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
579     }
580     return 0;
581 }}
582
583
584 =head2 InsertInitialData
585
586 Inserts system objects into RT's DB, like system user or 'nobody',
587 internal groups and other records required. However, this method
588 doesn't insert any real users like 'root' and you have to use
589 InsertData or another way to do that.
590
591 Takes no arguments. Returns status and message tuple.
592
593 It's safe to call this method even if those objects already exist.
594
595 =cut
596
597 sub InsertInitialData {
598     my $self    = shift;
599
600     my @warns;
601
602     # create RT_System user and grant him rights
603     {
604         require RT::CurrentUser;
605
606         my $test_user = RT::User->new( RT::CurrentUser->new() );
607         $test_user->Load('RT_System');
608         if ( $test_user->id ) {
609             push @warns, "Found system user in the DB.";
610         }
611         else {
612             my $user = RT::User->new( RT::CurrentUser->new() );
613             my ( $val, $msg ) = $user->_BootstrapCreate(
614                 Name     => 'RT_System',
615                 RealName => 'The RT System itself',
616                 Comments => 'Do not delete or modify this user. '
617                     . 'It is integral to RT\'s internal database structures',
618                 Creator  => '1',
619                 LastUpdatedBy => '1',
620             );
621             return ($val, $msg) unless $val;
622         }
623         DBIx::SearchBuilder::Record::Cachable->FlushCache;
624     }
625
626     # init RT::SystemUser and RT::System objects
627     RT::InitSystemObjects();
628     unless ( RT->SystemUser->id ) {
629         return (0, "Couldn't load system user");
630     }
631
632     # grant SuperUser right to system user
633     {
634         my $test_ace = RT::ACE->new( RT->SystemUser );
635         $test_ace->LoadByCols(
636             PrincipalId   => ACLEquivGroupId( RT->SystemUser->Id ),
637             PrincipalType => 'Group',
638             RightName     => 'SuperUser',
639             ObjectType    => 'RT::System',
640             ObjectId      => 1,
641         );
642         if ( $test_ace->id ) {
643             push @warns, "System user has global SuperUser right.";
644         } else {
645             my $ace = RT::ACE->new( RT->SystemUser );
646             my ( $val, $msg ) = $ace->_BootstrapCreate(
647                 PrincipalId   => ACLEquivGroupId( RT->SystemUser->Id ),
648                 PrincipalType => 'Group',
649                 RightName     => 'SuperUser',
650                 ObjectType    => 'RT::System',
651                 ObjectId      => 1,
652             );
653             return ($val, $msg) unless $val;
654         }
655         DBIx::SearchBuilder::Record::Cachable->FlushCache;
656     }
657
658     # system groups
659     # $self->loc('Everyone'); # For the string extractor to get a string to localize
660     # $self->loc('Privileged'); # For the string extractor to get a string to localize
661     # $self->loc('Unprivileged'); # For the string extractor to get a string to localize
662     foreach my $name (qw(Everyone Privileged Unprivileged)) {
663         my $group = RT::Group->new( RT->SystemUser );
664         $group->LoadSystemInternalGroup( $name );
665         if ( $group->id ) {
666             push @warns, "System group '$name' already exists.";
667             next;
668         }
669
670         $group = RT::Group->new( RT->SystemUser );
671         my ( $val, $msg ) = $group->_Create(
672             Type        => $name,
673             Domain      => 'SystemInternal',
674             Description => 'Pseudogroup for internal use',  # loc
675             Name        => '',
676             Instance    => '',
677         );
678         return ($val, $msg) unless $val;
679     }
680
681     # nobody
682     {
683         my $user = RT::User->new( RT->SystemUser );
684         $user->Load('Nobody');
685         if ( $user->id ) {
686             push @warns, "Found 'Nobody' user in the DB.";
687         }
688         else {
689             my ( $val, $msg ) = $user->Create(
690                 Name     => 'Nobody',
691                 RealName => 'Nobody in particular',
692                 Comments => 'Do not delete or modify this user. It is integral '
693                     .'to RT\'s internal data structures',
694                 Privileged => 0,
695             );
696             return ($val, $msg) unless $val;
697         }
698
699         if ( $user->HasRight( Right => 'OwnTicket', Object => $RT::System ) ) {
700             push @warns, "User 'Nobody' has global OwnTicket right.";
701         } else {
702             my ( $val, $msg ) = $user->PrincipalObj->GrantRight(
703                 Right => 'OwnTicket',
704                 Object => $RT::System,
705             );
706             return ($val, $msg) unless $val;
707         }
708     }
709
710     # rerun to get init Nobody as well
711     RT::InitSystemObjects();
712
713     # system role groups
714     foreach my $name (qw(Owner Requestor Cc AdminCc)) {
715         my $group = RT::Group->new( RT->SystemUser );
716         $group->LoadSystemRoleGroup( $name );
717         if ( $group->id ) {
718             push @warns, "System role '$name' already exists.";
719             next;
720         }
721
722         $group = RT::Group->new( RT->SystemUser );
723         my ( $val, $msg ) = $group->_Create(
724             Type        => $name,
725             Domain      => 'RT::System-Role',
726             Description => 'SystemRolegroup for internal use',  # loc
727             Name        => '',
728             Instance    => '',
729         );
730         return ($val, $msg) unless $val;
731     }
732
733     push @warns, "You appear to have a functional RT database."
734         if @warns;
735
736     return (1, join "\n", @warns);
737 }
738
739 =head2 InsertData
740
741 Load some sort of data into the database, takes path to a file.
742
743 =cut
744
745 sub InsertData {
746     my $self     = shift;
747     my $datafile = shift;
748     my $root_password = shift;
749     my %args     = (
750         disconnect_after => 1,
751         @_
752     );
753
754     # Slurp in stuff to insert from the datafile. Possible things to go in here:-
755     our (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions,
756            @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final);
757     local (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions,
758            @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final);
759
760     local $@;
761     $RT::Logger->debug("Going to load '$datafile' data file");
762     eval { require $datafile }
763       or return (0, "Couldn't load data from '$datafile' for import:\n\nERROR:". $@);
764
765     if ( @Initial ) {
766         $RT::Logger->debug("Running initial actions...");
767         foreach ( @Initial ) {
768             local $@;
769             eval { $_->(); 1 } or return (0, "One of initial functions failed: $@");
770         }
771         $RT::Logger->debug("Done.");
772     }
773     if ( @Groups ) {
774         $RT::Logger->debug("Creating groups...");
775         foreach my $item (@Groups) {
776             my $new_entry = RT::Group->new( RT->SystemUser );
777             my $member_of = delete $item->{'MemberOf'};
778             my ( $return, $msg ) = $new_entry->_Create(%$item);
779             unless ( $return ) {
780                 $RT::Logger->error( $msg );
781                 next;
782             } else {
783                 $RT::Logger->debug($return .".");
784             }
785             if ( $member_of ) {
786                 $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY';
787                 foreach( @$member_of ) {
788                     my $parent = RT::Group->new(RT->SystemUser);
789                     if ( ref $_ eq 'HASH' ) {
790                         $parent->LoadByCols( %$_ );
791                     }
792                     elsif ( !ref $_ ) {
793                         $parent->LoadUserDefinedGroup( $_ );
794                     }
795                     else {
796                         $RT::Logger->error(
797                             "(Error: wrong format of MemberOf field."
798                             ." Should be name of user defined group or"
799                             ." hash reference with 'column => value' pairs."
800                             ." Use array reference to add to multiple groups)"
801                         );
802                         next;
803                     }
804                     unless ( $parent->Id ) {
805                         $RT::Logger->error("(Error: couldn't load group to add member)");
806                         next;
807                     }
808                     my ( $return, $msg ) = $parent->AddMember( $new_entry->Id );
809                     unless ( $return ) {
810                         $RT::Logger->error( $msg );
811                     } else {
812                         $RT::Logger->debug( $return ."." );
813                     }
814                 }
815             }
816         }
817         $RT::Logger->debug("done.");
818     }
819     if ( @Users ) {
820         $RT::Logger->debug("Creating users...");
821         foreach my $item (@Users) {
822             if ( $item->{'Name'} eq 'root' && $root_password ) {
823                 $item->{'Password'} = $root_password;
824             }
825             my $new_entry = RT::User->new( RT->SystemUser );
826             my ( $return, $msg ) = $new_entry->Create(%$item);
827             unless ( $return ) {
828                 $RT::Logger->error( $msg );
829             } else {
830                 $RT::Logger->debug( $return ."." );
831             }
832         }
833         $RT::Logger->debug("done.");
834     }
835     if ( @Queues ) {
836         $RT::Logger->debug("Creating queues...");
837         for my $item (@Queues) {
838             my $new_entry = RT::Queue->new(RT->SystemUser);
839             my ( $return, $msg ) = $new_entry->Create(%$item);
840             unless ( $return ) {
841                 $RT::Logger->error( $msg );
842             } else {
843                 $RT::Logger->debug( $return ."." );
844             }
845         }
846         $RT::Logger->debug("done.");
847     }
848     if ( @CustomFields ) {
849         $RT::Logger->debug("Creating custom fields...");
850         for my $item ( @CustomFields ) {
851             my $new_entry = RT::CustomField->new( RT->SystemUser );
852             my $values    = delete $item->{'Values'};
853
854             my @queues;
855             # if ref then it's list of queues, so we do things ourself
856             if ( exists $item->{'Queue'} && ref $item->{'Queue'} ) {
857                 $item->{'LookupType'} ||= 'RT::Queue-RT::Ticket';
858                 @queues = @{ delete $item->{'Queue'} };
859             }
860
861             if ( $item->{'BasedOn'} ) {
862                 if ( $item->{'LookupType'} ) {
863                     my $basedon = RT::CustomField->new($RT::SystemUser);
864                     my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'},
865                                                             LookupType => $item->{'LookupType'} );
866                     if ($ok) {
867                         $item->{'BasedOn'} = $basedon->Id;
868                     } else {
869                         $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF.  Skipping BasedOn: $msg");
870                         delete $item->{'BasedOn'};
871                     }
872                 } else {
873                     $RT::Logger->error("Unable to load CF $item->{BasedOn} because no LookupType was specified.  Skipping BasedOn");
874                     delete $item->{'BasedOn'};
875                 }
876
877             } 
878
879             my ( $return, $msg ) = $new_entry->Create(%$item);
880             unless( $return ) {
881                 $RT::Logger->error( $msg );
882                 next;
883             }
884
885             foreach my $value ( @{$values} ) {
886                 my ( $return, $msg ) = $new_entry->AddValue(%$value);
887                 $RT::Logger->error( $msg ) unless $return;
888             }
889
890             # apply by default
891             if ( !@queues && !exists $item->{'Queue'} && $item->{LookupType} ) {
892                 my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
893                 $ocf->Create( CustomField => $new_entry->Id );
894             }
895
896             for my $q (@queues) {
897                 my $q_obj = RT::Queue->new(RT->SystemUser);
898                 $q_obj->Load($q);
899                 unless ( $q_obj->Id ) {
900                     $RT::Logger->error("Could not find queue ". $q );
901                     next;
902                 }
903                 my $OCF = RT::ObjectCustomField->new(RT->SystemUser);
904                 ( $return, $msg ) = $OCF->Create(
905                     CustomField => $new_entry->Id,
906                     ObjectId    => $q_obj->Id,
907                 );
908                 $RT::Logger->error( $msg ) unless $return and $OCF->Id;
909             }
910         }
911
912         $RT::Logger->debug("done.");
913     }
914     if ( @ACL ) {
915         $RT::Logger->debug("Creating ACL...");
916         for my $item (@ACL) {
917
918             my ($princ, $object);
919
920             # Global rights or Queue rights?
921             if ( $item->{'CF'} ) {
922                 $object = RT::CustomField->new( RT->SystemUser );
923                 my @columns = ( Name => $item->{'CF'} );
924                 push @columns, Queue => $item->{'Queue'} if $item->{'Queue'} and not ref $item->{'Queue'};
925                 $object->LoadByName( @columns );
926             } elsif ( $item->{'Queue'} ) {
927                 $object = RT::Queue->new(RT->SystemUser);
928                 $object->Load( $item->{'Queue'} );
929             } else {
930                 $object = $RT::System;
931             }
932
933             $RT::Logger->error("Couldn't load object") and next unless $object and $object->Id;
934
935             # Group rights or user rights?
936             if ( $item->{'GroupDomain'} ) {
937                 $princ = RT::Group->new(RT->SystemUser);
938                 if ( $item->{'GroupDomain'} eq 'UserDefined' ) {
939                   $princ->LoadUserDefinedGroup( $item->{'GroupId'} );
940                 } elsif ( $item->{'GroupDomain'} eq 'SystemInternal' ) {
941                   $princ->LoadSystemInternalGroup( $item->{'GroupType'} );
942                 } elsif ( $item->{'GroupDomain'} eq 'RT::System-Role' ) {
943                   $princ->LoadSystemRoleGroup( $item->{'GroupType'} );
944                 } elsif ( $item->{'GroupDomain'} eq 'RT::Queue-Role' &&
945                           $item->{'Queue'} )
946                 {
947                   $princ->LoadQueueRoleGroup( Type => $item->{'GroupType'},
948                                               Queue => $object->id);
949                 } else {
950                   $princ->Load( $item->{'GroupId'} );
951                 }
952                 unless ( $princ->Id ) {
953                     RT->Logger->error("Unable to load Group: GroupDomain => $item->{GroupDomain}, GroupId => $item->{GroupId}, Queue => $item->{Queue}");
954                     next;
955                 }
956             } else {
957                 $princ = RT::User->new(RT->SystemUser);
958                 my ($ok, $msg) = $princ->Load( $item->{'UserId'} );
959                 unless ( $ok ) {
960                     RT->Logger->error("Unable to load user: $item->{UserId} : $msg");
961                     next;
962                 }
963             }
964
965             # Grant it
966             my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
967                 Right => $item->{'Right'},
968                 Object => $object
969             );
970             unless ( $return ) {
971                 $RT::Logger->error( $msg );
972             }
973             else {
974                 $RT::Logger->debug( $return ."." );
975             }
976         }
977         $RT::Logger->debug("done.");
978     }
979
980     if ( @ScripActions ) {
981         $RT::Logger->debug("Creating ScripActions...");
982
983         for my $item (@ScripActions) {
984             my $new_entry = RT::ScripAction->new(RT->SystemUser);
985             my ( $return, $msg ) = $new_entry->Create(%$item);
986             unless ( $return ) {
987                 $RT::Logger->error( $msg );
988             }
989             else {
990                 $RT::Logger->debug( $return ."." );
991             }
992         }
993
994         $RT::Logger->debug("done.");
995     }
996
997     if ( @ScripConditions ) {
998         $RT::Logger->debug("Creating ScripConditions...");
999
1000         for my $item (@ScripConditions) {
1001             my $new_entry = RT::ScripCondition->new(RT->SystemUser);
1002             my ( $return, $msg ) = $new_entry->Create(%$item);
1003             unless ( $return ) {
1004                 $RT::Logger->error( $msg );
1005             }
1006             else {
1007                 $RT::Logger->debug( $return ."." );
1008             }
1009         }
1010
1011         $RT::Logger->debug("done.");
1012     }
1013
1014     if ( @Templates ) {
1015         $RT::Logger->debug("Creating templates...");
1016
1017         for my $item (@Templates) {
1018             my $new_entry = RT::Template->new(RT->SystemUser);
1019             my ( $return, $msg ) = $new_entry->Create(%$item);
1020             unless ( $return ) {
1021                 $RT::Logger->error( $msg );
1022             }
1023             else {
1024                 $RT::Logger->debug( $return ."." );
1025             }
1026         }
1027         $RT::Logger->debug("done.");
1028     }
1029     if ( @Scrips ) {
1030         $RT::Logger->debug("Creating scrips...");
1031
1032         for my $item (@Scrips) {
1033             my $new_entry = RT::Scrip->new(RT->SystemUser);
1034
1035             my @queues = ref $item->{'Queue'} eq 'ARRAY'? @{ $item->{'Queue'} }: $item->{'Queue'} || 0;
1036             push @queues, 0 unless @queues; # add global queue at least
1037
1038             foreach my $q ( @queues ) {
1039                 my ( $return, $msg ) = $new_entry->Create( %$item, Queue => $q );
1040                 unless ( $return ) {
1041                     $RT::Logger->error( $msg );
1042                 }
1043                 else {
1044                     $RT::Logger->debug( $return ."." );
1045                 }
1046             }
1047         }
1048         $RT::Logger->debug("done.");
1049     }
1050     if ( @Attributes ) {
1051         $RT::Logger->debug("Creating attributes...");
1052         my $sys = RT::System->new(RT->SystemUser);
1053
1054         for my $item (@Attributes) {
1055             my $obj = delete $item->{Object}; # XXX: make this something loadable
1056             $obj ||= $sys;
1057             my ( $return, $msg ) = $obj->AddAttribute (%$item);
1058             unless ( $return ) {
1059                 $RT::Logger->error( $msg );
1060             }
1061             else {
1062                 $RT::Logger->debug( $return ."." );
1063             }
1064         }
1065         $RT::Logger->debug("done.");
1066     }
1067     if ( @Final ) {
1068         $RT::Logger->debug("Running final actions...");
1069         for ( @Final ) {
1070             local $@;
1071             eval { $_->(); };
1072             $RT::Logger->error( "Failed to run one of final actions: $@" )
1073                 if $@;
1074         }
1075         $RT::Logger->debug("done.");
1076     }
1077
1078     # XXX: This disconnect doesn't really belong here; it's a relict from when
1079     # this method was extracted from rt-setup-database.  However, too much
1080     # depends on it to change without significant testing.  At the very least,
1081     # we can provide a way to skip the side-effect.
1082     if ( $args{disconnect_after} ) {
1083         my $db_type = RT->Config->Get('DatabaseType');
1084         $RT::Handle->Disconnect() unless $db_type eq 'SQLite';
1085     }
1086
1087     $RT::Logger->debug("Done setting up database content.");
1088
1089 # TODO is it ok to return 1 here? If so, the previous codes in this sub
1090 # should return (0, $msg) if error happens instead of just warning.
1091 # anyway, we need to return something here to tell if everything is ok
1092     return( 1, 'Done inserting data' );
1093 }
1094
1095 =head2 ACLEquivGroupId
1096
1097 Given a userid, return that user's acl equivalence group
1098
1099 =cut
1100
1101 sub ACLEquivGroupId {
1102     my $id = shift;
1103
1104     my $cu = RT->SystemUser;
1105     unless ( $cu ) {
1106         require RT::CurrentUser;
1107         $cu = RT::CurrentUser->new;
1108         $cu->LoadByName('RT_System');
1109         warn "Couldn't load RT_System user" unless $cu->id;
1110     }
1111
1112     my $equiv_group = RT::Group->new( $cu );
1113     $equiv_group->LoadACLEquivalenceGroup( $id );
1114     return $equiv_group->Id;
1115 }
1116
1117 =head2 QueryHistory
1118
1119 Returns the SQL query history associated with this handle. The top level array
1120 represents a lists of request. Each request is a hash with metadata about the
1121 request (such as the URL) and a list of queries. You'll probably not be using this.
1122
1123 =cut
1124
1125 sub QueryHistory {
1126     my $self = shift;
1127
1128     return $self->{QueryHistory};
1129 }
1130
1131 =head2 AddRequestToHistory
1132
1133 Adds a web request to the query history. It must be a hash with keys Path (a
1134 string) and Queries (an array reference of arrays, where elements are time,
1135 sql, bind parameters, and duration).
1136
1137 =cut
1138
1139 sub AddRequestToHistory {
1140     my $self    = shift;
1141     my $request = shift;
1142
1143     push @{ $self->{QueryHistory} }, $request;
1144 }
1145
1146 =head2 Quote
1147
1148 Returns the parameter quoted by DBI. B<You almost certainly do not need this.>
1149 Use bind parameters (C<?>) instead. This is used only outside the scope of interacting
1150 with the database.
1151
1152 =cut
1153
1154 sub Quote {
1155     my $self = shift;
1156     my $value = shift;
1157
1158     return $self->dbh->quote($value);
1159 }
1160
1161 =head2 FillIn
1162
1163 Takes a SQL query and an array reference of bind parameters and fills in the
1164 query's C<?> parameters.
1165
1166 =cut
1167
1168 sub FillIn {
1169     my $self = shift;
1170     my $sql  = shift;
1171     my $bind = shift;
1172
1173     my $b = 0;
1174
1175     # is this regex sufficient?
1176     $sql =~ s{\?}{$self->Quote($bind->[$b++])}eg;
1177
1178     return $sql;
1179 }
1180
1181 # log a mason stack trace instead of a Carp::longmess because it's less painful
1182 # and uses mason component paths properly
1183 sub _LogSQLStatement {
1184     my $self = shift;
1185     my $statement = shift;
1186     my $duration = shift;
1187     my @bind = @_;
1188
1189     require HTML::Mason::Exceptions;
1190     push @{$self->{'StatementLog'}} , ([Time::HiRes::time(), $statement, [@bind], $duration, HTML::Mason::Exception->new->as_string]);
1191 }
1192
1193 __PACKAGE__->FinalizeDatabaseType;
1194
1195 RT::Base->_ImportOverlays();
1196
1197 1;