1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2014 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 }}}
59 use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE);
74 $MasonLocalComponentRoot
79 RT->LoadGeneratedData();
87 A fully featured request tracker package.
89 This documentation describes the point-of-entry for RT's Perl API. To learn
90 more about what RT is and what it can do for you, visit
91 L<https://bestpractical.com/rt>.
97 If you're using RT's Perl libraries, you need to initialize RT before using any
100 You have the option of handling the timing of config loading and the actual
101 init sequence yourself with:
109 or you can let RT do it all:
113 This second method is particular useful when writing one-liners to interact with RT:
115 perl -MRT=-init -e '...'
117 The first method is necessary if you need to delay or conditionalize
118 initialization or if you want to fiddle with C<< RT->Config >> between loading
119 the config files and initializing the RT environment.
127 my $action = shift || '';
129 if ($action eq "-init" and not $DID_IMPORT_INIT) {
132 $DID_IMPORT_INIT = 1;
139 Load RT's config file. First, the site configuration file
140 (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
141 settings like hostname and name of RT instance. Then, the core
142 configuration file (F<RT_Config.pm>) is loaded to set fallback values
143 for all settings; it bases some values on settings from the site
146 In order for the core configuration to not override the site's
147 settings, the function C<Set> is used; it only sets values if they
148 have not been set already.
154 $Config = RT::Config->new;
155 $Config->LoadConfigs;
158 # RT::Essentials mistakenly recommends that WebPath be set to '/'.
159 # If the user does that, do what they mean.
160 $RT::WebPath = '' if ($RT::WebPath eq '/');
162 # fix relative LogDir and GnuPG homedir
163 unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
164 $Config->Set( LogDir =>
165 File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
168 my $gpgopts = $Config->Get('GnuPGOptions');
169 unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
170 $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} );
178 L<Connects to the database|/ConnectToDatabase>, L<initilizes system
179 objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets
180 up logging|/InitLogging>, and L<loads plugins|/InitPlugins>.
185 shift if @_%2; # code is inconsistent about calling as method
188 CheckPerlRequirements();
192 #Get a database connection
199 RT->Config->PostLoadCheck;
203 =head2 ConnectToDatabase
205 Get a database connection. See also L</Handle>.
209 sub ConnectToDatabase {
211 $Handle = RT::Handle->new unless $Handle;
218 Create the Logger object and set up signal handlers.
226 # We have to set the record separator ($, man perlvar)
227 # or Log::Dispatch starts getting
228 # really pissy, as some other module we use unsets it.
230 use Log::Dispatch 1.6;
233 map( { $_ => } 0..7 ),
238 error => 4, 'err' => 4,
239 critical => 5, crit => 5,
241 emergency => 7, emerg => 7,
244 unless ( $RT::Logger ) {
246 $RT::Logger = Log::Dispatch->new;
248 my $stack_from_level;
249 if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) {
250 # if option has old style '\d'(true) value
251 $stack_from_level = 0 if $stack_from_level =~ /^\d+$/;
252 $stack_from_level = $level_to_num{ $stack_from_level } || 0;
254 $stack_from_level = 99; # don't log
257 my $simple_cb = sub {
258 # if this code throw any warning we can get segfault
262 # skip Log::* stack frames
264 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
265 my ($package, $filename, $line) = caller($frame);
267 # Encode to bytes, so we don't send wide characters
268 $p{message} = Encode::encode("UTF-8", $p{message});
270 $p{'message'} =~ s/(?:\r*\n)+$//;
271 return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: "
272 . $p{'message'} ." ($filename:$line)\n";
275 my $syslog_cb = sub {
276 # if this code throw any warning we can get segfault
280 my $frame = 0; # stack frame index
281 # skip Log::* stack frames
282 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
283 my ($package, $filename, $line) = caller($frame);
285 # Encode to bytes, so we don't send wide characters
286 $p{message} = Encode::encode("UTF-8", $p{message});
288 $p{message} =~ s/(?:\r*\n)+$//;
289 if ($p{level} eq 'debug') {
290 return "[$$] $p{message} ($filename:$line)\n";
292 return "[$$] $p{message}\n";
299 return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
301 require Devel::StackTrace;
302 my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
303 return $p{'message'} . $trace->as_string;
305 # skip calling of the Log::* subroutins
307 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
308 $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
310 $p{'message'} .= "\nStack trace:\n";
311 while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
312 $p{'message'} .= "\t$sub(...) called at $filename:$line\n";
314 return $p{'message'};
317 if ( $Config->Get('LogToFile') ) {
318 my ($filename, $logdir) = (
319 $Config->Get('LogToFileNamed') || 'rt.log',
320 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
322 if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
323 ($logdir) = $filename =~ m{^(.*[/\\])};
326 $filename = File::Spec->catfile( $logdir, $filename );
329 unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
330 # localizing here would be hard when we don't have a current user yet
331 die "Log file '$filename' couldn't be written or created.\n RT can't run.";
334 require Log::Dispatch::File;
335 $RT::Logger->add( Log::Dispatch::File->new
337 min_level=> $Config->Get('LogToFile'),
338 filename=> $filename,
340 callbacks => [ $simple_cb, $stack_cb ],
343 if ( $Config->Get('LogToScreen') ) {
344 require Log::Dispatch::Screen;
345 $RT::Logger->add( Log::Dispatch::Screen->new
347 min_level => $Config->Get('LogToScreen'),
348 callbacks => [ $simple_cb, $stack_cb ],
352 if ( $Config->Get('LogToSyslog') ) {
353 require Log::Dispatch::Syslog;
354 $RT::Logger->add(Log::Dispatch::Syslog->new
357 min_level => $Config->Get('LogToSyslog'),
358 callbacks => [ $syslog_cb, $stack_cb ],
360 $Config->Get('LogToSyslogConf'),
364 InitSignalHandlers(%arg);
367 { # Work around bug in Log::Dispatch < 2.30, wherein the short forms
368 # of ->warn, ->err, and ->crit do not usefully propagate out, unlike
369 # ->warning, ->error, and ->critical
370 package Log::Dispatch;
371 no warnings 'redefine';
372 sub warn { shift->warning(@_) }
373 sub err { shift->error(@_) }
374 sub crit { shift->critical(@_) }
377 sub InitSignalHandlers {
380 return if $arg{'NoSignalHandlers'};
383 ## This is the default handling of warnings and die'ings in the code
384 ## (including other used modules - maybe except for errors catched by
385 ## Mason). It will log all problems through the standard logging
386 ## mechanism (see above).
388 $SIG{__WARN__} = sub {
389 # use 'goto &foo' syntax to hide ANON sub from stack
390 unshift @_, $RT::Logger, qw(level warning message);
391 goto &Log::Dispatch::log;
394 #When we call die, trap it and log->crit with the value of the die.
396 $SIG{__DIE__} = sub {
397 # if we are not in eval and perl is not parsing code
398 # then rollback transactions and log RT error
399 unless ($^S || !defined $^S ) {
400 $RT::Handle->Rollback(1) if $RT::Handle;
401 $RT::Logger->crit("$_[0]") if $RT::Logger;
408 sub CheckPerlRequirements {
409 if ($^V < 5.008003) {
410 die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V;
413 # use $error here so the following "die" can still affect the global $@
420 require Scalar::Util;
421 Scalar::Util::weaken($y);
429 RT requires the Scalar::Util module be built with support for the 'weaken'
432 It is sometimes the case that operating system upgrades will replace
433 a working Scalar::Util with a non-working one. If your system was working
434 correctly up until now, this is likely the cause of the problem.
436 Please reinstall Scalar::Util, being careful to let it build with your C
437 compiler. Usually this is as simple as running the following command as
440 perl -MCPAN -e'install Scalar::Util'
449 Load all modules that define base classes.
454 shift if @_%2; # so we can call it as a function or method
457 require RT::Transactions;
458 require RT::Attachments;
460 require RT::Principals;
461 require RT::CurrentUser;
462 require RT::Templates;
464 require RT::ScripActions;
465 require RT::ScripConditions;
468 require RT::GroupMembers;
469 require RT::CustomFields;
470 require RT::CustomFieldValues;
471 require RT::ObjectCustomFields;
472 require RT::ObjectCustomFieldValues;
473 require RT::Attributes;
474 require RT::Dashboard;
475 require RT::Approval;
476 require RT::Lifecycle;
480 require RT::Articles;
483 require RT::ObjectClass;
484 require RT::ObjectClasses;
485 require RT::ObjectTopic;
486 require RT::ObjectTopics;
490 # on a cold server (just after restart) people could have an object
491 # in the session, as we deserialize it so we never call constructor
492 # of the class, so the list of accessible fields is empty and we die
493 # with "Method xxx is not implemented in RT::SomeClass"
495 # without this, we also can never call _ClassAccessible, because we
496 # won't have filled RT::Record::_TABLE_ATTR
497 $_->_BuildTableAttributes foreach qw(
512 RT::ObjectCustomField
513 RT::ObjectCustomFieldValue
524 if ( $args{'Heavy'} ) {
525 # load scrips' modules
526 my $scrips = RT::Scrips->new(RT->SystemUser);
527 $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' );
528 while ( my $scrip = $scrips->Next ) {
530 eval { $scrip->LoadModules } or
531 $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ".
532 "You should delete or repair this Scrip in the admin UI.\n$@\n");
535 foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
537 eval "require $class; 1" or $RT::Logger->error(
538 "Class '$class' is listed in CustomFieldValuesSources option"
539 ." in the config, but we failed to load it:\n$@\n"
546 =head2 InitSystemObjects
548 Initializes system objects: C<$RT::System>, C<< RT->SystemUser >>
549 and C<< RT->Nobody >>.
553 sub InitSystemObjects {
555 #RT's system user is a genuine database user. its id lives here
556 require RT::CurrentUser;
557 $SystemUser = RT::CurrentUser->new;
558 $SystemUser->LoadByName('RT_System');
560 #RT's "nobody user" is a genuine database user. its ID lives here.
561 $Nobody = RT::CurrentUser->new;
562 $Nobody->LoadByName('Nobody');
565 $System = RT::System->new( $SystemUser );
572 Returns the current L<config object|RT::Config>, but note that
573 you must L<load config|/LoadConfig> first otherwise this method
576 Method can be called as class method.
580 sub Config { return $Config || shift->LoadConfig(); }
582 =head2 DatabaseHandle
584 Returns the current L<database handle object|RT::Handle>.
586 See also L</ConnectToDatabase>.
590 sub DatabaseHandle { return $Handle }
594 Returns the logger. See also L</InitLogging>.
598 sub Logger { return $Logger }
602 Returns the current L<system object|RT::System>. See also
603 L</InitSystemObjects>.
607 sub System { return $System }
611 Returns the system user's object, it's object of
612 L<RT::CurrentUser> class that represents the system. See also
613 L</InitSystemObjects>.
617 sub SystemUser { return $SystemUser }
621 Returns object of Nobody. It's object of L<RT::CurrentUser> class
622 that represents a user who can own ticket and nothing else. See
623 also L</InitSystemObjects>.
627 sub Nobody { return $Nobody }
629 sub PrivilegedUsers {
631 $_Privileged = RT::Group->new(RT->SystemUser);
632 $_Privileged->LoadSystemInternalGroup('Privileged');
637 sub UnprivilegedUsers {
638 if (!$_Unprivileged) {
639 $_Unprivileged = RT::Group->new(RT->SystemUser);
640 $_Unprivileged->LoadSystemInternalGroup('Unprivileged');
642 return $_Unprivileged;
648 Returns a listref of all Plugins currently configured for this RT instance.
649 You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
657 $self->InitPluginPaths;
658 @PLUGINS = $self->InitPlugins;
665 Takes an optional subdir (e.g. po, lib, etc.) and returns a list of
666 directories from plugins where that subdirectory exists.
668 This code does not check plugin names, plugin validitity, or load
669 plugins (see L</InitPlugins>) in any way, and requires that RT's
670 configuration have been already loaded.
681 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
682 my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
683 next unless -d $path;
689 =head2 InitPluginPaths
691 Push plugins' lib paths into @INC right after F<local/lib>.
692 In case F<local/lib> isn't in @INC, append them to @INC
696 sub InitPluginPaths {
697 my $self = shift || __PACKAGE__;
699 my @lib_dirs = $self->PluginDirs('lib');
704 my $realpath = Cwd::realpath($_);
705 next unless defined $realpath;
706 if ( $realpath eq $RT::LocalLibPath) {
707 push @tmp_inc, $_, @lib_dirs;
714 # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
715 push @tmp_inc, @lib_dirs unless $added;
718 @INC = grep !$seen{$_}++, @tmp_inc;
723 Initialize all Plugins found in the RT configuration file, setting up
724 their lib and L<HTML::Mason> component roots.
732 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
734 die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
735 push @plugins, RT::Plugin->new(name =>$plugin);
744 my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
745 if ($_[0] and $integrity) {
746 # Trying to turn install mode on but we have a good DB!
749 Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!")
753 $_INSTALL_MODE = shift;
755 require RT::CurrentUser;
756 $SystemUser = RT::CurrentUser->new();
760 return $_INSTALL_MODE;
763 sub LoadGeneratedData {
765 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
767 require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@";
768 $class->CanonicalizeGeneratedPaths();
771 sub CanonicalizeGeneratedPaths {
773 unless ( File::Spec->file_name_is_absolute($EtcPath) ) {
775 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
776 # otherwise RT.pm will make the source dir(where we configure RT) be the
777 # BasePath instead of the one specified by --prefix
778 unless ( -d $BasePath
779 && File::Spec->file_name_is_absolute($BasePath) )
781 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
783 # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
784 # is not always absolute
785 $BasePath = File::Spec->rel2abs(
786 File::Spec->catdir( $pm_path, File::Spec->updir ) );
789 $BasePath = Cwd::realpath($BasePath);
792 qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath
793 LocalLibPath LexiconPath LocalLexiconPath PluginPath
794 LocalPluginPath MasonComponentRoot MasonLocalComponentRoot
795 MasonDataDir MasonSessionDir/
800 # just change relative ones
801 $$path = File::Spec->catfile( $BasePath, $$path )
802 unless File::Spec->file_name_is_absolute($$path);
810 helper method to add js files to C<JSFiles> config.
811 to add extra js files, you can add the following line
812 in the plugin's main file:
814 RT->AddJavaScript( 'foo.js', 'bar.js' );
821 my @old = RT->Config->Get('JSFiles');
822 RT->Config->Set( 'JSFiles', @old, @_ );
823 return RT->Config->Get('JSFiles');
826 =head2 AddStyleSheets
828 helper method to add css files to C<CSSFiles> config
830 to add extra css files, you can add the following line
831 in the plugin's main file:
833 RT->AddStyleSheets( 'foo.css', 'bar.css' );
839 my @old = RT->Config->Get('CSSFiles');
840 RT->Config->Set( 'CSSFiles', @old, @_ );
841 return RT->Config->Get('CSSFiles');
846 helper method of RT->Config->Get('JSFiles')
851 return RT->Config->Get('JSFiles');
856 helper method of RT->Config->Get('CSSFiles')
861 return RT->Config->Get('CSSFiles');
866 Please report them to rt-bugs@bestpractical.com, if you know what's
867 broken and have at least some idea of what needs to be fixed.
869 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
874 L<DBIx::SearchBuilder>
879 RT::Base->_ImportOverlays();