1# BEGIN BPS TAGGED BLOCK {{{ 2# 3# COPYRIGHT: 4# 5# This software is Copyright (c) 1996-2021 Best Practical Solutions, LLC 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 49use strict; 50use warnings; 51use 5.010; 52 53package RT; 54 55 56use Encode (); 57use File::Spec (); 58use Cwd (); 59use Scalar::Util qw(blessed); 60use UNIVERSAL::require; 61 62use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE); 63 64use vars qw($BasePath 65 $EtcPath 66 $BinPath 67 $SbinPath 68 $VarPath 69 $FontPath 70 $LexiconPath 71 $StaticPath 72 $PluginPath 73 $LocalPath 74 $LocalEtcPath 75 $LocalLibPath 76 $LocalLexiconPath 77 $LocalStaticPath 78 $LocalPluginPath 79 $MasonComponentRoot 80 $MasonLocalComponentRoot 81 $MasonDataDir 82 $MasonSessionDir); 83 84# Set Email::Address module var before anything else loads. 85# This avoids an algorithmic complexity denial of service vulnerability. 86# See T#157608 and CVE-2015-7686 for more information. 87$Email::Address::COMMENT_NEST_LEVEL = 1; 88 89RT->LoadGeneratedData(); 90 91=head1 NAME 92 93RT - Request Tracker 94 95=head1 SYNOPSIS 96 97A fully featured request tracker package. 98 99This documentation describes the point-of-entry for RT's Perl API. To learn 100more about what RT is and what it can do for you, visit 101L<https://bestpractical.com/rt>. 102 103=head1 DESCRIPTION 104 105=head2 INITIALIZATION 106 107If you're using RT's Perl libraries, you need to initialize RT before using any 108of the modules. 109 110You have the option of handling the timing of config loading and the actual 111init sequence yourself with: 112 113 use RT; 114 BEGIN { 115 RT->LoadConfig; 116 RT->Init; 117 } 118 119or you can let RT do it all: 120 121 use RT -init; 122 123This second method is particular useful when writing one-liners to interact with RT: 124 125 perl -MRT=-init -e '...' 126 127The first method is necessary if you need to delay or conditionalize 128initialization or if you want to fiddle with C<< RT->Config >> between loading 129the config files and initializing the RT environment. 130 131=cut 132 133{ 134 my $DID_IMPORT_INIT; 135 sub import { 136 my $class = shift; 137 my $action = shift || ''; 138 139 if ($action eq "-init" and not $DID_IMPORT_INIT) { 140 $class->LoadConfig; 141 $class->Init; 142 $DID_IMPORT_INIT = 1; 143 } 144 } 145} 146 147=head2 LoadConfig 148 149Load RT's config file. First, the site configuration file 150(F<RT_SiteConfig.pm>) is loaded, in order to establish overall site 151settings like hostname and name of RT instance. Then, the core 152configuration file (F<RT_Config.pm>) is loaded to set fallback values 153for all settings; it bases some values on settings from the site 154configuration file. 155 156In order for the core configuration to not override the site's 157settings, the function C<Set> is used; it only sets values if they 158have not been set already. 159 160=cut 161 162sub LoadConfig { 163 require RT::Config; 164 $Config = RT::Config->new; 165 $Config->LoadConfigs; 166 require RT::I18N; 167 168 # RT::Essentials mistakenly recommends that WebPath be set to '/'. 169 # If the user does that, do what they mean. 170 $RT::WebPath = '' if ($RT::WebPath eq '/'); 171 172 # Fix relative LogDir; It cannot be fixed in a PostLoadCheck, as 173 # they are run after logging is enabled. 174 unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) { 175 $Config->Set( LogDir => 176 File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) ); 177 } 178 179 return $Config; 180} 181 182=head2 Init 183 184L<Connects to the database|/ConnectToDatabase>, L<initilizes system 185objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets 186up logging|/InitLogging>, and L<loads plugins|/InitPlugins>. 187 188=cut 189 190sub Init { 191 shift if @_%2; # code is inconsistent about calling as method 192 my %args = (@_); 193 194 CheckPerlRequirements(); 195 196 InitPluginPaths(); 197 198 #Get a database connection 199 ConnectToDatabase(); 200 InitSystemObjects(); 201 InitClasses(%args); 202 RT->Config->LoadConfigFromDatabase() unless $args{SkipConfigurations}; 203 InitLogging(); 204 ProcessPreInitMessages(); 205 InitPlugins(); 206 _BuildTableAttributes(); 207 RT::I18N->Init; 208 RT::CustomRoles->RegisterRoles unless $args{SkipCustomRoles}; 209 RT->Config->PostLoadCheck; 210 RT::Lifecycle->FillCache; 211} 212 213=head2 ConnectToDatabase 214 215Get a database connection. See also L</Handle>. 216 217=cut 218 219sub ConnectToDatabase { 220 require RT::Handle; 221 $Handle = RT::Handle->new unless $Handle; 222 $Handle->Connect; 223 return $Handle; 224} 225 226=head2 InitLogging 227 228Create the Logger object and set up signal handlers. 229 230=cut 231 232sub InitLogging { 233 234 # We have to set the record separator ($, man perlvar) 235 # or Log::Dispatch starts getting 236 # really pissy, as some other module we use unsets it. 237 $, = ''; 238 use Log::Dispatch 1.6; 239 240 my %level_to_num = ( 241 map( { $_ => } 0..7 ), 242 debug => 0, 243 info => 1, 244 notice => 2, 245 warning => 3, 246 error => 4, 'err' => 4, 247 critical => 5, crit => 5, 248 alert => 6, 249 emergency => 7, emerg => 7, 250 ); 251 252 unless ( $RT::Logger ) { 253 254 # preload UTF-8 encoding so that Encode:encode doesn't fail to load 255 # as part of throwing an exception 256 Encode::encode("UTF-8",""); 257 258 $RT::Logger = Log::Dispatch->new; 259 260 my $stack_from_level; 261 if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) { 262 # if option has old style '\d'(true) value 263 $stack_from_level = 0 if $stack_from_level =~ /^\d+$/; 264 $stack_from_level = $level_to_num{ $stack_from_level } || 0; 265 } else { 266 $stack_from_level = 99; # don't log 267 } 268 269 my $simple_cb = sub { 270 # if this code throw any warning we can get segfault 271 no warnings; 272 my %p = @_; 273 274 # skip Log::* stack frames 275 my $frame = 0; 276 $frame++ while caller($frame) && caller($frame) =~ /^Log::/; 277 my ($package, $filename, $line) = caller($frame); 278 279 # Encode to bytes, so we don't send wide characters 280 $p{message} = Encode::encode("UTF-8", $p{message}); 281 282 $p{'message'} =~ s/(?:\r*\n)+$//; 283 return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: " 284 . $p{'message'} ." ($filename:$line)\n"; 285 }; 286 287 my $syslog_cb = sub { 288 # if this code throw any warning we can get segfault 289 no warnings; 290 my %p = @_; 291 292 my $frame = 0; # stack frame index 293 # skip Log::* stack frames 294 $frame++ while caller($frame) && caller($frame) =~ /^Log::/; 295 my ($package, $filename, $line) = caller($frame); 296 297 # Encode to bytes, so we don't send wide characters 298 $p{message} = Encode::encode("UTF-8", $p{message}); 299 300 $p{message} =~ s/(?:\r*\n)+$//; 301 if ($p{level} eq 'debug') { 302 return "[$$] $p{message} ($filename:$line)\n"; 303 } else { 304 return "[$$] $p{message}\n"; 305 } 306 }; 307 308 my $stack_cb = sub { 309 no warnings; 310 my %p = @_; 311 return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level; 312 313 require Devel::StackTrace; 314 my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] ); 315 return $p{'message'} . $trace->as_string; 316 317 # skip calling of the Log::* subroutins 318 my $frame = 0; 319 $frame++ while caller($frame) && caller($frame) =~ /^Log::/; 320 $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/; 321 322 $p{'message'} .= "\nStack trace:\n"; 323 while( my ($package, $filename, $line, $sub) = caller($frame++) ) { 324 $p{'message'} .= "\t$sub(...) called at $filename:$line\n"; 325 } 326 return $p{'message'}; 327 }; 328 329 if ( $Config->Get('LogToFile') ) { 330 my ($filename, $logdir) = ( 331 $Config->Get('LogToFileNamed') || 'rt.log', 332 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ), 333 ); 334 if ( $filename =~ m![/\\]! ) { # looks like an absolute path. 335 ($logdir) = $filename =~ m{^(.*[/\\])}; 336 } 337 else { 338 $filename = File::Spec->catfile( $logdir, $filename ); 339 } 340 341 unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) { 342 # localizing here would be hard when we don't have a current user yet 343 die "Log file '$filename' couldn't be written or created.\n RT can't run."; 344 } 345 346 require Log::Dispatch::File; 347 $RT::Logger->add( Log::Dispatch::File->new 348 ( name=>'file', 349 min_level=> $Config->Get('LogToFile'), 350 filename=> $filename, 351 mode=>'append', 352 callbacks => [ $simple_cb, $stack_cb ], 353 )); 354 } 355 if ( $Config->Get('LogToSTDERR') ) { 356 require Log::Dispatch::Screen; 357 $RT::Logger->add( Log::Dispatch::Screen->new 358 ( name => 'screen', 359 min_level => $Config->Get('LogToSTDERR'), 360 callbacks => [ $simple_cb, $stack_cb ], 361 stderr => 1, 362 )); 363 } 364 if ( $Config->Get('LogToSyslog') ) { 365 require Log::Dispatch::Syslog; 366 $RT::Logger->add(Log::Dispatch::Syslog->new 367 ( name => 'syslog', 368 ident => 'RT', 369 min_level => $Config->Get('LogToSyslog'), 370 callbacks => [ $syslog_cb, $stack_cb ], 371 stderr => 1, 372 $Config->Get('LogToSyslogConf'), 373 )); 374 } 375 } 376 InitSignalHandlers(); 377} 378 379# Some messages may have been logged before the logger was available. 380# Output them here. 381 382sub ProcessPreInitMessages { 383 foreach my $message ( @RT::Config::PreInitLoggerMessages ){ 384 RT->Logger->debug($message); 385 } 386} 387 388sub InitSignalHandlers { 389 390# Signal handlers 391## This is the default handling of warnings and die'ings in the code 392## (including other used modules - maybe except for errors catched by 393## Mason). It will log all problems through the standard logging 394## mechanism (see above). 395 396 $SIG{__WARN__} = sub { 397 # use 'goto &foo' syntax to hide ANON sub from stack 398 unshift @_, $RT::Logger, qw(level warning message); 399 goto &Log::Dispatch::log; 400 }; 401 402#When we call die, trap it and log->crit with the value of the die. 403 404 $SIG{__DIE__} = sub { 405 # if we are not in eval and perl is not parsing code 406 # then rollback transactions and log RT error 407 unless ($^S || !defined $^S ) { 408 $RT::Handle->Rollback(1) if $RT::Handle; 409 $RT::Logger->crit("$_[0]") if $RT::Logger; 410 } 411 die $_[0]; 412 }; 413} 414 415 416sub CheckPerlRequirements { 417 eval {require 5.010_001}; 418 if ($@) { 419 die sprintf "RT requires Perl v5.10.1 or newer. Your current Perl is v%vd\n", $^V; 420 } 421 422 # use $error here so the following "die" can still affect the global $@ 423 my $error; 424 { 425 local $@; 426 eval { 427 my $x = ''; 428 my $y = \$x; 429 require Scalar::Util; 430 Scalar::Util::weaken($y); 431 }; 432 $error = $@; 433 } 434 435 if ($error) { 436 die <<"EOF"; 437 438RT requires the Scalar::Util module be built with support for the 'weaken' 439function. 440 441It is sometimes the case that operating system upgrades will replace 442a working Scalar::Util with a non-working one. If your system was working 443correctly up until now, this is likely the cause of the problem. 444 445Please reinstall Scalar::Util, being careful to let it build with your C 446compiler. Usually this is as simple as running the following command as 447root. 448 449 perl -MCPAN -e'install Scalar::Util' 450 451EOF 452 453 } 454} 455 456=head2 InitClasses 457 458Load all modules that define base classes. 459 460=cut 461 462sub InitClasses { 463 shift if @_%2; # so we can call it as a function or method 464 my %args = (@_); 465 require RT::Tickets; 466 require RT::Transactions; 467 require RT::Attachments; 468 require RT::Users; 469 require RT::Principals; 470 require RT::CurrentUser; 471 require RT::Templates; 472 require RT::Queues; 473 require RT::ScripActions; 474 require RT::ScripConditions; 475 require RT::Scrips; 476 require RT::Groups; 477 require RT::GroupMembers; 478 require RT::CustomFields; 479 require RT::CustomFieldValues; 480 require RT::ObjectCustomFields; 481 require RT::ObjectCustomFieldValues; 482 require RT::CustomRoles; 483 require RT::ObjectCustomRoles; 484 require RT::Attributes; 485 require RT::Dashboard; 486 require RT::Approval; 487 require RT::Lifecycle; 488 require RT::Link; 489 require RT::Links; 490 require RT::Article; 491 require RT::Articles; 492 require RT::Class; 493 require RT::Classes; 494 require RT::ObjectClass; 495 require RT::ObjectClasses; 496 require RT::ObjectTopic; 497 require RT::ObjectTopics; 498 require RT::Topic; 499 require RT::Topics; 500 require RT::Link; 501 require RT::Links; 502 require RT::Catalog; 503 require RT::Catalogs; 504 require RT::Asset; 505 require RT::Assets; 506 require RT::CustomFieldValues::Canonicalizer; 507 require RT::Configuration; 508 require RT::Configurations; 509 require RT::REST2; 510 require RT::Authen::Token; 511 512 _BuildTableAttributes(); 513 514 if ( $args{'Heavy'} ) { 515 # load scrips' modules 516 my $scrips = RT::Scrips->new(RT->SystemUser); 517 while ( my $scrip = $scrips->Next ) { 518 local $@; 519 eval { $scrip->LoadModules } or 520 $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ". 521 "You should delete or repair this Scrip in the admin UI.\n$@\n"); 522 } 523 524 foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) { 525 $class->require or $RT::Logger->error( 526 "Class '$class' is listed in CustomFieldValuesSources option" 527 ." in the config, but we failed to load it:\n$@\n" 528 ); 529 } 530 531 } 532} 533 534sub _BuildTableAttributes { 535 # on a cold server (just after restart) people could have an object 536 # in the session, as we deserialize it so we never call constructor 537 # of the class, so the list of accessible fields is empty and we die 538 # with "Method xxx is not implemented in RT::SomeClass" 539 540 # without this, we also can never call _ClassAccessible, because we 541 # won't have filled RT::Record::_TABLE_ATTR 542 $_->_BuildTableAttributes foreach qw( 543 RT::Ticket 544 RT::Transaction 545 RT::Attachment 546 RT::User 547 RT::Principal 548 RT::Template 549 RT::Queue 550 RT::ScripAction 551 RT::ScripCondition 552 RT::Scrip 553 RT::ObjectScrip 554 RT::Group 555 RT::GroupMember 556 RT::CustomField 557 RT::CustomFieldValue 558 RT::ObjectCustomField 559 RT::ObjectCustomFieldValue 560 RT::Attribute 561 RT::ACE 562 RT::Article 563 RT::Class 564 RT::Link 565 RT::ObjectClass 566 RT::ObjectTopic 567 RT::Topic 568 RT::Asset 569 RT::Catalog 570 RT::CustomRole 571 RT::ObjectCustomRole 572 ); 573} 574 575=head2 InitSystemObjects 576 577Initializes system objects: C<$RT::System>, C<< RT->SystemUser >> 578and C<< RT->Nobody >>. 579 580=cut 581 582sub InitSystemObjects { 583 584 #RT's system user is a genuine database user. its id lives here 585 require RT::CurrentUser; 586 $SystemUser = RT::CurrentUser->new; 587 $SystemUser->LoadByName('RT_System'); 588 589 #RT's "nobody user" is a genuine database user. its ID lives here. 590 $Nobody = RT::CurrentUser->new; 591 $Nobody->LoadByName('Nobody'); 592 593 require RT::System; 594 $System = RT::System->new( $SystemUser ); 595} 596 597=head1 CLASS METHODS 598 599=head2 Config 600 601Returns the current L<config object|RT::Config>, but note that 602you must L<load config|/LoadConfig> first otherwise this method 603returns undef. 604 605Method can be called as class method. 606 607=cut 608 609sub Config { return $Config || shift->LoadConfig(); } 610 611=head2 DatabaseHandle 612 613Returns the current L<database handle object|RT::Handle>. 614 615See also L</ConnectToDatabase>. 616 617=cut 618 619sub DatabaseHandle { return $Handle } 620 621=head2 Logger 622 623Returns the logger. See also L</InitLogging>. 624 625=cut 626 627sub Logger { return $Logger } 628 629=head2 System 630 631Returns the current L<system object|RT::System>. See also 632L</InitSystemObjects>. 633 634=cut 635 636sub System { return $System } 637 638=head2 SystemUser 639 640Returns the system user's object, it's object of 641L<RT::CurrentUser> class that represents the system. See also 642L</InitSystemObjects>. 643 644=cut 645 646sub SystemUser { return $SystemUser } 647 648=head2 Nobody 649 650Returns object of Nobody. It's object of L<RT::CurrentUser> class 651that represents a user who can own ticket and nothing else. See 652also L</InitSystemObjects>. 653 654=cut 655 656sub Nobody { return $Nobody } 657 658sub PrivilegedUsers { 659 if (!$_Privileged) { 660 $_Privileged = RT::Group->new(RT->SystemUser); 661 $_Privileged->LoadSystemInternalGroup('Privileged'); 662 } 663 return $_Privileged; 664} 665 666sub UnprivilegedUsers { 667 if (!$_Unprivileged) { 668 $_Unprivileged = RT::Group->new(RT->SystemUser); 669 $_Unprivileged->LoadSystemInternalGroup('Unprivileged'); 670 } 671 return $_Unprivileged; 672} 673 674 675=head2 Plugins 676 677Returns a listref of all Plugins currently configured for this RT instance. 678You can define plugins by adding them to the @Plugins list in your RT_SiteConfig 679 680=cut 681 682sub Plugins { 683 state @PLUGINS; 684 state $DID_INIT = 0; 685 686 my $self = shift; 687 unless ($DID_INIT) { 688 $self->InitPluginPaths; 689 @PLUGINS = $self->InitPlugins; 690 $DID_INIT++; 691 } 692 return [@PLUGINS]; 693} 694 695=head2 PluginDirs 696 697Takes an optional subdir (e.g. po, lib, etc.) and returns a list of 698directories from plugins where that subdirectory exists. 699 700This code does not check plugin names, plugin validitity, or load 701plugins (see L</InitPlugins>) in any way, and requires that RT's 702configuration have been already loaded. 703 704=cut 705 706sub PluginDirs { 707 my $self = shift; 708 my $subdir = shift; 709 710 require RT::Plugin; 711 712 my @res; 713 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { 714 my $path = RT::Plugin->new( name => $plugin )->Path( $subdir ); 715 next unless -d $path; 716 push @res, $path; 717 } 718 return @res; 719} 720 721=head2 InitPluginPaths 722 723Push plugins' lib paths into @INC right after F<local/lib>. 724In case F<local/lib> isn't in @INC, append them to @INC 725 726=cut 727 728sub InitPluginPaths { 729 my $self = shift || __PACKAGE__; 730 731 my @lib_dirs = $self->PluginDirs('lib'); 732 733 my @tmp_inc; 734 my $added; 735 for (@INC) { 736 my $realpath = Cwd::realpath($_); 737 next unless defined $realpath; 738 if ( $realpath eq $RT::LocalLibPath) { 739 push @tmp_inc, $_, @lib_dirs; 740 $added = 1; 741 } else { 742 push @tmp_inc, $_; 743 } 744 } 745 746 # append @lib_dirs in case $RT::LocalLibPath isn't in @INC 747 push @tmp_inc, @lib_dirs unless $added; 748 749 my %seen; 750 @INC = grep !$seen{$_}++, @tmp_inc; 751} 752 753=head2 InitPlugins 754 755Initialize all Plugins found in the RT configuration file, setting up 756their lib and L<HTML::Mason> component roots. 757 758=cut 759 760our %CORED_PLUGINS = ( 761 'RT::Extension::SLA' => '4.4', 762 'RT::Extension::ExternalStorage' => '4.4', 763 'RT::Extension::Assets' => '4.4', 764 'RT::Authen::ExternalAuth' => '4.4', 765 'RT::Extension::LDAPImport' => '4.4', 766 'RT::Extension::SpawnLinkedTicketInQueue' => '4.4', 767 'RT::Extension::ParentTimeWorked' => '4.4', 768 'RT::Extension::FutureMailgate' => '4.4', 769 'RT::Extension::AdminConditionsAndActions' => '4.4.2', 770 'RT::Extension::RightsInspector' => '5.0', 771 'RT::Extension::ConfigInDatabase' => '5.0', 772 'RT::Extension::CustomRole::Visibility' => '5.0', 773 'RT::Extension::PriorityAsString' => '5.0', 774 'RT::Extension::AssetSQL' => '5.0', 775 'RT::Extension::LifecycleUI' => '5.0', 776 'RT::Extension::REST2' => '5.0', 777 'RT::Authen::Token' => '5.0', 778 'RT::Extension::QuoteSelection' => 5.0, 779 'RT::Extension::FormattedTransactions' => '5.0.1', 780); 781 782sub InitPlugins { 783 my $self = shift; 784 my @plugins; 785 require RT::Plugin; 786 foreach my $plugin (grep $_, RT->Config->Get('Plugins')) { 787 if ( $CORED_PLUGINS{$plugin} ) { 788 RT->Logger->warning( "$plugin has been cored since RT $CORED_PLUGINS{$plugin}, please check the upgrade document for more details" ); 789 } 790 $plugin->require; 791 die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR); 792 push @plugins, RT::Plugin->new(name =>$plugin); 793 } 794 return @plugins; 795} 796 797 798sub InstallMode { 799 my $self = shift; 800 if (@_) { 801 my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; 802 if ($_[0] and $integrity) { 803 # Trying to turn install mode on but we have a good DB! 804 require Carp; 805 $RT::Logger->error( 806 Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!") 807 ); 808 } 809 else { 810 $_INSTALL_MODE = shift; 811 if($_INSTALL_MODE) { 812 require RT::CurrentUser; 813 $SystemUser = RT::CurrentUser->new(); 814 } 815 } 816 } 817 return $_INSTALL_MODE; 818} 819 820sub LoadGeneratedData { 821 my $class = shift; 822 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; 823 $pm_path = File::Spec->rel2abs( $pm_path ); 824 825 require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@"; 826 $class->CanonicalizeGeneratedPaths(); 827} 828 829sub CanonicalizeGeneratedPaths { 830 my $class = shift; 831 unless ( File::Spec->file_name_is_absolute($EtcPath) ) { 832 833 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}. 834 # otherwise RT.pm will make the source dir(where we configure RT) be the 835 # BasePath instead of the one specified by --prefix 836 unless ( -d $BasePath 837 && File::Spec->file_name_is_absolute($BasePath) ) 838 { 839 my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1]; 840 841 # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'} 842 # is not always absolute 843 $BasePath = File::Spec->rel2abs( 844 File::Spec->catdir( $pm_path, File::Spec->updir ) ); 845 } 846 847 $BasePath = Cwd::realpath($BasePath); 848 849 for my $path ( 850 qw/EtcPath BinPath SbinPath VarPath LocalPath StaticPath LocalEtcPath 851 LocalLibPath LexiconPath LocalLexiconPath PluginPath FontPath 852 LocalPluginPath LocalStaticPath MasonComponentRoot MasonLocalComponentRoot 853 MasonDataDir MasonSessionDir/ 854 ) 855 { 856 no strict 'refs'; 857 858 # just change relative ones 859 $$path = File::Spec->catfile( $BasePath, $$path ) 860 unless File::Spec->file_name_is_absolute($$path); 861 } 862 } 863 864} 865 866=head2 AddJavaScript 867 868Helper method to add JS files to the C<@JSFiles> config at runtime. 869 870To add files, you can add the following line to your extension's main C<.pm> 871file: 872 873 RT->AddJavaScript( 'foo.js', 'bar.js' ); 874 875Files are expected to be in a static root in a F<js/> directory, such as 876F<static/js/> in your extension or F<local/static/js/> for local overlays. 877 878=cut 879 880sub AddJavaScript { 881 my $self = shift; 882 883 my @old = RT->Config->Get('JSFiles'); 884 RT->Config->Set( 'JSFiles', @old, @_ ); 885 return RT->Config->Get('JSFiles'); 886} 887 888=head2 AddStyleSheets 889 890Helper method to add CSS files to the C<@CSSFiles> config at runtime. 891 892To add files, you can add the following line to your extension's main C<.pm> 893file: 894 895 RT->AddStyleSheets( 'foo.css', 'bar.css' ); 896 897Files are expected to be in a static root in a F<css/> directory, such as 898F<static/css/> in your extension or F<local/static/css/> for local 899overlays. 900 901=cut 902 903sub AddStyleSheets { 904 my $self = shift; 905 my @old = RT->Config->Get('CSSFiles'); 906 RT->Config->Set( 'CSSFiles', @old, @_ ); 907 return RT->Config->Get('CSSFiles'); 908} 909 910=head2 JavaScript 911 912helper method of RT->Config->Get('JSFiles') 913 914=cut 915 916sub JavaScript { 917 return RT->Config->Get('JSFiles'); 918} 919 920=head2 StyleSheets 921 922helper method of RT->Config->Get('CSSFiles') 923 924=cut 925 926sub StyleSheets { 927 return RT->Config->Get('CSSFiles'); 928} 929 930=head2 Deprecated 931 932Notes that a particular call path is deprecated, and will be removed in 933a particular release. Puts a warning in the logs indicating such, along 934with a stack trace. 935 936Optional arguments include: 937 938=over 939 940=item Remove 941 942The release which is slated to remove the method or component 943 944=item Instead 945 946A suggestion of what to use in place of the deprecated API 947 948=item Arguments 949 950Used if not the entire method is being removed, merely a manner of 951calling it; names the arguments which are deprecated. 952 953=item Message 954 955Overrides the auto-built phrasing of C<Calling function ____ is 956deprecated> with a custom message. 957 958=item Detail 959 960Provides more context (e.g. callback paths) after the Message but before the 961Stack 962 963=item Object 964 965An L<RT::Record> object to print the class and numeric id of. Useful if the 966admin will need to hunt down a particular object to fix the deprecation 967warning. 968 969=back 970 971=cut 972 973sub Deprecated { 974 my $class = shift; 975 my %args = ( 976 Arguments => undef, 977 Remove => undef, 978 Instead => undef, 979 Message => undef, 980 Detail => undef, 981 Stack => 1, 982 LogLevel => "warn", 983 @_, 984 ); 985 986 my ($function) = (caller(1))[3]; 987 my $stack; 988 if ($function eq "HTML::Mason::Commands::__ANON__") { 989 eval { HTML::Mason::Exception->throw() }; 990 my $error = $@; 991 my $info = $error->analyze_error; 992 $function = "Mason component ".$info->{frames}[0]->filename; 993 $stack = join("\n", map { sprintf("\t[%s:%d]", $_->filename, $_->line) } @{$info->{frames}}); 994 } else { 995 $function = "function $function"; 996 $stack = Carp::longmess(); 997 } 998 $stack =~ s/^.*?\n//; # Strip off call to ->Deprecated 999 1000 my $msg; 1001 if ($args{Message}) { 1002 $msg = $args{Message}; 1003 } elsif ($args{Arguments}) { 1004 $msg = "Calling $function with $args{Arguments} is deprecated"; 1005 } else { 1006 $msg = "The $function is deprecated"; 1007 } 1008 $msg .= ", and will be removed in RT $args{Remove}" 1009 if $args{Remove}; 1010 $msg .= "."; 1011 1012 $msg .= " You should use $args{Instead} instead." 1013 if $args{Instead}; 1014 1015 $msg .= sprintf " Object: %s #%d.", blessed($args{Object}), $args{Object}->id 1016 if $args{Object}; 1017 1018 $msg .= "\n$args{Detail}\n" if $args{Detail}; 1019 1020 $msg .= " Call stack:\n$stack" if $args{Stack}; 1021 1022 my $loglevel = $args{LogLevel}; 1023 RT->Logger->$loglevel($msg); 1024} 1025 1026=head1 BUGS 1027 1028Please report them to rt-bugs@bestpractical.com, if you know what's 1029broken and have at least some idea of what needs to be fixed. 1030 1031If you're not sure what's going on, start a discussion in the RT Developers 1032category on the community forum at L<https://forum.bestpractical.com> or 1033send email to sales@bestpractical.com for professional assistance. 1034 1035=head1 SEE ALSO 1036 1037L<RT::StyleGuide> 1038L<DBIx::SearchBuilder> 1039 1040=cut 1041 1042require RT::Base; 1043RT::Base->_ImportOverlays(); 1044 10451; 1046