1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2016 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 Scalar::Util qw(blessed);
60 use UNIVERSAL::require;
62 use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE);
80 $MasonLocalComponentRoot
85 RT->LoadGeneratedData();
93 A fully featured request tracker package.
95 This documentation describes the point-of-entry for RT's Perl API. To learn
96 more about what RT is and what it can do for you, visit
97 L<https://bestpractical.com/rt>.
101 =head2 INITIALIZATION
103 If you're using RT's Perl libraries, you need to initialize RT before using any
106 You have the option of handling the timing of config loading and the actual
107 init sequence yourself with:
115 or you can let RT do it all:
119 This second method is particular useful when writing one-liners to interact with RT:
121 perl -MRT=-init -e '...'
123 The first method is necessary if you need to delay or conditionalize
124 initialization or if you want to fiddle with C<< RT->Config >> between loading
125 the config files and initializing the RT environment.
133 my $action = shift || '';
135 if ($action eq "-init" and not $DID_IMPORT_INIT) {
138 $DID_IMPORT_INIT = 1;
145 Load RT's config file. First, the site configuration file
146 (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
147 settings like hostname and name of RT instance. Then, the core
148 configuration file (F<RT_Config.pm>) is loaded to set fallback values
149 for all settings; it bases some values on settings from the site
152 In order for the core configuration to not override the site's
153 settings, the function C<Set> is used; it only sets values if they
154 have not been set already.
160 $Config = RT::Config->new;
161 $Config->LoadConfigs;
164 # RT::Essentials mistakenly recommends that WebPath be set to '/'.
165 # If the user does that, do what they mean.
166 $RT::WebPath = '' if ($RT::WebPath eq '/');
168 # Fix relative LogDir; It cannot be fixed in a PostLoadCheck, as
169 # they are run after logging is enabled.
170 unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
171 $Config->Set( LogDir =>
172 File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
180 L<Connects to the database|/ConnectToDatabase>, L<initilizes system
181 objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets
182 up logging|/InitLogging>, and L<loads plugins|/InitPlugins>.
187 shift if @_%2; # code is inconsistent about calling as method
190 CheckPerlRequirements();
194 #Get a database connection
200 _BuildTableAttributes();
202 RT->Config->PostLoadCheck;
203 RT::Lifecycle->FillCache;
206 =head2 ConnectToDatabase
208 Get a database connection. See also L</Handle>.
212 sub ConnectToDatabase {
214 $Handle = RT::Handle->new unless $Handle;
221 Create the Logger object and set up signal handlers.
229 # We have to set the record separator ($, man perlvar)
230 # or Log::Dispatch starts getting
231 # really pissy, as some other module we use unsets it.
233 use Log::Dispatch 1.6;
236 map( { $_ => } 0..7 ),
241 error => 4, 'err' => 4,
242 critical => 5, crit => 5,
244 emergency => 7, emerg => 7,
247 unless ( $RT::Logger ) {
249 $RT::Logger = Log::Dispatch->new;
251 my $stack_from_level;
252 if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) {
253 # if option has old style '\d'(true) value
254 $stack_from_level = 0 if $stack_from_level =~ /^\d+$/;
255 $stack_from_level = $level_to_num{ $stack_from_level } || 0;
257 $stack_from_level = 99; # don't log
260 my $simple_cb = sub {
261 # if this code throw any warning we can get segfault
265 # skip Log::* stack frames
267 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
268 my ($package, $filename, $line) = caller($frame);
270 # Encode to bytes, so we don't send wide characters
271 $p{message} = Encode::encode("UTF-8", $p{message});
273 $p{'message'} =~ s/(?:\r*\n)+$//;
274 return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: "
275 . $p{'message'} ." ($filename:$line)\n";
278 my $syslog_cb = sub {
279 # if this code throw any warning we can get segfault
283 my $frame = 0; # stack frame index
284 # skip Log::* stack frames
285 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
286 my ($package, $filename, $line) = caller($frame);
288 # Encode to bytes, so we don't send wide characters
289 $p{message} = Encode::encode("UTF-8", $p{message});
291 $p{message} =~ s/(?:\r*\n)+$//;
292 if ($p{level} eq 'debug') {
293 return "[$$] $p{message} ($filename:$line)\n";
295 return "[$$] $p{message}\n";
302 return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
304 require Devel::StackTrace;
305 my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
306 return $p{'message'} . $trace->as_string;
308 # skip calling of the Log::* subroutins
310 $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
311 $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
313 $p{'message'} .= "\nStack trace:\n";
314 while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
315 $p{'message'} .= "\t$sub(...) called at $filename:$line\n";
317 return $p{'message'};
320 if ( $Config->Get('LogToFile') ) {
321 my ($filename, $logdir) = (
322 $Config->Get('LogToFileNamed') || 'rt.log',
323 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
325 if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
326 ($logdir) = $filename =~ m{^(.*[/\\])};
329 $filename = File::Spec->catfile( $logdir, $filename );
332 unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
333 # localizing here would be hard when we don't have a current user yet
334 die "Log file '$filename' couldn't be written or created.\n RT can't run.";
337 require Log::Dispatch::File;
338 $RT::Logger->add( Log::Dispatch::File->new
340 min_level=> $Config->Get('LogToFile'),
341 filename=> $filename,
343 callbacks => [ $simple_cb, $stack_cb ],
346 if ( $Config->Get('LogToSTDERR') ) {
347 require Log::Dispatch::Screen;
348 $RT::Logger->add( Log::Dispatch::Screen->new
350 min_level => $Config->Get('LogToSTDERR'),
351 callbacks => [ $simple_cb, $stack_cb ],
355 if ( $Config->Get('LogToSyslog') ) {
356 require Log::Dispatch::Syslog;
357 $RT::Logger->add(Log::Dispatch::Syslog->new
360 min_level => $Config->Get('LogToSyslog'),
361 callbacks => [ $syslog_cb, $stack_cb ],
363 $Config->Get('LogToSyslogConf'),
367 InitSignalHandlers(%arg);
370 sub InitSignalHandlers {
373 return if $arg{'NoSignalHandlers'};
376 ## This is the default handling of warnings and die'ings in the code
377 ## (including other used modules - maybe except for errors catched by
378 ## Mason). It will log all problems through the standard logging
379 ## mechanism (see above).
381 $SIG{__WARN__} = sub {
382 # use 'goto &foo' syntax to hide ANON sub from stack
383 unshift @_, $RT::Logger, qw(level warning message);
384 goto &Log::Dispatch::log;
387 #When we call die, trap it and log->crit with the value of the die.
389 $SIG{__DIE__} = sub {
390 # if we are not in eval and perl is not parsing code
391 # then rollback transactions and log RT error
392 unless ($^S || !defined $^S ) {
393 $RT::Handle->Rollback(1) if $RT::Handle;
394 $RT::Logger->crit("$_[0]") if $RT::Logger;
401 sub CheckPerlRequirements {
402 eval {require 5.010_001};
404 die sprintf "RT requires Perl v5.10.1 or newer. Your current Perl is v%vd\n", $^V;
407 # use $error here so the following "die" can still affect the global $@
414 require Scalar::Util;
415 Scalar::Util::weaken($y);
423 RT requires the Scalar::Util module be built with support for the 'weaken'
426 It is sometimes the case that operating system upgrades will replace
427 a working Scalar::Util with a non-working one. If your system was working
428 correctly up until now, this is likely the cause of the problem.
430 Please reinstall Scalar::Util, being careful to let it build with your C
431 compiler. Usually this is as simple as running the following command as
434 perl -MCPAN -e'install Scalar::Util'
443 Load all modules that define base classes.
448 shift if @_%2; # so we can call it as a function or method
451 require RT::Transactions;
452 require RT::Attachments;
454 require RT::Principals;
455 require RT::CurrentUser;
456 require RT::Templates;
458 require RT::ScripActions;
459 require RT::ScripConditions;
462 require RT::GroupMembers;
463 require RT::CustomFields;
464 require RT::CustomFieldValues;
465 require RT::ObjectCustomFields;
466 require RT::ObjectCustomFieldValues;
467 require RT::Attributes;
468 require RT::Dashboard;
469 require RT::Approval;
470 require RT::Lifecycle;
474 require RT::Articles;
477 require RT::ObjectClass;
478 require RT::ObjectClasses;
479 require RT::ObjectTopic;
480 require RT::ObjectTopics;
486 _BuildTableAttributes();
488 if ( $args{'Heavy'} ) {
489 # load scrips' modules
490 my $scrips = RT::Scrips->new(RT->SystemUser);
491 while ( my $scrip = $scrips->Next ) {
493 eval { $scrip->LoadModules } or
494 $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ".
495 "You should delete or repair this Scrip in the admin UI.\n$@\n");
498 foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
499 $class->require or $RT::Logger->error(
500 "Class '$class' is listed in CustomFieldValuesSources option"
501 ." in the config, but we failed to load it:\n$@\n"
508 sub _BuildTableAttributes {
509 # on a cold server (just after restart) people could have an object
510 # in the session, as we deserialize it so we never call constructor
511 # of the class, so the list of accessible fields is empty and we die
512 # with "Method xxx is not implemented in RT::SomeClass"
514 # without this, we also can never call _ClassAccessible, because we
515 # won't have filled RT::Record::_TABLE_ATTR
516 $_->_BuildTableAttributes foreach qw(
532 RT::ObjectCustomField
533 RT::ObjectCustomFieldValue
545 =head2 InitSystemObjects
547 Initializes system objects: C<$RT::System>, C<< RT->SystemUser >>
548 and C<< RT->Nobody >>.
552 sub InitSystemObjects {
554 #RT's system user is a genuine database user. its id lives here
555 require RT::CurrentUser;
556 $SystemUser = RT::CurrentUser->new;
557 $SystemUser->LoadByName('RT_System');
559 #RT's "nobody user" is a genuine database user. its ID lives here.
560 $Nobody = RT::CurrentUser->new;
561 $Nobody->LoadByName('Nobody');
564 $System = RT::System->new( $SystemUser );
571 Returns the current L<config object|RT::Config>, but note that
572 you must L<load config|/LoadConfig> first otherwise this method
575 Method can be called as class method.
579 sub Config { return $Config || shift->LoadConfig(); }
581 =head2 DatabaseHandle
583 Returns the current L<database handle object|RT::Handle>.
585 See also L</ConnectToDatabase>.
589 sub DatabaseHandle { return $Handle }
593 Returns the logger. See also L</InitLogging>.
597 sub Logger { return $Logger }
601 Returns the current L<system object|RT::System>. See also
602 L</InitSystemObjects>.
606 sub System { return $System }
610 Returns the system user's object, it's object of
611 L<RT::CurrentUser> class that represents the system. See also
612 L</InitSystemObjects>.
616 sub SystemUser { return $SystemUser }
620 Returns object of Nobody. It's object of L<RT::CurrentUser> class
621 that represents a user who can own ticket and nothing else. See
622 also L</InitSystemObjects>.
626 sub Nobody { return $Nobody }
628 sub PrivilegedUsers {
630 $_Privileged = RT::Group->new(RT->SystemUser);
631 $_Privileged->LoadSystemInternalGroup('Privileged');
636 sub UnprivilegedUsers {
637 if (!$_Unprivileged) {
638 $_Unprivileged = RT::Group->new(RT->SystemUser);
639 $_Unprivileged->LoadSystemInternalGroup('Unprivileged');
641 return $_Unprivileged;
647 Returns a listref of all Plugins currently configured for this RT instance.
648 You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
658 $self->InitPluginPaths;
659 @PLUGINS = $self->InitPlugins;
667 Takes an optional subdir (e.g. po, lib, etc.) and returns a list of
668 directories from plugins where that subdirectory exists.
670 This code does not check plugin names, plugin validitity, or load
671 plugins (see L</InitPlugins>) in any way, and requires that RT's
672 configuration have been already loaded.
683 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
684 my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
685 next unless -d $path;
691 =head2 InitPluginPaths
693 Push plugins' lib paths into @INC right after F<local/lib>.
694 In case F<local/lib> isn't in @INC, append them to @INC
698 sub InitPluginPaths {
699 my $self = shift || __PACKAGE__;
701 my @lib_dirs = $self->PluginDirs('lib');
706 my $realpath = Cwd::realpath($_);
707 next unless defined $realpath;
708 if ( $realpath eq $RT::LocalLibPath) {
709 push @tmp_inc, $_, @lib_dirs;
716 # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
717 push @tmp_inc, @lib_dirs unless $added;
720 @INC = grep !$seen{$_}++, @tmp_inc;
725 Initialize all Plugins found in the RT configuration file, setting up
726 their lib and L<HTML::Mason> component roots.
734 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
736 die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
737 push @plugins, RT::Plugin->new(name =>$plugin);
746 my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
747 if ($_[0] and $integrity) {
748 # Trying to turn install mode on but we have a good DB!
751 Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!")
755 $_INSTALL_MODE = shift;
757 require RT::CurrentUser;
758 $SystemUser = RT::CurrentUser->new();
762 return $_INSTALL_MODE;
765 sub LoadGeneratedData {
767 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
769 require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@";
770 $class->CanonicalizeGeneratedPaths();
773 sub CanonicalizeGeneratedPaths {
775 unless ( File::Spec->file_name_is_absolute($EtcPath) ) {
777 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
778 # otherwise RT.pm will make the source dir(where we configure RT) be the
779 # BasePath instead of the one specified by --prefix
780 unless ( -d $BasePath
781 && File::Spec->file_name_is_absolute($BasePath) )
783 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
785 # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
786 # is not always absolute
787 $BasePath = File::Spec->rel2abs(
788 File::Spec->catdir( $pm_path, File::Spec->updir ) );
791 $BasePath = Cwd::realpath($BasePath);
794 qw/EtcPath BinPath SbinPath VarPath LocalPath StaticPath LocalEtcPath
795 LocalLibPath LexiconPath LocalLexiconPath PluginPath FontPath
796 LocalPluginPath LocalStaticPath MasonComponentRoot MasonLocalComponentRoot
797 MasonDataDir MasonSessionDir/
802 # just change relative ones
803 $$path = File::Spec->catfile( $BasePath, $$path )
804 unless File::Spec->file_name_is_absolute($$path);
812 Helper method to add JS files to the C<@JSFiles> config at runtime.
814 To add files, you can add the following line to your extension's main C<.pm>
817 RT->AddJavaScript( 'foo.js', 'bar.js' );
819 Files are expected to be in a static root in a F<js/> directory, such as
820 F<static/js/> in your extension or F<local/static/js/> for local overlays.
827 my @old = RT->Config->Get('JSFiles');
828 RT->Config->Set( 'JSFiles', @old, @_ );
829 return RT->Config->Get('JSFiles');
832 =head2 AddStyleSheets
834 Helper method to add CSS files to the C<@CSSFiles> config at runtime.
836 To add files, you can add the following line to your extension's main C<.pm>
839 RT->AddStyleSheets( 'foo.css', 'bar.css' );
841 Files are expected to be in a static root in a F<css/> directory, such as
842 F<static/css/> in your extension or F<local/static/css/> for local
849 my @old = RT->Config->Get('CSSFiles');
850 RT->Config->Set( 'CSSFiles', @old, @_ );
851 return RT->Config->Get('CSSFiles');
856 helper method of RT->Config->Get('JSFiles')
861 return RT->Config->Get('JSFiles');
866 helper method of RT->Config->Get('CSSFiles')
871 return RT->Config->Get('CSSFiles');
876 Notes that a particular call path is deprecated, and will be removed in
877 a particular release. Puts a warning in the logs indicating such, along
880 Optional arguments include:
886 The release which is slated to remove the method or component
890 A suggestion of what to use in place of the deprecated API
894 Used if not the entire method is being removed, merely a manner of
895 calling it; names the arguments which are deprecated.
899 Overrides the auto-built phrasing of C<Calling function ____ is
900 deprecated> with a custom message.
904 An L<RT::Record> object to print the class and numeric id of. Useful if the
905 admin will need to hunt down a particular object to fix the deprecation
924 my ($function) = (caller(1))[3];
926 if ($function eq "HTML::Mason::Commands::__ANON__") {
927 eval { HTML::Mason::Exception->throw() };
929 my $info = $error->analyze_error;
930 $function = "Mason component ".$info->{frames}[0]->filename;
931 $stack = join("\n", map { sprintf("\t[%s:%d]", $_->filename, $_->line) } @{$info->{frames}});
933 $function = "function $function";
934 $stack = Carp::longmess();
936 $stack =~ s/^.*?\n//; # Strip off call to ->Deprecated
939 if ($args{Message}) {
940 $msg = $args{Message};
941 } elsif ($args{Arguments}) {
942 $msg = "Calling $function with $args{Arguments} is deprecated";
944 $msg = "The $function is deprecated";
946 $msg .= ", and will be removed in RT $args{Remove}"
950 $msg .= " You should use $args{Instead} instead."
953 $msg .= sprintf " Object: %s #%d.", blessed($args{Object}), $args{Object}->id
956 $msg .= " Call stack:\n$stack" if $args{Stack};
958 my $loglevel = $args{LogLevel};
959 RT->Logger->$loglevel($msg);
964 Please report them to rt-bugs@bestpractical.com, if you know what's
965 broken and have at least some idea of what needs to be fixed.
967 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
972 L<DBIx::SearchBuilder>
977 RT::Base->_ImportOverlays();