rt/lib/RT.pm

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