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 }}}
58 use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE);
73 $MasonLocalComponentRoot
78 RT->LoadGeneratedData();
86 A fully featured request tracker package.
88 This documentation describes the point-of-entry for RT's Perl API. To learn
89 more about what RT is and what it can do for you, visit
90 L<https://bestpractical.com/rt>.
96 If you're using RT's Perl libraries, you need to initialize RT before using any
99 You have the option of handling the timing of config loading and the actual
100 init sequence yourself with:
108 or you can let RT do it all:
112 This second method is particular useful when writing one-liners to interact with RT:
114 perl -MRT=-init -e '...'
116 The first method is necessary if you need to delay or conditionalize
117 initialization or if you want to fiddle with C<< RT->Config >> between loading
118 the config files and initializing the RT environment.
126 my $action = shift || '';
128 if ($action eq "-init" and not $DID_IMPORT_INIT) {
131 $DID_IMPORT_INIT = 1;
138 Load RT's config file. First, the site configuration file
139 (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
140 settings like hostname and name of RT instance. Then, the core
141 configuration file (F<RT_Config.pm>) is loaded to set fallback values
142 for all settings; it bases some values on settings from the site
145 In order for the core configuration to not override the site's
146 settings, the function C<Set> is used; it only sets values if they
147 have not been set already.
153 $Config = RT::Config->new;
154 $Config->LoadConfigs;
157 # RT::Essentials mistakenly recommends that WebPath be set to '/'.
158 # If the user does that, do what they mean.
159 $RT::WebPath = '' if ($RT::WebPath eq '/');
161 # fix relative LogDir and GnuPG homedir
162 unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
163 $Config->Set( LogDir =>
164 File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
167 my $gpgopts = $Config->Get('GnuPGOptions');
168 unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
169 $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} );
177 L<Connects to the database|/ConnectToDatabase>, L<initilizes system
178 objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets
179 up logging|/InitLogging>, and L<loads plugins|/InitPlugins>.
184 shift if @_%2; # code is inconsistent about calling as method
187 CheckPerlRequirements();
191 #Get a database connection
198 RT->Config->PostLoadCheck;
202 =head2 ConnectToDatabase
204 Get a database connection. See also L</Handle>.
208 sub ConnectToDatabase {
210 $Handle = RT::Handle->new unless $Handle;
217 Create the Logger object and set up signal handlers.
225 # We have to set the record separator ($, man perlvar)
226 # or Log::Dispatch starts getting
227 # really pissy, as some other module we use unsets it.
229 use Log::Dispatch 1.6;
232 map( { $_ => } 0..7 ),
237 error => 4, 'err' => 4,
238 critical => 5, crit => 5,
240 emergency => 7, emerg => 7,
243 unless ( $RT::Logger ) {
245 $RT::Logger = Log::Dispatch->new;
247 my $stack_from_level;
248 if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) {
249 # if option has old style '\d'(true) value
250 $stack_from_level = 0 if $stack_from_level =~ /^\d+$/;
251 $stack_from_level = $level_to_num{ $stack_from_level } || 0;
253 $stack_from_level = 99; # don't log
256 my $simple_cb = sub {
257 # if this code throw any warning we can get segfault
261 # skip Log::* stack frames
263 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
264 my ($package, $filename, $line) = caller($frame);
266 $p{'message'} =~ s/(?:\r*\n)+$//;
267 return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: "
268 . $p{'message'} ." ($filename:$line)\n";
271 my $syslog_cb = sub {
272 # if this code throw any warning we can get segfault
276 my $frame = 0; # stack frame index
277 # skip Log::* stack frames
278 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
279 my ($package, $filename, $line) = caller($frame);
281 # syswrite() cannot take utf8; turn it off here.
282 Encode::_utf8_off($p{message});
284 $p{message} =~ s/(?:\r*\n)+$//;
285 if ($p{level} eq 'debug') {
286 return "[$$] $p{message} ($filename:$line)\n";
288 return "[$$] $p{message}\n";
295 return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
297 require Devel::StackTrace;
298 my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
299 return $p{'message'} . $trace->as_string;
301 # skip calling of the Log::* subroutins
303 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
304 $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
306 $p{'message'} .= "\nStack trace:\n";
307 while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
308 $p{'message'} .= "\t$sub(...) called at $filename:$line\n";
310 return $p{'message'};
313 if ( $Config->Get('LogToFile') ) {
314 my ($filename, $logdir) = (
315 $Config->Get('LogToFileNamed') || 'rt.log',
316 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
318 if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
319 ($logdir) = $filename =~ m{^(.*[/\\])};
322 $filename = File::Spec->catfile( $logdir, $filename );
325 unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
326 # localizing here would be hard when we don't have a current user yet
327 die "Log file '$filename' couldn't be written or created.\n RT can't run.";
330 require Log::Dispatch::File;
331 $RT::Logger->add( Log::Dispatch::File->new
333 min_level=> $Config->Get('LogToFile'),
334 filename=> $filename,
336 callbacks => [ $simple_cb, $stack_cb ],
339 if ( $Config->Get('LogToScreen') ) {
340 require Log::Dispatch::Screen;
341 $RT::Logger->add( Log::Dispatch::Screen->new
343 min_level => $Config->Get('LogToScreen'),
344 callbacks => [ $simple_cb, $stack_cb ],
348 if ( $Config->Get('LogToSyslog') ) {
349 require Log::Dispatch::Syslog;
350 $RT::Logger->add(Log::Dispatch::Syslog->new
353 min_level => $Config->Get('LogToSyslog'),
354 callbacks => [ $syslog_cb, $stack_cb ],
356 $Config->Get('LogToSyslogConf'),
360 InitSignalHandlers(%arg);
363 { # Work around bug in Log::Dispatch < 2.30, wherein the short forms
364 # of ->warn, ->err, and ->crit do not usefully propagate out, unlike
365 # ->warning, ->error, and ->critical
366 package Log::Dispatch;
367 no warnings 'redefine';
368 sub warn { shift->warning(@_) }
369 sub err { shift->error(@_) }
370 sub crit { shift->critical(@_) }
373 sub InitSignalHandlers {
376 return if $arg{'NoSignalHandlers'};
379 ## This is the default handling of warnings and die'ings in the code
380 ## (including other used modules - maybe except for errors catched by
381 ## Mason). It will log all problems through the standard logging
382 ## mechanism (see above).
384 $SIG{__WARN__} = sub {
385 # The 'wide character' warnings has to be silenced for now, at least
386 # until HTML::Mason offers a sane way to process both raw output and
388 # use 'goto &foo' syntax to hide ANON sub from stack
389 if( index($_[0], 'Wide character in ') != 0 ) {
390 unshift @_, $RT::Logger, qw(level warning message);
391 goto &Log::Dispatch::log;
393 # Return value is used only by RT::Test to filter warnings from
394 # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever
395 # starts returning 'IGNORE', we'll need to switch to something more
396 # clever. I don't expect that to happen.
400 #When we call die, trap it and log->crit with the value of the die.
402 $SIG{__DIE__} = sub {
403 # if we are not in eval and perl is not parsing code
404 # then rollback transactions and log RT error
405 unless ($^S || !defined $^S ) {
406 $RT::Handle->Rollback(1) if $RT::Handle;
407 $RT::Logger->crit("$_[0]") if $RT::Logger;
414 sub CheckPerlRequirements {
415 if ($^V < 5.008003) {
416 die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V;
419 # use $error here so the following "die" can still affect the global $@
426 require Scalar::Util;
427 Scalar::Util::weaken($y);
435 RT requires the Scalar::Util module be built with support for the 'weaken'
438 It is sometimes the case that operating system upgrades will replace
439 a working Scalar::Util with a non-working one. If your system was working
440 correctly up until now, this is likely the cause of the problem.
442 Please reinstall Scalar::Util, being careful to let it build with your C
443 compiler. Usually this is as simple as running the following command as
446 perl -MCPAN -e'install Scalar::Util'
455 Load all modules that define base classes.
460 shift if @_%2; # so we can call it as a function or method
463 require RT::Transactions;
464 require RT::Attachments;
466 require RT::Principals;
467 require RT::CurrentUser;
468 require RT::Templates;
470 require RT::ScripActions;
471 require RT::ScripConditions;
474 require RT::GroupMembers;
475 require RT::CustomFields;
476 require RT::CustomFieldValues;
477 require RT::ObjectCustomFields;
478 require RT::ObjectCustomFieldValues;
479 require RT::Attributes;
480 require RT::Dashboard;
481 require RT::Approval;
482 require RT::Lifecycle;
486 require RT::Articles;
489 require RT::ObjectClass;
490 require RT::ObjectClasses;
491 require RT::ObjectTopic;
492 require RT::ObjectTopics;
496 # on a cold server (just after restart) people could have an object
497 # in the session, as we deserialize it so we never call constructor
498 # of the class, so the list of accessible fields is empty and we die
499 # with "Method xxx is not implemented in RT::SomeClass"
501 # without this, we also can never call _ClassAccessible, because we
502 # won't have filled RT::Record::_TABLE_ATTR
503 $_->_BuildTableAttributes foreach qw(
518 RT::ObjectCustomField
519 RT::ObjectCustomFieldValue
530 if ( $args{'Heavy'} ) {
531 # load scrips' modules
532 my $scrips = RT::Scrips->new(RT->SystemUser);
533 $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' );
534 while ( my $scrip = $scrips->Next ) {
536 eval { $scrip->LoadModules } or
537 $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ".
538 "You should delete or repair this Scrip in the admin UI.\n$@\n");
541 foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
543 eval "require $class; 1" or $RT::Logger->error(
544 "Class '$class' is listed in CustomFieldValuesSources option"
545 ." in the config, but we failed to load it:\n$@\n"
552 =head2 InitSystemObjects
554 Initializes system objects: C<$RT::System>, C<< RT->SystemUser >>
555 and C<< RT->Nobody >>.
559 sub InitSystemObjects {
561 #RT's system user is a genuine database user. its id lives here
562 require RT::CurrentUser;
563 $SystemUser = RT::CurrentUser->new;
564 $SystemUser->LoadByName('RT_System');
566 #RT's "nobody user" is a genuine database user. its ID lives here.
567 $Nobody = RT::CurrentUser->new;
568 $Nobody->LoadByName('Nobody');
571 $System = RT::System->new( $SystemUser );
578 Returns the current L<config object|RT::Config>, but note that
579 you must L<load config|/LoadConfig> first otherwise this method
582 Method can be called as class method.
586 sub Config { return $Config || shift->LoadConfig(); }
588 =head2 DatabaseHandle
590 Returns the current L<database handle object|RT::Handle>.
592 See also L</ConnectToDatabase>.
596 sub DatabaseHandle { return $Handle }
600 Returns the logger. See also L</InitLogging>.
604 sub Logger { return $Logger }
608 Returns the current L<system object|RT::System>. See also
609 L</InitSystemObjects>.
613 sub System { return $System }
617 Returns the system user's object, it's object of
618 L<RT::CurrentUser> class that represents the system. See also
619 L</InitSystemObjects>.
623 sub SystemUser { return $SystemUser }
627 Returns object of Nobody. It's object of L<RT::CurrentUser> class
628 that represents a user who can own ticket and nothing else. See
629 also L</InitSystemObjects>.
633 sub Nobody { return $Nobody }
635 sub PrivilegedUsers {
637 $_Privileged = RT::Group->new(RT->SystemUser);
638 $_Privileged->LoadSystemInternalGroup('Privileged');
643 sub UnprivilegedUsers {
644 if (!$_Unprivileged) {
645 $_Unprivileged = RT::Group->new(RT->SystemUser);
646 $_Unprivileged->LoadSystemInternalGroup('Unprivileged');
648 return $_Unprivileged;
654 Returns a listref of all Plugins currently configured for this RT instance.
655 You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
663 $self->InitPluginPaths;
664 @PLUGINS = $self->InitPlugins;
671 Takes an optional subdir (e.g. po, lib, etc.) and returns a list of
672 directories from plugins where that subdirectory exists.
674 This code does not check plugin names, plugin validitity, or load
675 plugins (see L</InitPlugins>) in any way, and requires that RT's
676 configuration have been already loaded.
687 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
688 my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
689 next unless -d $path;
695 =head2 InitPluginPaths
697 Push plugins' lib paths into @INC right after F<local/lib>.
698 In case F<local/lib> isn't in @INC, append them to @INC
702 sub InitPluginPaths {
703 my $self = shift || __PACKAGE__;
705 my @lib_dirs = $self->PluginDirs('lib');
710 if ( Cwd::realpath($_) eq $RT::LocalLibPath) {
711 push @tmp_inc, $_, @lib_dirs;
718 # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
719 push @tmp_inc, @lib_dirs unless $added;
722 @INC = grep !$seen{$_}++, @tmp_inc;
727 Initialize all Plugins found in the RT configuration file, setting up
728 their lib and L<HTML::Mason> component roots.
736 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
738 die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
739 push @plugins, RT::Plugin->new(name =>$plugin);
748 my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
749 if ($_[0] and $integrity) {
750 # Trying to turn install mode on but we have a good DB!
753 Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!")
757 $_INSTALL_MODE = shift;
759 require RT::CurrentUser;
760 $SystemUser = RT::CurrentUser->new();
764 return $_INSTALL_MODE;
767 sub LoadGeneratedData {
769 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
771 require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@";
772 $class->CanonicalizeGeneratedPaths();
775 sub CanonicalizeGeneratedPaths {
777 unless ( File::Spec->file_name_is_absolute($EtcPath) ) {
779 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
780 # otherwise RT.pm will make the source dir(where we configure RT) be the
781 # BasePath instead of the one specified by --prefix
782 unless ( -d $BasePath
783 && File::Spec->file_name_is_absolute($BasePath) )
785 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
787 # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
788 # is not always absolute
789 $BasePath = File::Spec->rel2abs(
790 File::Spec->catdir( $pm_path, File::Spec->updir ) );
793 $BasePath = Cwd::realpath($BasePath);
796 qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath
797 LocalLibPath LexiconPath LocalLexiconPath PluginPath
798 LocalPluginPath MasonComponentRoot MasonLocalComponentRoot
799 MasonDataDir MasonSessionDir/
804 # just change relative ones
805 $$path = File::Spec->catfile( $BasePath, $$path )
806 unless File::Spec->file_name_is_absolute($$path);
814 helper method to add js files to C<JSFiles> config.
815 to add extra js files, you can add the following line
816 in the plugin's main file:
818 RT->AddJavaScript( 'foo.js', 'bar.js' );
825 my @old = RT->Config->Get('JSFiles');
826 RT->Config->Set( 'JSFiles', @old, @_ );
827 return RT->Config->Get('JSFiles');
830 =head2 AddStyleSheets
832 helper method to add css files to C<CSSFiles> config
834 to add extra css files, you can add the following line
835 in the plugin's main file:
837 RT->AddStyleSheets( 'foo.css', 'bar.css' );
843 my @old = RT->Config->Get('CSSFiles');
844 RT->Config->Set( 'CSSFiles', @old, @_ );
845 return RT->Config->Get('CSSFiles');
850 helper method of RT->Config->Get('JSFiles')
855 return RT->Config->Get('JSFiles');
860 helper method of RT->Config->Get('CSSFiles')
865 return RT->Config->Get('CSSFiles');
870 Please report them to rt-bugs@bestpractical.com, if you know what's
871 broken and have at least some idea of what needs to be fixed.
873 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
878 L<DBIx::SearchBuilder>
883 RT::Base->_ImportOverlays();