]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
403d7b0b | 5 | # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC |
84fb5b46 MKG |
6 | # <sales@bestpractical.com> |
7 | # | |
8 | # (Except where explicitly superseded by other copyright notices) | |
9 | # | |
10 | # | |
11 | # LICENSE: | |
12 | # | |
13 | # This work is made available to you under the terms of Version 2 of | |
14 | # the GNU General Public License. A copy of that license should have | |
15 | # been provided with this software, but in any event can be snarfed | |
16 | # from www.gnu.org. | |
17 | # | |
18 | # This work is distributed in the hope that it will be useful, but | |
19 | # WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
21 | # General Public License for more details. | |
22 | # | |
23 | # You should have received a copy of the GNU General Public License | |
24 | # along with this program; if not, write to the Free Software | |
25 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
26 | # 02110-1301 or visit their web page on the internet at | |
27 | # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. | |
28 | # | |
29 | # | |
30 | # CONTRIBUTION SUBMISSION POLICY: | |
31 | # | |
32 | # (The following paragraph is not intended to limit the rights granted | |
33 | # to you to modify and distribute this software under the terms of | |
34 | # the GNU General Public License and is only of importance to you if | |
35 | # you choose to contribute your changes and enhancements to the | |
36 | # community by submitting them to Best Practical Solutions, LLC.) | |
37 | # | |
38 | # By intentionally submitting any modifications, corrections or | |
39 | # derivatives to this work, or any other work intended for use with | |
40 | # Request Tracker, to Best Practical Solutions, LLC, you confirm that | |
41 | # you are the copyright holder for those contributions and you grant | |
42 | # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, | |
43 | # royalty-free, perpetual, license to use, copy, create derivative | |
44 | # works based on those contributions, and sublicense and distribute | |
45 | # those contributions and any derivatives thereof. | |
46 | # | |
47 | # END BPS TAGGED BLOCK }}} | |
48 | ||
49 | =head1 NAME | |
50 | ||
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; | |
c36a7e1d MKG |
581 | } |
582 | ||
583 | sub version_words { | |
584 | return keys %word; | |
585 | } | |
586 | ||
587 | } | |
84fb5b46 MKG |
588 | |
589 | ||
590 | =head2 InsertInitialData | |
591 | ||
592 | Inserts system objects into RT's DB, like system user or 'nobody', | |
593 | internal groups and other records required. However, this method | |
594 | doesn't insert any real users like 'root' and you have to use | |
595 | InsertData or another way to do that. | |
596 | ||
597 | Takes no arguments. Returns status and message tuple. | |
598 | ||
599 | It's safe to call this method even if those objects already exist. | |
600 | ||
601 | =cut | |
602 | ||
603 | sub InsertInitialData { | |
604 | my $self = shift; | |
605 | ||
606 | my @warns; | |
607 | ||
608 | # create RT_System user and grant him rights | |
609 | { | |
610 | require RT::CurrentUser; | |
611 | ||
612 | my $test_user = RT::User->new( RT::CurrentUser->new() ); | |
613 | $test_user->Load('RT_System'); | |
614 | if ( $test_user->id ) { | |
615 | push @warns, "Found system user in the DB."; | |
616 | } | |
617 | else { | |
618 | my $user = RT::User->new( RT::CurrentUser->new() ); | |
619 | my ( $val, $msg ) = $user->_BootstrapCreate( | |
620 | Name => 'RT_System', | |
621 | RealName => 'The RT System itself', | |
622 | Comments => 'Do not delete or modify this user. ' | |
623 | . 'It is integral to RT\'s internal database structures', | |
624 | Creator => '1', | |
625 | LastUpdatedBy => '1', | |
626 | ); | |
627 | return ($val, $msg) unless $val; | |
628 | } | |
629 | DBIx::SearchBuilder::Record::Cachable->FlushCache; | |
630 | } | |
631 | ||
632 | # init RT::SystemUser and RT::System objects | |
633 | RT::InitSystemObjects(); | |
634 | unless ( RT->SystemUser->id ) { | |
635 | return (0, "Couldn't load system user"); | |
636 | } | |
637 | ||
638 | # grant SuperUser right to system user | |
639 | { | |
640 | my $test_ace = RT::ACE->new( RT->SystemUser ); | |
641 | $test_ace->LoadByCols( | |
642 | PrincipalId => ACLEquivGroupId( RT->SystemUser->Id ), | |
643 | PrincipalType => 'Group', | |
644 | RightName => 'SuperUser', | |
645 | ObjectType => 'RT::System', | |
646 | ObjectId => 1, | |
647 | ); | |
648 | if ( $test_ace->id ) { | |
649 | push @warns, "System user has global SuperUser right."; | |
650 | } else { | |
651 | my $ace = RT::ACE->new( RT->SystemUser ); | |
652 | my ( $val, $msg ) = $ace->_BootstrapCreate( | |
653 | PrincipalId => ACLEquivGroupId( RT->SystemUser->Id ), | |
654 | PrincipalType => 'Group', | |
655 | RightName => 'SuperUser', | |
656 | ObjectType => 'RT::System', | |
657 | ObjectId => 1, | |
658 | ); | |
659 | return ($val, $msg) unless $val; | |
660 | } | |
661 | DBIx::SearchBuilder::Record::Cachable->FlushCache; | |
662 | } | |
663 | ||
664 | # system groups | |
665 | # $self->loc('Everyone'); # For the string extractor to get a string to localize | |
666 | # $self->loc('Privileged'); # For the string extractor to get a string to localize | |
667 | # $self->loc('Unprivileged'); # For the string extractor to get a string to localize | |
668 | foreach my $name (qw(Everyone Privileged Unprivileged)) { | |
669 | my $group = RT::Group->new( RT->SystemUser ); | |
670 | $group->LoadSystemInternalGroup( $name ); | |
671 | if ( $group->id ) { | |
672 | push @warns, "System group '$name' already exists."; | |
673 | next; | |
674 | } | |
675 | ||
676 | $group = RT::Group->new( RT->SystemUser ); | |
677 | my ( $val, $msg ) = $group->_Create( | |
678 | Type => $name, | |
679 | Domain => 'SystemInternal', | |
680 | Description => 'Pseudogroup for internal use', # loc | |
681 | Name => '', | |
682 | Instance => '', | |
683 | ); | |
684 | return ($val, $msg) unless $val; | |
685 | } | |
686 | ||
687 | # nobody | |
688 | { | |
689 | my $user = RT::User->new( RT->SystemUser ); | |
690 | $user->Load('Nobody'); | |
691 | if ( $user->id ) { | |
692 | push @warns, "Found 'Nobody' user in the DB."; | |
693 | } | |
694 | else { | |
695 | my ( $val, $msg ) = $user->Create( | |
696 | Name => 'Nobody', | |
697 | RealName => 'Nobody in particular', | |
698 | Comments => 'Do not delete or modify this user. It is integral ' | |
699 | .'to RT\'s internal data structures', | |
700 | Privileged => 0, | |
701 | ); | |
702 | return ($val, $msg) unless $val; | |
703 | } | |
704 | ||
705 | if ( $user->HasRight( Right => 'OwnTicket', Object => $RT::System ) ) { | |
706 | push @warns, "User 'Nobody' has global OwnTicket right."; | |
707 | } else { | |
708 | my ( $val, $msg ) = $user->PrincipalObj->GrantRight( | |
709 | Right => 'OwnTicket', | |
710 | Object => $RT::System, | |
711 | ); | |
712 | return ($val, $msg) unless $val; | |
713 | } | |
714 | } | |
715 | ||
716 | # rerun to get init Nobody as well | |
717 | RT::InitSystemObjects(); | |
718 | ||
719 | # system role groups | |
720 | foreach my $name (qw(Owner Requestor Cc AdminCc)) { | |
721 | my $group = RT::Group->new( RT->SystemUser ); | |
722 | $group->LoadSystemRoleGroup( $name ); | |
723 | if ( $group->id ) { | |
724 | push @warns, "System role '$name' already exists."; | |
725 | next; | |
726 | } | |
727 | ||
728 | $group = RT::Group->new( RT->SystemUser ); | |
729 | my ( $val, $msg ) = $group->_Create( | |
730 | Type => $name, | |
731 | Domain => 'RT::System-Role', | |
732 | Description => 'SystemRolegroup for internal use', # loc | |
733 | Name => '', | |
734 | Instance => '', | |
735 | ); | |
736 | return ($val, $msg) unless $val; | |
737 | } | |
738 | ||
739 | push @warns, "You appear to have a functional RT database." | |
740 | if @warns; | |
741 | ||
742 | return (1, join "\n", @warns); | |
743 | } | |
744 | ||
745 | =head2 InsertData | |
746 | ||
747 | Load some sort of data into the database, takes path to a file. | |
748 | ||
749 | =cut | |
750 | ||
751 | sub InsertData { | |
752 | my $self = shift; | |
753 | my $datafile = shift; | |
754 | my $root_password = shift; | |
b5747ff2 MKG |
755 | my %args = ( |
756 | disconnect_after => 1, | |
757 | @_ | |
758 | ); | |
84fb5b46 MKG |
759 | |
760 | # Slurp in stuff to insert from the datafile. Possible things to go in here:- | |
761 | our (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions, | |
762 | @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final); | |
763 | local (@Groups, @Users, @ACL, @Queues, @ScripActions, @ScripConditions, | |
764 | @Templates, @CustomFields, @Scrips, @Attributes, @Initial, @Final); | |
765 | ||
766 | local $@; | |
767 | $RT::Logger->debug("Going to load '$datafile' data file"); | |
768 | eval { require $datafile } | |
769 | or return (0, "Couldn't load data from '$datafile' for import:\n\nERROR:". $@); | |
770 | ||
771 | if ( @Initial ) { | |
772 | $RT::Logger->debug("Running initial actions..."); | |
773 | foreach ( @Initial ) { | |
774 | local $@; | |
775 | eval { $_->(); 1 } or return (0, "One of initial functions failed: $@"); | |
776 | } | |
777 | $RT::Logger->debug("Done."); | |
778 | } | |
779 | if ( @Groups ) { | |
780 | $RT::Logger->debug("Creating groups..."); | |
781 | foreach my $item (@Groups) { | |
782 | my $new_entry = RT::Group->new( RT->SystemUser ); | |
783 | my $member_of = delete $item->{'MemberOf'}; | |
784 | my ( $return, $msg ) = $new_entry->_Create(%$item); | |
785 | unless ( $return ) { | |
786 | $RT::Logger->error( $msg ); | |
787 | next; | |
788 | } else { | |
789 | $RT::Logger->debug($return ."."); | |
790 | } | |
791 | if ( $member_of ) { | |
792 | $member_of = [ $member_of ] unless ref $member_of eq 'ARRAY'; | |
793 | foreach( @$member_of ) { | |
794 | my $parent = RT::Group->new(RT->SystemUser); | |
795 | if ( ref $_ eq 'HASH' ) { | |
796 | $parent->LoadByCols( %$_ ); | |
797 | } | |
798 | elsif ( !ref $_ ) { | |
799 | $parent->LoadUserDefinedGroup( $_ ); | |
800 | } | |
801 | else { | |
802 | $RT::Logger->error( | |
803 | "(Error: wrong format of MemberOf field." | |
804 | ." Should be name of user defined group or" | |
805 | ." hash reference with 'column => value' pairs." | |
806 | ." Use array reference to add to multiple groups)" | |
807 | ); | |
808 | next; | |
809 | } | |
810 | unless ( $parent->Id ) { | |
811 | $RT::Logger->error("(Error: couldn't load group to add member)"); | |
812 | next; | |
813 | } | |
814 | my ( $return, $msg ) = $parent->AddMember( $new_entry->Id ); | |
815 | unless ( $return ) { | |
816 | $RT::Logger->error( $msg ); | |
817 | } else { | |
818 | $RT::Logger->debug( $return ."." ); | |
819 | } | |
820 | } | |
821 | } | |
822 | } | |
823 | $RT::Logger->debug("done."); | |
824 | } | |
825 | if ( @Users ) { | |
826 | $RT::Logger->debug("Creating users..."); | |
827 | foreach my $item (@Users) { | |
828 | if ( $item->{'Name'} eq 'root' && $root_password ) { | |
829 | $item->{'Password'} = $root_password; | |
830 | } | |
831 | my $new_entry = RT::User->new( RT->SystemUser ); | |
832 | my ( $return, $msg ) = $new_entry->Create(%$item); | |
833 | unless ( $return ) { | |
834 | $RT::Logger->error( $msg ); | |
835 | } else { | |
836 | $RT::Logger->debug( $return ."." ); | |
837 | } | |
838 | } | |
839 | $RT::Logger->debug("done."); | |
840 | } | |
841 | if ( @Queues ) { | |
842 | $RT::Logger->debug("Creating queues..."); | |
843 | for my $item (@Queues) { | |
844 | my $new_entry = RT::Queue->new(RT->SystemUser); | |
845 | my ( $return, $msg ) = $new_entry->Create(%$item); | |
846 | unless ( $return ) { | |
847 | $RT::Logger->error( $msg ); | |
848 | } else { | |
849 | $RT::Logger->debug( $return ."." ); | |
850 | } | |
851 | } | |
852 | $RT::Logger->debug("done."); | |
853 | } | |
854 | if ( @CustomFields ) { | |
855 | $RT::Logger->debug("Creating custom fields..."); | |
856 | for my $item ( @CustomFields ) { | |
857 | my $new_entry = RT::CustomField->new( RT->SystemUser ); | |
858 | my $values = delete $item->{'Values'}; | |
859 | ||
860 | my @queues; | |
861 | # if ref then it's list of queues, so we do things ourself | |
862 | if ( exists $item->{'Queue'} && ref $item->{'Queue'} ) { | |
863 | $item->{'LookupType'} ||= 'RT::Queue-RT::Ticket'; | |
864 | @queues = @{ delete $item->{'Queue'} }; | |
865 | } | |
866 | ||
84fb5b46 | 867 | if ( $item->{'BasedOn'} ) { |
dab09ea8 MKG |
868 | if ( $item->{'LookupType'} ) { |
869 | my $basedon = RT::CustomField->new($RT::SystemUser); | |
870 | my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'}, | |
871 | LookupType => $item->{'LookupType'} ); | |
84fb5b46 | 872 | if ($ok) { |
dab09ea8 | 873 | $item->{'BasedOn'} = $basedon->Id; |
84fb5b46 | 874 | } else { |
dab09ea8 MKG |
875 | $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF. Skipping BasedOn: $msg"); |
876 | delete $item->{'BasedOn'}; | |
84fb5b46 MKG |
877 | } |
878 | } else { | |
dab09ea8 MKG |
879 | $RT::Logger->error("Unable to load CF $item->{BasedOn} because no LookupType was specified. Skipping BasedOn"); |
880 | delete $item->{'BasedOn'}; | |
84fb5b46 | 881 | } |
dab09ea8 MKG |
882 | |
883 | } | |
884 | ||
885 | my ( $return, $msg ) = $new_entry->Create(%$item); | |
886 | unless( $return ) { | |
887 | $RT::Logger->error( $msg ); | |
888 | next; | |
84fb5b46 MKG |
889 | } |
890 | ||
891 | foreach my $value ( @{$values} ) { | |
892 | my ( $return, $msg ) = $new_entry->AddValue(%$value); | |
893 | $RT::Logger->error( $msg ) unless $return; | |
894 | } | |
895 | ||
896 | # apply by default | |
897 | if ( !@queues && !exists $item->{'Queue'} && $item->{LookupType} ) { | |
898 | my $ocf = RT::ObjectCustomField->new(RT->SystemUser); | |
899 | $ocf->Create( CustomField => $new_entry->Id ); | |
900 | } | |
901 | ||
902 | for my $q (@queues) { | |
903 | my $q_obj = RT::Queue->new(RT->SystemUser); | |
904 | $q_obj->Load($q); | |
905 | unless ( $q_obj->Id ) { | |
906 | $RT::Logger->error("Could not find queue ". $q ); | |
907 | next; | |
908 | } | |
909 | my $OCF = RT::ObjectCustomField->new(RT->SystemUser); | |
910 | ( $return, $msg ) = $OCF->Create( | |
911 | CustomField => $new_entry->Id, | |
912 | ObjectId => $q_obj->Id, | |
913 | ); | |
914 | $RT::Logger->error( $msg ) unless $return and $OCF->Id; | |
915 | } | |
916 | } | |
917 | ||
918 | $RT::Logger->debug("done."); | |
919 | } | |
920 | if ( @ACL ) { | |
921 | $RT::Logger->debug("Creating ACL..."); | |
922 | for my $item (@ACL) { | |
923 | ||
924 | my ($princ, $object); | |
925 | ||
926 | # Global rights or Queue rights? | |
927 | if ( $item->{'CF'} ) { | |
928 | $object = RT::CustomField->new( RT->SystemUser ); | |
929 | my @columns = ( Name => $item->{'CF'} ); | |
930 | push @columns, Queue => $item->{'Queue'} if $item->{'Queue'} and not ref $item->{'Queue'}; | |
931 | $object->LoadByName( @columns ); | |
932 | } elsif ( $item->{'Queue'} ) { | |
933 | $object = RT::Queue->new(RT->SystemUser); | |
934 | $object->Load( $item->{'Queue'} ); | |
935 | } else { | |
936 | $object = $RT::System; | |
937 | } | |
938 | ||
939 | $RT::Logger->error("Couldn't load object") and next unless $object and $object->Id; | |
940 | ||
941 | # Group rights or user rights? | |
942 | if ( $item->{'GroupDomain'} ) { | |
943 | $princ = RT::Group->new(RT->SystemUser); | |
944 | if ( $item->{'GroupDomain'} eq 'UserDefined' ) { | |
945 | $princ->LoadUserDefinedGroup( $item->{'GroupId'} ); | |
946 | } elsif ( $item->{'GroupDomain'} eq 'SystemInternal' ) { | |
947 | $princ->LoadSystemInternalGroup( $item->{'GroupType'} ); | |
948 | } elsif ( $item->{'GroupDomain'} eq 'RT::System-Role' ) { | |
949 | $princ->LoadSystemRoleGroup( $item->{'GroupType'} ); | |
950 | } elsif ( $item->{'GroupDomain'} eq 'RT::Queue-Role' && | |
951 | $item->{'Queue'} ) | |
952 | { | |
953 | $princ->LoadQueueRoleGroup( Type => $item->{'GroupType'}, | |
954 | Queue => $object->id); | |
955 | } else { | |
956 | $princ->Load( $item->{'GroupId'} ); | |
957 | } | |
958 | unless ( $princ->Id ) { | |
959 | RT->Logger->error("Unable to load Group: GroupDomain => $item->{GroupDomain}, GroupId => $item->{GroupId}, Queue => $item->{Queue}"); | |
960 | next; | |
961 | } | |
962 | } else { | |
963 | $princ = RT::User->new(RT->SystemUser); | |
964 | my ($ok, $msg) = $princ->Load( $item->{'UserId'} ); | |
965 | unless ( $ok ) { | |
966 | RT->Logger->error("Unable to load user: $item->{UserId} : $msg"); | |
967 | next; | |
968 | } | |
969 | } | |
970 | ||
971 | # Grant it | |
972 | my ( $return, $msg ) = $princ->PrincipalObj->GrantRight( | |
973 | Right => $item->{'Right'}, | |
974 | Object => $object | |
975 | ); | |
976 | unless ( $return ) { | |
977 | $RT::Logger->error( $msg ); | |
978 | } | |
979 | else { | |
980 | $RT::Logger->debug( $return ."." ); | |
981 | } | |
982 | } | |
983 | $RT::Logger->debug("done."); | |
984 | } | |
985 | ||
986 | if ( @ScripActions ) { | |
987 | $RT::Logger->debug("Creating ScripActions..."); | |
988 | ||
989 | for my $item (@ScripActions) { | |
990 | my $new_entry = RT::ScripAction->new(RT->SystemUser); | |
991 | my ( $return, $msg ) = $new_entry->Create(%$item); | |
992 | unless ( $return ) { | |
993 | $RT::Logger->error( $msg ); | |
994 | } | |
995 | else { | |
996 | $RT::Logger->debug( $return ."." ); | |
997 | } | |
998 | } | |
999 | ||
1000 | $RT::Logger->debug("done."); | |
1001 | } | |
1002 | ||
1003 | if ( @ScripConditions ) { | |
1004 | $RT::Logger->debug("Creating ScripConditions..."); | |
1005 | ||
1006 | for my $item (@ScripConditions) { | |
1007 | my $new_entry = RT::ScripCondition->new(RT->SystemUser); | |
1008 | my ( $return, $msg ) = $new_entry->Create(%$item); | |
1009 | unless ( $return ) { | |
1010 | $RT::Logger->error( $msg ); | |
1011 | } | |
1012 | else { | |
1013 | $RT::Logger->debug( $return ."." ); | |
1014 | } | |
1015 | } | |
1016 | ||
1017 | $RT::Logger->debug("done."); | |
1018 | } | |
1019 | ||
1020 | if ( @Templates ) { | |
1021 | $RT::Logger->debug("Creating templates..."); | |
1022 | ||
1023 | for my $item (@Templates) { | |
1024 | my $new_entry = RT::Template->new(RT->SystemUser); | |
1025 | my ( $return, $msg ) = $new_entry->Create(%$item); | |
1026 | unless ( $return ) { | |
1027 | $RT::Logger->error( $msg ); | |
1028 | } | |
1029 | else { | |
1030 | $RT::Logger->debug( $return ."." ); | |
1031 | } | |
1032 | } | |
1033 | $RT::Logger->debug("done."); | |
1034 | } | |
1035 | if ( @Scrips ) { | |
1036 | $RT::Logger->debug("Creating scrips..."); | |
1037 | ||
1038 | for my $item (@Scrips) { | |
1039 | my $new_entry = RT::Scrip->new(RT->SystemUser); | |
1040 | ||
1041 | my @queues = ref $item->{'Queue'} eq 'ARRAY'? @{ $item->{'Queue'} }: $item->{'Queue'} || 0; | |
1042 | push @queues, 0 unless @queues; # add global queue at least | |
1043 | ||
1044 | foreach my $q ( @queues ) { | |
1045 | my ( $return, $msg ) = $new_entry->Create( %$item, Queue => $q ); | |
1046 | unless ( $return ) { | |
1047 | $RT::Logger->error( $msg ); | |
1048 | } | |
1049 | else { | |
1050 | $RT::Logger->debug( $return ."." ); | |
1051 | } | |
1052 | } | |
1053 | } | |
1054 | $RT::Logger->debug("done."); | |
1055 | } | |
1056 | if ( @Attributes ) { | |
1057 | $RT::Logger->debug("Creating attributes..."); | |
1058 | my $sys = RT::System->new(RT->SystemUser); | |
1059 | ||
1060 | for my $item (@Attributes) { | |
1061 | my $obj = delete $item->{Object}; # XXX: make this something loadable | |
1062 | $obj ||= $sys; | |
1063 | my ( $return, $msg ) = $obj->AddAttribute (%$item); | |
1064 | unless ( $return ) { | |
1065 | $RT::Logger->error( $msg ); | |
1066 | } | |
1067 | else { | |
1068 | $RT::Logger->debug( $return ."." ); | |
1069 | } | |
1070 | } | |
1071 | $RT::Logger->debug("done."); | |
1072 | } | |
1073 | if ( @Final ) { | |
1074 | $RT::Logger->debug("Running final actions..."); | |
1075 | for ( @Final ) { | |
1076 | local $@; | |
1077 | eval { $_->(); }; | |
1078 | $RT::Logger->error( "Failed to run one of final actions: $@" ) | |
1079 | if $@; | |
1080 | } | |
1081 | $RT::Logger->debug("done."); | |
1082 | } | |
1083 | ||
b5747ff2 MKG |
1084 | # XXX: This disconnect doesn't really belong here; it's a relict from when |
1085 | # this method was extracted from rt-setup-database. However, too much | |
1086 | # depends on it to change without significant testing. At the very least, | |
1087 | # we can provide a way to skip the side-effect. | |
1088 | if ( $args{disconnect_after} ) { | |
1089 | my $db_type = RT->Config->Get('DatabaseType'); | |
1090 | $RT::Handle->Disconnect() unless $db_type eq 'SQLite'; | |
1091 | } | |
84fb5b46 MKG |
1092 | |
1093 | $RT::Logger->debug("Done setting up database content."); | |
1094 | ||
1095 | # TODO is it ok to return 1 here? If so, the previous codes in this sub | |
1096 | # should return (0, $msg) if error happens instead of just warning. | |
1097 | # anyway, we need to return something here to tell if everything is ok | |
1098 | return( 1, 'Done inserting data' ); | |
1099 | } | |
1100 | ||
1101 | =head2 ACLEquivGroupId | |
1102 | ||
1103 | Given a userid, return that user's acl equivalence group | |
1104 | ||
1105 | =cut | |
1106 | ||
1107 | sub ACLEquivGroupId { | |
1108 | my $id = shift; | |
1109 | ||
1110 | my $cu = RT->SystemUser; | |
1111 | unless ( $cu ) { | |
1112 | require RT::CurrentUser; | |
1113 | $cu = RT::CurrentUser->new; | |
1114 | $cu->LoadByName('RT_System'); | |
1115 | warn "Couldn't load RT_System user" unless $cu->id; | |
1116 | } | |
1117 | ||
1118 | my $equiv_group = RT::Group->new( $cu ); | |
1119 | $equiv_group->LoadACLEquivalenceGroup( $id ); | |
1120 | return $equiv_group->Id; | |
1121 | } | |
1122 | ||
1123 | =head2 QueryHistory | |
1124 | ||
1125 | Returns the SQL query history associated with this handle. The top level array | |
1126 | represents a lists of request. Each request is a hash with metadata about the | |
1127 | request (such as the URL) and a list of queries. You'll probably not be using this. | |
1128 | ||
1129 | =cut | |
1130 | ||
1131 | sub QueryHistory { | |
1132 | my $self = shift; | |
1133 | ||
1134 | return $self->{QueryHistory}; | |
1135 | } | |
1136 | ||
1137 | =head2 AddRequestToHistory | |
1138 | ||
1139 | Adds a web request to the query history. It must be a hash with keys Path (a | |
1140 | string) and Queries (an array reference of arrays, where elements are time, | |
1141 | sql, bind parameters, and duration). | |
1142 | ||
1143 | =cut | |
1144 | ||
1145 | sub AddRequestToHistory { | |
1146 | my $self = shift; | |
1147 | my $request = shift; | |
1148 | ||
1149 | push @{ $self->{QueryHistory} }, $request; | |
1150 | } | |
1151 | ||
1152 | =head2 Quote | |
1153 | ||
1154 | Returns the parameter quoted by DBI. B<You almost certainly do not need this.> | |
1155 | Use bind parameters (C<?>) instead. This is used only outside the scope of interacting | |
1156 | with the database. | |
1157 | ||
1158 | =cut | |
1159 | ||
1160 | sub Quote { | |
1161 | my $self = shift; | |
1162 | my $value = shift; | |
1163 | ||
1164 | return $self->dbh->quote($value); | |
1165 | } | |
1166 | ||
1167 | =head2 FillIn | |
1168 | ||
1169 | Takes a SQL query and an array reference of bind parameters and fills in the | |
1170 | query's C<?> parameters. | |
1171 | ||
1172 | =cut | |
1173 | ||
1174 | sub FillIn { | |
1175 | my $self = shift; | |
1176 | my $sql = shift; | |
1177 | my $bind = shift; | |
1178 | ||
1179 | my $b = 0; | |
1180 | ||
1181 | # is this regex sufficient? | |
1182 | $sql =~ s{\?}{$self->Quote($bind->[$b++])}eg; | |
1183 | ||
1184 | return $sql; | |
1185 | } | |
1186 | ||
1187 | # log a mason stack trace instead of a Carp::longmess because it's less painful | |
1188 | # and uses mason component paths properly | |
1189 | sub _LogSQLStatement { | |
1190 | my $self = shift; | |
1191 | my $statement = shift; | |
1192 | my $duration = shift; | |
1193 | my @bind = @_; | |
1194 | ||
1195 | require HTML::Mason::Exceptions; | |
1196 | push @{$self->{'StatementLog'}} , ([Time::HiRes::time(), $statement, [@bind], $duration, HTML::Mason::Exception->new->as_string]); | |
1197 | } | |
1198 | ||
1199 | __PACKAGE__->FinalizeDatabaseType; | |
1200 | ||
1201 | RT::Base->_ImportOverlays(); | |
1202 | ||
1203 | 1; |