1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
58 use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_INSTALL_MODE);
60 our $VERSION = '@RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.@RT_VERSION_PATCH@';
64 our $BasePath = '@RT_PATH@';
65 our $EtcPath = '@RT_ETC_PATH@';
66 our $BinPath = '@RT_BIN_PATH@';
67 our $SbinPath = '@RT_SBIN_PATH@';
68 our $VarPath = '@RT_VAR_PATH@';
69 our $PluginPath = '@RT_PLUGIN_PATH@';
70 our $LocalPath = '@RT_LOCAL_PATH@';
71 our $LocalEtcPath = '@LOCAL_ETC_PATH@';
72 our $LocalLibPath = '@LOCAL_LIB_PATH@';
73 our $LocalLexiconPath = '@LOCAL_LEXICON_PATH@';
74 our $LocalPluginPath = $LocalPath."/plugins";
77 # $MasonComponentRoot is where your rt instance keeps its mason html files
79 our $MasonComponentRoot = '@MASON_HTML_PATH@';
81 # $MasonLocalComponentRoot is where your rt instance keeps its site-local
84 our $MasonLocalComponentRoot = '@MASON_LOCAL_HTML_PATH@';
86 # $MasonDataDir Where mason keeps its datafiles
88 our $MasonDataDir = '@MASON_DATA_PATH@';
90 # RT needs to put session data (for preserving state between connections
91 # via the web interface)
92 our $MasonSessionDir = '@MASON_SESSION_PATH@';
94 unless ( File::Spec->file_name_is_absolute($EtcPath) ) {
96 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
97 # otherwise RT.pm will make src dir(where we configure RT) be the BasePath
98 # instead of the --prefix one
99 unless ( -d $BasePath && File::Spec->file_name_is_absolute($BasePath) ) {
100 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
102 # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
103 # is not always absolute
106 File::Spec->catdir( $pm_path, File::Spec->updir ) );
109 $BasePath = Cwd::realpath( $BasePath );
111 for my $path ( qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath
112 LocalLibPath LocalLexiconPath PluginPath LocalPluginPath
113 MasonComponentRoot MasonLocalComponentRoot MasonDataDir
116 # just change relative ones
117 $$path = File::Spec->catfile( $BasePath, $$path )
118 unless File::Spec->file_name_is_absolute( $$path );
129 A fully featured request tracker package
133 =head2 INITIALIZATION
137 Load RT's config file. First, the site configuration file
138 (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
139 settings like hostname and name of RT instance. Then, the core
140 configuration file (F<RT_Config.pm>) is loaded to set fallback values
141 for all settings; it bases some values on settings from the site
144 In order for the core configuration to not override the site's
145 settings, the function C<Set> is used; it only sets values if they
146 have not been set already.
152 $Config = new RT::Config;
153 $Config->LoadConfigs;
156 # RT::Essentials mistakenly recommends that WebPath be set to '/'.
157 # If the user does that, do what they mean.
158 $RT::WebPath = '' if ($RT::WebPath eq '/');
160 # fix relative LogDir and GnuPG homedir
161 unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
162 $Config->Set( LogDir =>
163 File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
166 my $gpgopts = $Config->Get('GnuPGOptions');
167 unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
168 $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} );
176 L<Connect to the database /ConnectToDatabase>, L<initilizes system objects /InitSystemObjects>,
177 L<preloads classes /InitClasses> and L<set up logging /InitLogging>.
183 CheckPerlRequirements();
187 #Get a database connection
193 RT->Config->PostLoadCheck;
197 =head2 ConnectToDatabase
199 Get a database connection. See also </Handle>.
203 sub ConnectToDatabase {
205 $Handle = new RT::Handle unless $Handle;
212 Create the Logger object and set up signal handlers.
218 # We have to set the record separator ($, man perlvar)
219 # or Log::Dispatch starts getting
220 # really pissy, as some other module we use unsets it.
222 use Log::Dispatch 1.6;
225 map( { $_ => } 0..7 ),
230 error => 4, 'err' => 4,
231 critical => 5, crit => 5,
233 emergency => 7, emerg => 7,
236 unless ( $RT::Logger ) {
238 $RT::Logger = Log::Dispatch->new;
240 my $stack_from_level;
241 if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) {
242 # if option has old style '\d'(true) value
243 $stack_from_level = 0 if $stack_from_level =~ /^\d+$/;
244 $stack_from_level = $level_to_num{ $stack_from_level } || 0;
246 $stack_from_level = 99; # don't log
249 my $simple_cb = sub {
250 # if this code throw any warning we can get segfault
254 # skip Log::* stack frames
256 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
257 my ($package, $filename, $line) = caller($frame);
259 $p{'message'} =~ s/(?:\r*\n)+$//;
260 return "[". gmtime(time) ."] [". $p{'level'} ."]: "
261 . $p{'message'} ." ($filename:$line)\n";
264 my $syslog_cb = sub {
265 # if this code throw any warning we can get segfault
269 my $frame = 0; # stack frame index
270 # skip Log::* stack frames
271 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
272 my ($package, $filename, $line) = caller($frame);
274 # syswrite() cannot take utf8; turn it off here.
275 Encode::_utf8_off($p{message});
277 $p{message} =~ s/(?:\r*\n)+$//;
278 if ($p{level} eq 'debug') {
279 return "$p{message}\n";
281 return "$p{message} ($filename:$line)\n";
288 return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
290 require Devel::StackTrace;
291 my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
292 return $p{'message'} . $trace->as_string;
294 # skip calling of the Log::* subroutins
296 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
297 $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
299 $p{'message'} .= "\nStack trace:\n";
300 while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
301 $p{'message'} .= "\t$sub(...) called at $filename:$line\n";
303 return $p{'message'};
306 if ( $Config->Get('LogToFile') ) {
307 my ($filename, $logdir) = (
308 $Config->Get('LogToFileNamed') || 'rt.log',
309 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
311 if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
312 ($logdir) = $filename =~ m{^(.*[/\\])};
315 $filename = File::Spec->catfile( $logdir, $filename );
318 unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
319 # localizing here would be hard when we don't have a current user yet
320 die "Log file '$filename' couldn't be written or created.\n RT can't run.";
323 require Log::Dispatch::File;
324 $RT::Logger->add( Log::Dispatch::File->new
326 min_level=> $Config->Get('LogToFile'),
327 filename=> $filename,
329 callbacks => [ $simple_cb, $stack_cb ],
332 if ( $Config->Get('LogToScreen') ) {
333 require Log::Dispatch::Screen;
334 $RT::Logger->add( Log::Dispatch::Screen->new
336 min_level => $Config->Get('LogToScreen'),
337 callbacks => [ $simple_cb, $stack_cb ],
341 if ( $Config->Get('LogToSyslog') ) {
342 require Log::Dispatch::Syslog;
343 $RT::Logger->add(Log::Dispatch::Syslog->new
346 min_level => $Config->Get('LogToSyslog'),
347 callbacks => [ $syslog_cb, $stack_cb ],
349 $Config->Get('LogToSyslogConf'),
353 InitSignalHandlers();
356 sub InitSignalHandlers {
359 ## This is the default handling of warnings and die'ings in the code
360 ## (including other used modules - maybe except for errors catched by
361 ## Mason). It will log all problems through the standard logging
362 ## mechanism (see above).
364 $SIG{__WARN__} = sub {
365 # The 'wide character' warnings has to be silenced for now, at least
366 # until HTML::Mason offers a sane way to process both raw output and
368 # use 'goto &foo' syntax to hide ANON sub from stack
369 if( index($_[0], 'Wide character in ') != 0 ) {
370 unshift @_, $RT::Logger, qw(level warning message);
371 goto &Log::Dispatch::log;
375 #When we call die, trap it and log->crit with the value of the die.
377 $SIG{__DIE__} = sub {
378 # if we are not in eval and perl is not parsing code
379 # then rollback transactions and log RT error
380 unless ($^S || !defined $^S ) {
381 $RT::Handle->Rollback(1) if $RT::Handle;
382 $RT::Logger->crit("$_[0]") if $RT::Logger;
389 sub CheckPerlRequirements {
390 if ($^V < 5.008003) {
391 die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V;
394 # use $error here so the following "die" can still affect the global $@
401 require Scalar::Util;
402 Scalar::Util::weaken($y);
410 RT requires the Scalar::Util module be built with support for the 'weaken'
413 It is sometimes the case that operating system upgrades will replace
414 a working Scalar::Util with a non-working one. If your system was working
415 correctly up until now, this is likely the cause of the problem.
417 Please reinstall Scalar::Util, being careful to let it build with your C
418 compiler. Ususally this is as simple as running the following command as
421 perl -MCPAN -e'install Scalar::Util'
430 Load all modules that define base classes.
435 shift if @_%2; # so we can call it as a function or method
438 require RT::Transactions;
439 require RT::Attachments;
441 require RT::Principals;
442 require RT::CurrentUser;
443 require RT::Templates;
445 require RT::ScripActions;
446 require RT::ScripConditions;
449 require RT::GroupMembers;
450 require RT::CustomFields;
451 require RT::CustomFieldValues;
452 require RT::ObjectCustomFields;
453 require RT::ObjectCustomFieldValues;
454 require RT::Attributes;
455 require RT::Dashboard;
456 require RT::Approval;
458 # on a cold server (just after restart) people could have an object
459 # in the session, as we deserialize it so we never call constructor
460 # of the class, so the list of accessible fields is empty and we die
461 # with "Method xxx is not implemented in RT::SomeClass"
462 $_->_BuildTableAttributes foreach qw(
477 RT::ObjectCustomField
478 RT::ObjectCustomFieldValue
482 if ( $args{'Heavy'} ) {
483 # load scrips' modules
484 my $scrips = RT::Scrips->new($RT::SystemUser);
485 $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' );
486 while ( my $scrip = $scrips->Next ) {
488 eval { $scrip->LoadModules } or
489 $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ".
490 "You should delete or repair this Scrip in the admin UI.\n$@\n");
493 foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
495 eval "require $class; 1" or $RT::Logger->error(
496 "Class '$class' is listed in CustomFieldValuesSources option"
497 ." in the config, but we failed to load it:\n$@\n"
501 RT::I18N->LoadLexicons;
505 =head2 InitSystemObjects
507 Initializes system objects: C<$RT::System>, C<$RT::SystemUser>
512 sub InitSystemObjects {
514 #RT's system user is a genuine database user. its id lives here
515 require RT::CurrentUser;
516 $SystemUser = new RT::CurrentUser;
517 $SystemUser->LoadByName('RT_System');
519 #RT's "nobody user" is a genuine database user. its ID lives here.
520 $Nobody = new RT::CurrentUser;
521 $Nobody->LoadByName('Nobody');
524 $System = RT::System->new( $SystemUser );
531 Returns the current L<config object RT::Config>, but note that
532 you must L<load config /LoadConfig> first otherwise this method
535 Method can be called as class method.
539 sub Config { return $Config }
541 =head2 DatabaseHandle
543 Returns the current L<database handle object RT::Handle>.
545 See also L</ConnectToDatabase>.
549 sub DatabaseHandle { return $Handle }
553 Returns the logger. See also L</InitLogging>.
557 sub Logger { return $Logger }
561 Returns the current L<system object RT::System>. See also
562 L</InitSystemObjects>.
566 sub System { return $System }
570 Returns the system user's object, it's object of
571 L<RT::CurrentUser> class that represents the system. See also
572 L</InitSystemObjects>.
576 sub SystemUser { return $SystemUser }
580 Returns object of Nobody. It's object of L<RT::CurrentUser> class
581 that represents a user who can own ticket and nothing else. See
582 also L</InitSystemObjects>.
586 sub Nobody { return $Nobody }
590 Returns a listref of all Plugins currently configured for this RT instance.
591 You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
599 $self->InitPluginPaths;
600 @PLUGINS = $self->InitPlugins;
607 Takes optional subdir (e.g. po, lib, etc.) and return plugins' dirs that exist.
609 This code chacke plugins names or anything else and required when main config
610 is loaded to load plugins' configs.
621 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
622 my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
623 next unless -d $path;
629 =head2 InitPluginPaths
631 Push plugins' lib paths into @INC right after F<local/lib>.
632 In case F<local/lib> isn't in @INC, append them to @INC
636 sub InitPluginPaths {
637 my $self = shift || __PACKAGE__;
639 my @lib_dirs = $self->PluginDirs('lib');
644 if ( Cwd::realpath($_) eq $RT::LocalLibPath) {
645 push @tmp_inc, $_, @lib_dirs;
652 # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
653 push @tmp_inc, @lib_dirs unless $added;
656 @INC = grep !$seen{$_}++, @tmp_inc;
661 Initialze all Plugins found in the RT configuration file, setting up their lib and HTML::Mason component roots.
669 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
671 die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
672 push @plugins, RT::Plugin->new(name =>$plugin);
681 $_INSTALL_MODE = shift;
683 require RT::CurrentUser;
684 $SystemUser = RT::CurrentUser->new();
687 return $_INSTALL_MODE;
693 Please report them to rt-bugs@bestpractical.com, if you know what's
694 broken and have at least some idea of what needs to be fixed.
696 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
701 L<DBIx::SearchBuilder>
707 RT::Base->_ImportOverlays();