]>
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 | use strict; | |
50 | use warnings; | |
51 | ||
52 | package RT; | |
53 | ||
54 | ||
55 | use File::Spec (); | |
56 | use Cwd (); | |
57 | ||
58 | use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE); | |
59 | ||
60 | use vars qw($BasePath | |
61 | $EtcPath | |
62 | $BinPath | |
63 | $SbinPath | |
64 | $VarPath | |
65 | $LexiconPath | |
66 | $PluginPath | |
67 | $LocalPath | |
68 | $LocalEtcPath | |
69 | $LocalLibPath | |
70 | $LocalLexiconPath | |
71 | $LocalPluginPath | |
72 | $MasonComponentRoot | |
73 | $MasonLocalComponentRoot | |
74 | $MasonDataDir | |
75 | $MasonSessionDir); | |
76 | ||
77 | ||
78 | RT->LoadGeneratedData(); | |
79 | ||
80 | =head1 NAME | |
81 | ||
82 | RT - Request Tracker | |
83 | ||
84 | =head1 SYNOPSIS | |
85 | ||
86 | A fully featured request tracker package | |
87 | ||
88 | =head1 DESCRIPTION | |
89 | ||
90 | =head2 INITIALIZATION | |
91 | ||
92 | =head2 LoadConfig | |
93 | ||
94 | Load RT's config file. First, the site configuration file | |
95 | (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site | |
96 | settings like hostname and name of RT instance. Then, the core | |
97 | configuration file (F<RT_Config.pm>) is loaded to set fallback values | |
98 | for all settings; it bases some values on settings from the site | |
99 | configuration file. | |
100 | ||
101 | In order for the core configuration to not override the site's | |
102 | settings, the function C<Set> is used; it only sets values if they | |
103 | have not been set already. | |
104 | ||
105 | =cut | |
106 | ||
107 | sub LoadConfig { | |
108 | require RT::Config; | |
109 | $Config = RT::Config->new; | |
110 | $Config->LoadConfigs; | |
111 | require RT::I18N; | |
112 | ||
113 | # RT::Essentials mistakenly recommends that WebPath be set to '/'. | |
114 | # If the user does that, do what they mean. | |
115 | $RT::WebPath = '' if ($RT::WebPath eq '/'); | |
116 | ||
117 | # fix relative LogDir and GnuPG homedir | |
118 | unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) { | |
119 | $Config->Set( LogDir => | |
120 | File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) ); | |
121 | } | |
122 | ||
123 | my $gpgopts = $Config->Get('GnuPGOptions'); | |
124 | unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) { | |
125 | $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} ); | |
126 | } | |
127 | ||
128 | return $Config; | |
129 | } | |
130 | ||
131 | =head2 Init | |
132 | ||
133 | L<Connects to the database|/ConnectToDatabase>, L<initilizes system | |
134 | objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets | |
135 | up logging|/InitLogging>, and L<loads plugins|/InitPlugins>. | |
136 | ||
137 | =cut | |
138 | ||
139 | sub Init { | |
140 | ||
141 | CheckPerlRequirements(); | |
142 | ||
143 | InitPluginPaths(); | |
144 | ||
145 | #Get a database connection | |
146 | ConnectToDatabase(); | |
147 | InitSystemObjects(); | |
148 | InitClasses(); | |
149 | InitLogging(); | |
150 | InitPlugins(); | |
151 | RT::I18N->Init; | |
152 | RT->Config->PostLoadCheck; | |
153 | ||
154 | } | |
155 | ||
156 | =head2 ConnectToDatabase | |
157 | ||
158 | Get a database connection. See also L</Handle>. | |
159 | ||
160 | =cut | |
161 | ||
162 | sub ConnectToDatabase { | |
163 | require RT::Handle; | |
164 | $Handle = RT::Handle->new unless $Handle; | |
165 | $Handle->Connect; | |
166 | return $Handle; | |
167 | } | |
168 | ||
169 | =head2 InitLogging | |
170 | ||
171 | Create the Logger object and set up signal handlers. | |
172 | ||
173 | =cut | |
174 | ||
175 | sub InitLogging { | |
176 | ||
177 | # We have to set the record separator ($, man perlvar) | |
178 | # or Log::Dispatch starts getting | |
179 | # really pissy, as some other module we use unsets it. | |
180 | $, = ''; | |
181 | use Log::Dispatch 1.6; | |
182 | ||
183 | my %level_to_num = ( | |
184 | map( { $_ => } 0..7 ), | |
185 | debug => 0, | |
186 | info => 1, | |
187 | notice => 2, | |
188 | warning => 3, | |
189 | error => 4, 'err' => 4, | |
190 | critical => 5, crit => 5, | |
191 | alert => 6, | |
192 | emergency => 7, emerg => 7, | |
193 | ); | |
194 | ||
195 | unless ( $RT::Logger ) { | |
196 | ||
197 | $RT::Logger = Log::Dispatch->new; | |
198 | ||
199 | my $stack_from_level; | |
200 | if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) { | |
201 | # if option has old style '\d'(true) value | |
202 | $stack_from_level = 0 if $stack_from_level =~ /^\d+$/; | |
203 | $stack_from_level = $level_to_num{ $stack_from_level } || 0; | |
204 | } else { | |
205 | $stack_from_level = 99; # don't log | |
206 | } | |
207 | ||
208 | my $simple_cb = sub { | |
209 | # if this code throw any warning we can get segfault | |
210 | no warnings; | |
211 | my %p = @_; | |
212 | ||
213 | # skip Log::* stack frames | |
214 | my $frame = 0; | |
215 | $frame++ while caller($frame) && caller($frame) =~ /^Log::/; | |
216 | my ($package, $filename, $line) = caller($frame); | |
217 | ||
218 | $p{'message'} =~ s/(?:\r*\n)+$//; | |
219 | return "[". gmtime(time) ."] [". $p{'level'} ."]: " | |
220 | . $p{'message'} ." ($filename:$line)\n"; | |
221 | }; | |
222 | ||
223 | my $syslog_cb = sub { | |
224 | # if this code throw any warning we can get segfault | |
225 | no warnings; | |
226 | my %p = @_; | |
227 | ||
228 | my $frame = 0; # stack frame index | |
229 | # skip Log::* stack frames | |
230 | $frame++ while caller($frame) && caller($frame) =~ /^Log::/; | |
231 | my ($package, $filename, $line) = caller($frame); | |
232 | ||
233 | # syswrite() cannot take utf8; turn it off here. | |
234 | Encode::_utf8_off($p{message}); | |
235 | ||
236 | $p{message} =~ s/(?:\r*\n)+$//; | |
237 | if ($p{level} eq 'debug') { | |
238 | return "$p{message}\n"; | |
239 | } else { | |
240 | return "$p{message} ($filename:$line)\n"; | |
241 | } | |
242 | }; | |
243 | ||
244 | my $stack_cb = sub { | |
245 | no warnings; | |
246 | my %p = @_; | |
247 | return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level; | |
248 | ||
249 | require Devel::StackTrace; | |
250 | my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] ); | |
251 | return $p{'message'} . $trace->as_string; | |
252 | ||
253 | # skip calling of the Log::* subroutins | |
254 | my $frame = 0; | |
255 | $frame++ while caller($frame) && caller($frame) =~ /^Log::/; | |
256 | $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/; | |
257 | ||
258 | $p{'message'} .= "\nStack trace:\n"; | |
259 | while( my ($package, $filename, $line, $sub) = caller($frame++) ) { | |
260 | $p{'message'} .= "\t$sub(...) called at $filename:$line\n"; | |
261 | } | |
262 | return $p{'message'}; | |
263 | }; | |
264 | ||
265 | if ( $Config->Get('LogToFile') ) { | |
266 | my ($filename, $logdir) = ( | |
267 | $Config->Get('LogToFileNamed') || 'rt.log', | |
268 | $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ), | |
269 | ); | |
270 | if ( $filename =~ m![/\\]! ) { # looks like an absolute path. | |
271 | ($logdir) = $filename =~ m{^(.*[/\\])}; | |
272 | } | |
273 | else { | |
274 | $filename = File::Spec->catfile( $logdir, $filename ); | |
275 | } | |
276 | ||
277 | unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) { | |
278 | # localizing here would be hard when we don't have a current user yet | |
279 | die "Log file '$filename' couldn't be written or created.\n RT can't run."; | |
280 | } | |
281 | ||
282 | require Log::Dispatch::File; | |
283 | $RT::Logger->add( Log::Dispatch::File->new | |
284 | ( name=>'file', | |
285 | min_level=> $Config->Get('LogToFile'), | |
286 | filename=> $filename, | |
287 | mode=>'append', | |
288 | callbacks => [ $simple_cb, $stack_cb ], | |
289 | )); | |
290 | } | |
291 | if ( $Config->Get('LogToScreen') ) { | |
292 | require Log::Dispatch::Screen; | |
293 | $RT::Logger->add( Log::Dispatch::Screen->new | |
294 | ( name => 'screen', | |
295 | min_level => $Config->Get('LogToScreen'), | |
296 | callbacks => [ $simple_cb, $stack_cb ], | |
297 | stderr => 1, | |
298 | )); | |
299 | } | |
300 | if ( $Config->Get('LogToSyslog') ) { | |
301 | require Log::Dispatch::Syslog; | |
302 | $RT::Logger->add(Log::Dispatch::Syslog->new | |
303 | ( name => 'syslog', | |
304 | ident => 'RT', | |
305 | min_level => $Config->Get('LogToSyslog'), | |
306 | callbacks => [ $syslog_cb, $stack_cb ], | |
307 | stderr => 1, | |
308 | $Config->Get('LogToSyslogConf'), | |
309 | )); | |
310 | } | |
311 | } | |
312 | InitSignalHandlers(); | |
313 | } | |
314 | ||
403d7b0b MKG |
315 | { # Work around bug in Log::Dispatch < 2.30, wherein the short forms |
316 | # of ->warn, ->err, and ->crit do not usefully propagate out, unlike | |
317 | # ->warning, ->error, and ->critical | |
318 | package Log::Dispatch; | |
319 | no warnings 'redefine'; | |
320 | sub warn { shift->warning(@_) } | |
321 | sub err { shift->error(@_) } | |
322 | sub crit { shift->critical(@_) } | |
323 | } | |
324 | ||
84fb5b46 MKG |
325 | sub InitSignalHandlers { |
326 | ||
327 | # Signal handlers | |
328 | ## This is the default handling of warnings and die'ings in the code | |
329 | ## (including other used modules - maybe except for errors catched by | |
330 | ## Mason). It will log all problems through the standard logging | |
331 | ## mechanism (see above). | |
332 | ||
333 | $SIG{__WARN__} = sub { | |
334 | # The 'wide character' warnings has to be silenced for now, at least | |
335 | # until HTML::Mason offers a sane way to process both raw output and | |
336 | # unicode strings. | |
337 | # use 'goto &foo' syntax to hide ANON sub from stack | |
338 | if( index($_[0], 'Wide character in ') != 0 ) { | |
339 | unshift @_, $RT::Logger, qw(level warning message); | |
340 | goto &Log::Dispatch::log; | |
341 | } | |
403d7b0b MKG |
342 | # Return value is used only by RT::Test to filter warnings from |
343 | # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever | |
344 | # starts returning 'IGNORE', we'll need to switch to something more | |
345 | # clever. I don't expect that to happen. | |
346 | return 'IGNORE'; | |
84fb5b46 MKG |
347 | }; |
348 | ||
349 | #When we call die, trap it and log->crit with the value of the die. | |
350 | ||
351 | $SIG{__DIE__} = sub { | |
352 | # if we are not in eval and perl is not parsing code | |
353 | # then rollback transactions and log RT error | |
354 | unless ($^S || !defined $^S ) { | |
355 | $RT::Handle->Rollback(1) if $RT::Handle; | |
356 | $RT::Logger->crit("$_[0]") if $RT::Logger; | |
357 | } | |
358 | die $_[0]; | |
359 | }; | |
360 | } | |
361 | ||
362 | ||
363 | sub CheckPerlRequirements { | |
364 | if ($^V < 5.008003) { | |
365 | die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V; | |
366 | } | |
367 | ||
368 | # use $error here so the following "die" can still affect the global $@ | |
369 | my $error; | |
370 | { | |
371 | local $@; | |
372 | eval { | |
373 | my $x = ''; | |
374 | my $y = \$x; | |
375 | require Scalar::Util; | |
376 | Scalar::Util::weaken($y); | |
377 | }; | |
378 | $error = $@; | |
379 | } | |
380 | ||
381 | if ($error) { | |
382 | die <<"EOF"; | |
383 | ||
384 | RT requires the Scalar::Util module be built with support for the 'weaken' | |
385 | function. | |
386 | ||
387 | It is sometimes the case that operating system upgrades will replace | |
388 | a working Scalar::Util with a non-working one. If your system was working | |
389 | correctly up until now, this is likely the cause of the problem. | |
390 | ||
391 | Please reinstall Scalar::Util, being careful to let it build with your C | |
392 | compiler. Usually this is as simple as running the following command as | |
393 | root. | |
394 | ||
395 | perl -MCPAN -e'install Scalar::Util' | |
396 | ||
397 | EOF | |
398 | ||
399 | } | |
400 | } | |
401 | ||
402 | =head2 InitClasses | |
403 | ||
404 | Load all modules that define base classes. | |
405 | ||
406 | =cut | |
407 | ||
408 | sub InitClasses { | |
409 | shift if @_%2; # so we can call it as a function or method | |
410 | my %args = (@_); | |
411 | require RT::Tickets; | |
412 | require RT::Transactions; | |
413 | require RT::Attachments; | |
414 | require RT::Users; | |
415 | require RT::Principals; | |
416 | require RT::CurrentUser; | |
417 | require RT::Templates; | |
418 | require RT::Queues; | |
419 | require RT::ScripActions; | |
420 | require RT::ScripConditions; | |
421 | require RT::Scrips; | |
422 | require RT::Groups; | |
423 | require RT::GroupMembers; | |
424 | require RT::CustomFields; | |
425 | require RT::CustomFieldValues; | |
426 | require RT::ObjectCustomFields; | |
427 | require RT::ObjectCustomFieldValues; | |
428 | require RT::Attributes; | |
429 | require RT::Dashboard; | |
430 | require RT::Approval; | |
431 | require RT::Lifecycle; | |
432 | require RT::Link; | |
b5747ff2 | 433 | require RT::Links; |
84fb5b46 MKG |
434 | require RT::Article; |
435 | require RT::Articles; | |
436 | require RT::Class; | |
437 | require RT::Classes; | |
438 | require RT::ObjectClass; | |
439 | require RT::ObjectClasses; | |
440 | require RT::ObjectTopic; | |
441 | require RT::ObjectTopics; | |
442 | require RT::Topic; | |
443 | require RT::Topics; | |
444 | ||
445 | # on a cold server (just after restart) people could have an object | |
446 | # in the session, as we deserialize it so we never call constructor | |
447 | # of the class, so the list of accessible fields is empty and we die | |
448 | # with "Method xxx is not implemented in RT::SomeClass" | |
449 | ||
450 | # without this, we also can never call _ClassAccessible, because we | |
451 | # won't have filled RT::Record::_TABLE_ATTR | |
452 | $_->_BuildTableAttributes foreach qw( | |
453 | RT::Ticket | |
454 | RT::Transaction | |
455 | RT::Attachment | |
456 | RT::User | |
457 | RT::Principal | |
458 | RT::Template | |
459 | RT::Queue | |
460 | RT::ScripAction | |
461 | RT::ScripCondition | |
462 | RT::Scrip | |
463 | RT::Group | |
464 | RT::GroupMember | |
465 | RT::CustomField | |
466 | RT::CustomFieldValue | |
467 | RT::ObjectCustomField | |
468 | RT::ObjectCustomFieldValue | |
469 | RT::Attribute | |
470 | RT::ACE | |
471 | RT::Link | |
472 | RT::Article | |
473 | RT::Class | |
474 | RT::ObjectClass | |
475 | RT::ObjectTopic | |
476 | RT::Topic | |
477 | ); | |
478 | ||
479 | if ( $args{'Heavy'} ) { | |
480 | # load scrips' modules | |
481 | my $scrips = RT::Scrips->new(RT->SystemUser); | |
482 | $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' ); | |
483 | while ( my $scrip = $scrips->Next ) { | |
484 | local $@; | |
485 | eval { $scrip->LoadModules } or | |
486 | $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ". | |
487 | "You should delete or repair this Scrip in the admin UI.\n$@\n"); | |
488 | } | |
489 | ||
490 | foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) { | |
491 | local $@; | |
492 | eval "require $class; 1" or $RT::Logger->error( | |
493 | "Class '$class' is listed in CustomFieldValuesSources option" | |
494 | ." in the config, but we failed to load it:\n$@\n" | |
495 | ); | |
496 | } | |
497 | ||
498 | } | |
499 | } | |
500 | ||
501 | =head2 InitSystemObjects | |
502 | ||
503 | Initializes system objects: C<$RT::System>, C<< RT->SystemUser >> | |
504 | and C<< RT->Nobody >>. | |
505 | ||
506 | =cut | |
507 | ||
508 | sub InitSystemObjects { | |
509 | ||
510 | #RT's system user is a genuine database user. its id lives here | |
511 | require RT::CurrentUser; | |
512 | $SystemUser = RT::CurrentUser->new; | |
513 | $SystemUser->LoadByName('RT_System'); | |
514 | ||
515 | #RT's "nobody user" is a genuine database user. its ID lives here. | |
516 | $Nobody = RT::CurrentUser->new; | |
517 | $Nobody->LoadByName('Nobody'); | |
518 | ||
519 | require RT::System; | |
520 | $System = RT::System->new( $SystemUser ); | |
521 | } | |
522 | ||
523 | =head1 CLASS METHODS | |
524 | ||
525 | =head2 Config | |
526 | ||
527 | Returns the current L<config object|RT::Config>, but note that | |
528 | you must L<load config|/LoadConfig> first otherwise this method | |
529 | returns undef. | |
530 | ||
531 | Method can be called as class method. | |
532 | ||
533 | =cut | |
534 | ||
535 | sub Config { return $Config || shift->LoadConfig(); } | |
536 | ||
537 | =head2 DatabaseHandle | |
538 | ||
539 | Returns the current L<database handle object|RT::Handle>. | |
540 | ||
541 | See also L</ConnectToDatabase>. | |
542 | ||
543 | =cut | |
544 | ||
545 | sub DatabaseHandle { return $Handle } | |
546 | ||
547 | =head2 Logger | |
548 | ||
549 | Returns the logger. See also L</InitLogging>. | |
550 | ||
551 | =cut | |
552 | ||
553 | sub Logger { return $Logger } | |
554 | ||
555 | =head2 System | |
556 | ||
557 | Returns the current L<system object|RT::System>. See also | |
558 | L</InitSystemObjects>. | |
559 | ||
560 | =cut | |
561 | ||
562 | sub System { return $System } | |
563 | ||
564 | =head2 SystemUser | |
565 | ||
566 | Returns the system user's object, it's object of | |
567 | L<RT::CurrentUser> class that represents the system. See also | |
568 | L</InitSystemObjects>. | |
569 | ||
570 | =cut | |
571 | ||
572 | sub SystemUser { return $SystemUser } | |
573 | ||
574 | =head2 Nobody | |
575 | ||
576 | Returns object of Nobody. It's object of L<RT::CurrentUser> class | |
577 | that represents a user who can own ticket and nothing else. See | |
578 | also L</InitSystemObjects>. | |
579 | ||
580 | =cut | |
581 | ||
582 | sub Nobody { return $Nobody } | |
583 | ||
584 | sub PrivilegedUsers { | |
585 | if (!$_Privileged) { | |
586 | $_Privileged = RT::Group->new(RT->SystemUser); | |
587 | $_Privileged->LoadSystemInternalGroup('Privileged'); | |
588 | } | |
589 | return $_Privileged; | |
590 | } | |
591 | ||
592 | sub UnprivilegedUsers { | |
593 | if (!$_Unprivileged) { | |
594 | $_Unprivileged = RT::Group->new(RT->SystemUser); | |
595 | $_Unprivileged->LoadSystemInternalGroup('Unprivileged'); | |
596 | } | |
597 | return $_Unprivileged; | |
598 | } | |
599 | ||
600 | ||
601 | =head2 Plugins | |
602 | ||
603 | Returns a listref of all Plugins currently configured for this RT instance. | |
604 | You can define plugins by adding them to the @Plugins list in your RT_SiteConfig | |
605 | ||
606 | =cut | |
607 | ||
608 | our @PLUGINS = (); | |
609 | sub Plugins { | |
610 | my $self = shift; | |
611 | unless (@PLUGINS) { | |
612 | $self->InitPluginPaths; | |
613 | @PLUGINS = $self->InitPlugins; | |
614 | } | |
615 | return \@PLUGINS; | |
616 | } | |
617 | ||
618 | =head2 PluginDirs | |
619 | ||
620 | Takes an optional subdir (e.g. po, lib, etc.) and returns a list of | |
621 | directories from plugins where that subdirectory exists. | |
622 | ||
623 | This code does not check plugin names, plugin validitity, or load | |
624 | plugins (see L</InitPlugins>) in any way, and requires that RT's | |
625 | configuration have been already loaded. | |
626 | ||
627 | =cut | |
628 | ||
629 | sub PluginDirs { | |
630 | my $self = shift; | |
631 | my $subdir = shift; | |
632 | ||
633 | require RT::Plugin; | |
634 | ||
635 | my @res; | |
636 | foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { | |
637 | my $path = RT::Plugin->new( name => $plugin )->Path( $subdir ); | |
638 | next unless -d $path; | |
639 | push @res, $path; | |
640 | } | |
641 | return @res; | |
642 | } | |
643 | ||
644 | =head2 InitPluginPaths | |
645 | ||
646 | Push plugins' lib paths into @INC right after F<local/lib>. | |
647 | In case F<local/lib> isn't in @INC, append them to @INC | |
648 | ||
649 | =cut | |
650 | ||
651 | sub InitPluginPaths { | |
652 | my $self = shift || __PACKAGE__; | |
653 | ||
654 | my @lib_dirs = $self->PluginDirs('lib'); | |
655 | ||
656 | my @tmp_inc; | |
657 | my $added; | |
658 | for (@INC) { | |
659 | if ( Cwd::realpath($_) eq $RT::LocalLibPath) { | |
660 | push @tmp_inc, $_, @lib_dirs; | |
661 | $added = 1; | |
662 | } else { | |
663 | push @tmp_inc, $_; | |
664 | } | |
665 | } | |
666 | ||
667 | # append @lib_dirs in case $RT::LocalLibPath isn't in @INC | |
668 | push @tmp_inc, @lib_dirs unless $added; | |
669 | ||
670 | my %seen; | |
671 | @INC = grep !$seen{$_}++, @tmp_inc; | |
672 | } | |
673 | ||
674 | =head2 InitPlugins | |
675 | ||
676 | Initialize all Plugins found in the RT configuration file, setting up | |
677 | their lib and L<HTML::Mason> component roots. | |
678 | ||
679 | =cut | |
680 | ||
681 | sub InitPlugins { | |
682 | my $self = shift; | |
683 | my @plugins; | |
684 | require RT::Plugin; | |
685 | foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { | |
686 | $plugin->require; | |
687 | die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR); | |
688 | push @plugins, RT::Plugin->new(name =>$plugin); | |
689 | } | |
690 | return @plugins; | |
691 | } | |
692 | ||
693 | ||
694 | sub InstallMode { | |
695 | my $self = shift; | |
696 | if (@_) { | |
697 | my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; | |
698 | if ($_[0] and $integrity) { | |
699 | # Trying to turn install mode on but we have a good DB! | |
700 | require Carp; | |
701 | $RT::Logger->error( | |
702 | Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!") | |
703 | ); | |
704 | } | |
705 | else { | |
706 | $_INSTALL_MODE = shift; | |
707 | if($_INSTALL_MODE) { | |
708 | require RT::CurrentUser; | |
709 | $SystemUser = RT::CurrentUser->new(); | |
710 | } | |
711 | } | |
712 | } | |
713 | return $_INSTALL_MODE; | |
714 | } | |
715 | ||
716 | sub LoadGeneratedData { | |
717 | my $class = shift; | |
718 | my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; | |
719 | ||
720 | require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@"; | |
721 | $class->CanonicalizeGeneratedPaths(); | |
722 | } | |
723 | ||
724 | sub CanonicalizeGeneratedPaths { | |
725 | my $class = shift; | |
726 | unless ( File::Spec->file_name_is_absolute($EtcPath) ) { | |
727 | ||
728 | # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}. | |
729 | # otherwise RT.pm will make the source dir(where we configure RT) be the | |
730 | # BasePath instead of the one specified by --prefix | |
731 | unless ( -d $BasePath | |
732 | && File::Spec->file_name_is_absolute($BasePath) ) | |
733 | { | |
734 | my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; | |
735 | ||
736 | # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'} | |
737 | # is not always absolute | |
738 | $BasePath = File::Spec->rel2abs( | |
739 | File::Spec->catdir( $pm_path, File::Spec->updir ) ); | |
740 | } | |
741 | ||
742 | $BasePath = Cwd::realpath($BasePath); | |
743 | ||
744 | for my $path ( | |
745 | qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath | |
746 | LocalLibPath LexiconPath LocalLexiconPath PluginPath | |
747 | LocalPluginPath MasonComponentRoot MasonLocalComponentRoot | |
748 | MasonDataDir MasonSessionDir/ | |
749 | ) | |
750 | { | |
751 | no strict 'refs'; | |
752 | ||
753 | # just change relative ones | |
754 | $$path = File::Spec->catfile( $BasePath, $$path ) | |
755 | unless File::Spec->file_name_is_absolute($$path); | |
756 | } | |
757 | } | |
758 | ||
759 | } | |
760 | ||
761 | =head2 AddJavaScript | |
762 | ||
763 | helper method to add js files to C<JSFiles> config. | |
b5747ff2 | 764 | to add extra js files, you can add the following line |
84fb5b46 MKG |
765 | in the plugin's main file: |
766 | ||
767 | RT->AddJavaScript( 'foo.js', 'bar.js' ); | |
768 | ||
769 | =cut | |
770 | ||
771 | sub AddJavaScript { | |
772 | my $self = shift; | |
773 | ||
774 | my @old = RT->Config->Get('JSFiles'); | |
775 | RT->Config->Set( 'JSFiles', @old, @_ ); | |
776 | return RT->Config->Get('JSFiles'); | |
777 | } | |
778 | ||
779 | =head2 AddStyleSheets | |
780 | ||
781 | helper method to add css files to C<CSSFiles> config | |
782 | ||
783 | to add extra css files, you can add the following line | |
784 | in the plugin's main file: | |
785 | ||
786 | RT->AddStyleSheets( 'foo.css', 'bar.css' ); | |
787 | ||
788 | =cut | |
789 | ||
790 | sub AddStyleSheets { | |
791 | my $self = shift; | |
792 | my @old = RT->Config->Get('CSSFiles'); | |
793 | RT->Config->Set( 'CSSFiles', @old, @_ ); | |
794 | return RT->Config->Get('CSSFiles'); | |
795 | } | |
796 | ||
797 | =head2 JavaScript | |
798 | ||
799 | helper method of RT->Config->Get('JSFiles') | |
800 | ||
801 | =cut | |
802 | ||
803 | sub JavaScript { | |
804 | return RT->Config->Get('JSFiles'); | |
805 | } | |
806 | ||
807 | =head2 StyleSheets | |
808 | ||
809 | helper method of RT->Config->Get('CSSFiles') | |
810 | ||
811 | =cut | |
812 | ||
813 | sub StyleSheets { | |
814 | return RT->Config->Get('CSSFiles'); | |
815 | } | |
816 | ||
817 | =head1 BUGS | |
818 | ||
819 | Please report them to rt-bugs@bestpractical.com, if you know what's | |
820 | broken and have at least some idea of what needs to be fixed. | |
821 | ||
822 | If you're not sure what's going on, report them rt-devel@lists.bestpractical.com. | |
823 | ||
824 | =head1 SEE ALSO | |
825 | ||
826 | L<RT::StyleGuide> | |
827 | L<DBIx::SearchBuilder> | |
828 | ||
829 | =cut | |
830 | ||
831 | require RT::Base; | |
832 | RT::Base->_ImportOverlays(); | |
833 | ||
834 | 1; |