rt/lib/RT.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 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
  85 RT->LoadGeneratedData();
  86
  87 =head1 NAME
  88
  89 RT - Request Tracker
  90
  91 =head1 SYNOPSIS
  92
  93 A fully featured request tracker package.
  94
  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>.
  98
  99 =head1 DESCRIPTION
 100
 101 =head2 INITIALIZATION
 102
 103 If you're using RT's Perl libraries, you need to initialize RT before using any
 104 of the modules.
 105
 106 You have the option of handling the timing of config loading and the actual
 107 init sequence yourself with:
 108
 109     use RT;
 110     BEGIN {
 111         RT->LoadConfig;
 112         RT->Init;
 113     }
 114
 115 or you can let RT do it all:
 116
 117     use RT -init;
 118
 119 This second method is particular useful when writing one-liners to interact with RT:
 120
 121     perl -MRT=-init -e '...'
 122
 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.
 126
 127 =cut
 128
 129 {
 130     my $DID_IMPORT_INIT;
 131     sub import {
 132         my $class  = shift;
 133         my $action = shift || '';
 134
 135         if ($action eq "-init" and not $DID_IMPORT_INIT) {
 136             $class->LoadConfig;
 137             $class->Init;
 138             $DID_IMPORT_INIT = 1;
 139         }
 140     }
 141 }
 142
 143 =head2 LoadConfig
 144
 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
 150 configuration file.
 151
 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.
 155
 156 =cut
 157
 158 sub LoadConfig {
 159     require RT::Config;
 160     $Config = RT::Config->new;
 161     $Config->LoadConfigs;
 162     require RT::I18N;
 163
 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 '/');
 167
 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') ) );
 173     }
 174
 175     return $Config;
 176 }
 177
 178 =head2 Init
 179
 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>.
 183
 184 =cut
 185
 186 sub Init {
 187     shift if @_%2; # code is inconsistent about calling as method
 188     my %args = (@_);
 189
 190     CheckPerlRequirements();
 191
 192     InitPluginPaths();
 193
 194     #Get a database connection
 195     ConnectToDatabase();
 196     InitSystemObjects();
 197     InitClasses(%args);
 198     InitLogging(%args);
 199     InitPlugins();
 200     _BuildTableAttributes();
 201     RT::I18N->Init;
 202     RT->Config->PostLoadCheck;
 203     RT::Lifecycle->FillCache;
 204 }
 205
 206 =head2 ConnectToDatabase
 207
 208 Get a database connection. See also L</Handle>.
 209
 210 =cut
 211
 212 sub ConnectToDatabase {
 213     require RT::Handle;
 214     $Handle = RT::Handle->new unless $Handle;
 215     $Handle->Connect;
 216     return $Handle;
 217 }
 218
 219 =head2 InitLogging
 220
 221 Create the Logger object and set up signal handlers.
 222
 223 =cut
 224
 225 sub InitLogging {
 226
 227     my %arg = @_;
 228
 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.
 232     $, = '';
 233     use Log::Dispatch 1.6;
 234
 235     my %level_to_num = (
 236         map( { $_ => } 0..7 ),
 237         debug     => 0,
 238         info      => 1,
 239         notice    => 2,
 240         warning   => 3,
 241         error     => 4, 'err' => 4,
 242         critical  => 5, crit  => 5,
 243         alert     => 6,
 244         emergency => 7, emerg => 7,
 245     );
 246
 247     unless ( $RT::Logger ) {
 248
 249         $RT::Logger = Log::Dispatch->new;
 250
 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;
 256         } else {
 257             $stack_from_level = 99; # don't log
 258         }
 259
 260         my $simple_cb = sub {
 261             # if this code throw any warning we can get segfault
 262             no warnings;
 263             my %p = @_;
 264
 265             # skip Log::* stack frames
 266             my $frame = 0;
 267             $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
 268             my ($package, $filename, $line) = caller($frame);
 269
 270             # Encode to bytes, so we don't send wide characters
 271             $p{message} = Encode::encode("UTF-8", $p{message});
 272
 273             $p{'message'} =~ s/(?:\r*\n)+$//;
 274             return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: "
 275                 . $p{'message'} ." ($filename:$line)\n";
 276         };
 277
 278         my $syslog_cb = sub {
 279             # if this code throw any warning we can get segfault
 280             no warnings;
 281             my %p = @_;
 282
 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);
 287
 288             # Encode to bytes, so we don't send wide characters
 289             $p{message} = Encode::encode("UTF-8", $p{message});
 290
 291             $p{message} =~ s/(?:\r*\n)+$//;
 292             if ($p{level} eq 'debug') {
 293                 return "[$$] $p{message} ($filename:$line)\n";
 294             } else {
 295                 return "[$$] $p{message}\n";
 296             }
 297         };
 298
 299         my $stack_cb = sub {
 300             no warnings;
 301             my %p = @_;
 302             return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
 303
 304             require Devel::StackTrace;
 305             my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
 306             return $p{'message'} . $trace->as_string;
 307
 308             # skip calling of the Log::* subroutins
 309             my $frame = 0;
 310             $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
 311             $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
 312
 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";
 316             }
 317             return $p{'message'};
 318         };
 319
 320         if ( $Config->Get('LogToFile') ) {
 321             my ($filename, $logdir) = (
 322                 $Config->Get('LogToFileNamed') || 'rt.log',
 323                 $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
 324             );
 325             if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
 326                 ($logdir) = $filename =~ m{^(.*[/\\])};
 327             }
 328             else {
 329                 $filename = File::Spec->catfile( $logdir, $filename );
 330             }
 331
 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.";
 335             }
 336
 337             require Log::Dispatch::File;
 338             $RT::Logger->add( Log::Dispatch::File->new
 339                            ( name=>'file',
 340                              min_level=> $Config->Get('LogToFile'),
 341                              filename=> $filename,
 342                              mode=>'append',
 343                              callbacks => [ $simple_cb, $stack_cb ],
 344                            ));
 345         }
 346         if ( $Config->Get('LogToSTDERR') ) {
 347             require Log::Dispatch::Screen;
 348             $RT::Logger->add( Log::Dispatch::Screen->new
 349                          ( name => 'screen',
 350                            min_level => $Config->Get('LogToSTDERR'),
 351                            callbacks => [ $simple_cb, $stack_cb ],
 352                            stderr => 1,
 353                          ));
 354         }
 355         if ( $Config->Get('LogToSyslog') ) {
 356             require Log::Dispatch::Syslog;
 357             $RT::Logger->add(Log::Dispatch::Syslog->new
 358                          ( name => 'syslog',
 359                            ident => 'RT',
 360                            min_level => $Config->Get('LogToSyslog'),
 361                            callbacks => [ $syslog_cb, $stack_cb ],
 362                            stderr => 1,
 363                            $Config->Get('LogToSyslogConf'),
 364                          ));
 365         }
 366     }
 367     InitSignalHandlers(%arg);
 368 }
 369
 370 sub InitSignalHandlers {
 371
 372     my %arg = @_;
 373     return if $arg{'NoSignalHandlers'};
 374
 375 # Signal handlers
 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).
 380
 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;
 385     };
 386
 387 #When we call die, trap it and log->crit with the value of the die.
 388
 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;
 395         }
 396         die $_[0];
 397     };
 398 }
 399
 400
 401 sub CheckPerlRequirements {
 402     eval {require 5.010_001};
 403     if ($@) {
 404         die sprintf "RT requires Perl v5.10.1 or newer.  Your current Perl is v%vd\n", $^V;
 405     }
 406
 407     # use $error here so the following "die" can still affect the global $@
 408     my $error;
 409     {
 410         local $@;
 411         eval {
 412             my $x = '';
 413             my $y = \$x;
 414             require Scalar::Util;
 415             Scalar::Util::weaken($y);
 416         };
 417         $error = $@;
 418     }
 419
 420     if ($error) {
 421         die <<"EOF";
 422
 423 RT requires the Scalar::Util module be built with support for  the 'weaken'
 424 function.
 425
 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.
 429
 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
 432 root.
 433
 434     perl -MCPAN -e'install Scalar::Util'
 435
 436 EOF
 437
 438     }
 439 }
 440
 441 =head2 InitClasses
 442
 443 Load all modules that define base classes.
 444
 445 =cut
 446
 447 sub InitClasses {
 448     shift if @_%2; # so we can call it as a function or method
 449     my %args = (@_);
 450     require RT::Tickets;
 451     require RT::Transactions;
 452     require RT::Attachments;
 453     require RT::Users;
 454     require RT::Principals;
 455     require RT::CurrentUser;
 456     require RT::Templates;
 457     require RT::Queues;
 458     require RT::ScripActions;
 459     require RT::ScripConditions;
 460     require RT::Scrips;
 461     require RT::Groups;
 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;
 471     require RT::Link;
 472     require RT::Links;
 473     require RT::Article;
 474     require RT::Articles;
 475     require RT::Class;
 476     require RT::Classes;
 477     require RT::ObjectClass;
 478     require RT::ObjectClasses;
 479     require RT::ObjectTopic;
 480     require RT::ObjectTopics;
 481     require RT::Topic;
 482     require RT::Topics;
 483     require RT::Link;
 484     require RT::Links;
 485
 486     _BuildTableAttributes();
 487
 488     if ( $args{'Heavy'} ) {
 489         # load scrips' modules
 490         my $scrips = RT::Scrips->new(RT->SystemUser);
 491         while ( my $scrip = $scrips->Next ) {
 492             local $@;
 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");
 496         }
 497
 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"
 502             );
 503         }
 504
 505     }
 506 }
 507
 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"
 513
 514     # without this, we also can never call _ClassAccessible, because we
 515     # won't have filled RT::Record::_TABLE_ATTR
 516     $_->_BuildTableAttributes foreach qw(
 517         RT::Ticket
 518         RT::Transaction
 519         RT::Attachment
 520         RT::User
 521         RT::Principal
 522         RT::Template
 523         RT::Queue
 524         RT::ScripAction
 525         RT::ScripCondition
 526         RT::Scrip
 527         RT::ObjectScrip
 528         RT::Group
 529         RT::GroupMember
 530         RT::CustomField
 531         RT::CustomFieldValue
 532         RT::ObjectCustomField
 533         RT::ObjectCustomFieldValue
 534         RT::Attribute
 535         RT::ACE
 536         RT::Article
 537         RT::Class
 538         RT::Link
 539         RT::ObjectClass
 540         RT::ObjectTopic
 541         RT::Topic
 542     );
 543 }
 544
 545 =head2 InitSystemObjects
 546
 547 Initializes system objects: C<$RT::System>, C<< RT->SystemUser >>
 548 and C<< RT->Nobody >>.
 549
 550 =cut
 551
 552 sub InitSystemObjects {
 553
 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');
 558
 559     #RT's "nobody user" is a genuine database user. its ID lives here.
 560     $Nobody = RT::CurrentUser->new;
 561     $Nobody->LoadByName('Nobody');
 562
 563     require RT::System;
 564     $System = RT::System->new( $SystemUser );
 565 }
 566
 567 =head1 CLASS METHODS
 568
 569 =head2 Config
 570
 571 Returns the current L<config object|RT::Config>, but note that
 572 you must L<load config|/LoadConfig> first otherwise this method
 573 returns undef.
 574
 575 Method can be called as class method.
 576
 577 =cut
 578
 579 sub Config { return $Config || shift->LoadConfig(); }
 580
 581 =head2 DatabaseHandle
 582
 583 Returns the current L<database handle object|RT::Handle>.
 584
 585 See also L</ConnectToDatabase>.
 586
 587 =cut
 588
 589 sub DatabaseHandle { return $Handle }
 590
 591 =head2 Logger
 592
 593 Returns the logger. See also L</InitLogging>.
 594
 595 =cut
 596
 597 sub Logger { return $Logger }
 598
 599 =head2 System
 600
 601 Returns the current L<system object|RT::System>. See also
 602 L</InitSystemObjects>.
 603
 604 =cut
 605
 606 sub System { return $System }
 607
 608 =head2 SystemUser
 609
 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>.
 613
 614 =cut
 615
 616 sub SystemUser { return $SystemUser }
 617
 618 =head2 Nobody
 619
 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>.
 623
 624 =cut
 625
 626 sub Nobody { return $Nobody }
 627
 628 sub PrivilegedUsers {
 629     if (!$_Privileged) {
 630     $_Privileged = RT::Group->new(RT->SystemUser);
 631     $_Privileged->LoadSystemInternalGroup('Privileged');
 632     }
 633     return $_Privileged;
 634 }
 635
 636 sub UnprivilegedUsers {
 637     if (!$_Unprivileged) {
 638     $_Unprivileged = RT::Group->new(RT->SystemUser);
 639     $_Unprivileged->LoadSystemInternalGroup('Unprivileged');
 640     }
 641     return $_Unprivileged;
 642 }
 643
 644
 645 =head2 Plugins
 646
 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
 649
 650 =cut
 651
 652 sub Plugins {
 653     state @PLUGINS;
 654     state $DID_INIT = 0;
 655
 656     my $self = shift;
 657     unless ($DID_INIT) {
 658         $self->InitPluginPaths;
 659         @PLUGINS = $self->InitPlugins;
 660         $DID_INIT++;
 661     }
 662     return [@PLUGINS];
 663 }
 664
 665 =head2 PluginDirs
 666
 667 Takes an optional subdir (e.g. po, lib, etc.) and returns a list of
 668 directories from plugins where that subdirectory exists.
 669
 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.
 673
 674 =cut
 675
 676 sub PluginDirs {
 677     my $self = shift;
 678     my $subdir = shift;
 679
 680     require RT::Plugin;
 681
 682     my @res;
 683     foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
 684         my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
 685         next unless -d $path;
 686         push @res, $path;
 687     }
 688     return @res;
 689 }
 690
 691 =head2 InitPluginPaths
 692
 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
 695
 696 =cut
 697
 698 sub InitPluginPaths {
 699     my $self = shift || __PACKAGE__;
 700
 701     my @lib_dirs = $self->PluginDirs('lib');
 702
 703     my @tmp_inc;
 704     my $added;
 705     for (@INC) {
 706         my $realpath = Cwd::realpath($_);
 707         next unless defined $realpath;
 708         if ( $realpath eq $RT::LocalLibPath) {
 709             push @tmp_inc, $_, @lib_dirs;
 710             $added = 1;
 711         } else {
 712             push @tmp_inc, $_;
 713         }
 714     }
 715
 716     # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
 717     push @tmp_inc, @lib_dirs unless $added;
 718
 719     my %seen;
 720     @INC = grep !$seen{$_}++, @tmp_inc;
 721 }
 722
 723 =head2 InitPlugins
 724
 725 Initialize all Plugins found in the RT configuration file, setting up
 726 their lib and L<HTML::Mason> component roots.
 727
 728 =cut
 729
 730 sub InitPlugins {
 731     my $self    = shift;
 732     my @plugins;
 733     require RT::Plugin;
 734     foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
 735         $plugin->require;
 736         die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
 737         push @plugins, RT::Plugin->new(name =>$plugin);
 738     }
 739     return @plugins;
 740 }
 741
 742
 743 sub InstallMode {
 744     my $self = shift;
 745     if (@_) {
 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!
 749             require Carp;
 750             $RT::Logger->error(
 751                 Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!")
 752             );
 753         }
 754         else {
 755             $_INSTALL_MODE = shift;
 756             if($_INSTALL_MODE) {
 757                 require RT::CurrentUser;
 758                $SystemUser = RT::CurrentUser->new();
 759             }
 760         }
 761     }
 762     return $_INSTALL_MODE;
 763 }
 764
 765 sub LoadGeneratedData {
 766     my $class = shift;
 767     my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
 768
 769     require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@";
 770     $class->CanonicalizeGeneratedPaths();
 771 }
 772
 773 sub CanonicalizeGeneratedPaths {
 774     my $class = shift;
 775     unless ( File::Spec->file_name_is_absolute($EtcPath) ) {
 776
 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) )
 782         {
 783             my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
 784
 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 ) );
 789         }
 790
 791         $BasePath = Cwd::realpath($BasePath);
 792
 793         for my $path (
 794                     qw/EtcPath BinPath SbinPath VarPath LocalPath StaticPath LocalEtcPath
 795                     LocalLibPath LexiconPath LocalLexiconPath PluginPath FontPath
 796                     LocalPluginPath LocalStaticPath MasonComponentRoot MasonLocalComponentRoot
 797                     MasonDataDir MasonSessionDir/
 798                      )
 799         {
 800             no strict 'refs';
 801
 802             # just change relative ones
 803             $$path = File::Spec->catfile( $BasePath, $$path )
 804                 unless File::Spec->file_name_is_absolute($$path);
 805         }
 806     }
 807
 808 }
 809
 810 =head2 AddJavaScript
 811
 812 Helper method to add JS files to the C<@JSFiles> config at runtime.
 813
 814 To add files, you can add the following line to your extension's main C<.pm>
 815 file:
 816
 817     RT->AddJavaScript( 'foo.js', 'bar.js' );
 818
 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.
 821
 822 =cut
 823
 824 sub AddJavaScript {
 825     my $self = shift;
 826
 827     my @old = RT->Config->Get('JSFiles');
 828     RT->Config->Set( 'JSFiles', @old, @_ );
 829     return RT->Config->Get('JSFiles');
 830 }
 831
 832 =head2 AddStyleSheets
 833
 834 Helper method to add CSS files to the C<@CSSFiles> config at runtime.
 835
 836 To add files, you can add the following line to your extension's main C<.pm>
 837 file:
 838
 839     RT->AddStyleSheets( 'foo.css', 'bar.css' );
 840
 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
 843 overlays.
 844
 845 =cut
 846
 847 sub AddStyleSheets {
 848     my $self = shift;
 849     my @old = RT->Config->Get('CSSFiles');
 850     RT->Config->Set( 'CSSFiles', @old, @_ );
 851     return RT->Config->Get('CSSFiles');
 852 }
 853
 854 =head2 JavaScript
 855
 856 helper method of RT->Config->Get('JSFiles')
 857
 858 =cut
 859
 860 sub JavaScript {
 861     return RT->Config->Get('JSFiles');
 862 }
 863
 864 =head2 StyleSheets
 865
 866 helper method of RT->Config->Get('CSSFiles')
 867
 868 =cut
 869
 870 sub StyleSheets {
 871     return RT->Config->Get('CSSFiles');
 872 }
 873
 874 =head2 Deprecated
 875
 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
 878 with a stack trace.
 879
 880 Optional arguments include:
 881
 882 =over
 883
 884 =item Remove
 885
 886 The release which is slated to remove the method or component
 887
 888 =item Instead
 889
 890 A suggestion of what to use in place of the deprecated API
 891
 892 =item Arguments
 893
 894 Used if not the entire method is being removed, merely a manner of
 895 calling it; names the arguments which are deprecated.
 896
 897 =item Message
 898
 899 Overrides the auto-built phrasing of C<Calling function ____ is
 900 deprecated> with a custom message.
 901
 902 =item Object
 903
 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
 906 warning.
 907
 908 =back
 909
 910 =cut
 911
 912 sub Deprecated {
 913     my $class = shift;
 914     my %args = (
 915         Arguments => undef,
 916         Remove => undef,
 917         Instead => undef,
 918         Message => undef,
 919         Stack   => 1,
 920         LogLevel => "warn",
 921         @_,
 922     );
 923
 924     my ($function) = (caller(1))[3];
 925     my $stack;
 926     if ($function eq "HTML::Mason::Commands::__ANON__") {
 927         eval { HTML::Mason::Exception->throw() };
 928         my $error = $@;
 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}});
 932     } else {
 933         $function = "function $function";
 934         $stack = Carp::longmess();
 935     }
 936     $stack =~ s/^.*?\n//; # Strip off call to ->Deprecated
 937
 938     my $msg;
 939     if ($args{Message}) {
 940         $msg = $args{Message};
 941     } elsif ($args{Arguments}) {
 942         $msg = "Calling $function with $args{Arguments} is deprecated";
 943     } else {
 944         $msg = "The $function is deprecated";
 945     }
 946     $msg .= ", and will be removed in RT $args{Remove}"
 947         if $args{Remove};
 948     $msg .= ".";
 949
 950     $msg .= "  You should use $args{Instead} instead."
 951         if $args{Instead};
 952
 953     $msg .= sprintf "  Object: %s #%d.", blessed($args{Object}), $args{Object}->id
 954         if $args{Object};
 955
 956     $msg .= "  Call stack:\n$stack" if $args{Stack};
 957
 958     my $loglevel = $args{LogLevel};
 959     RT->Logger->$loglevel($msg);
 960 }
 961
 962 =head1 BUGS
 963
 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.
 966
 967 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
 968
 969 =head1 SEE ALSO
 970
 971 L<RT::StyleGuide>
 972 L<DBIx::SearchBuilder>
 973
 974 =cut
 975
 976 require RT::Base;
 977 RT::Base->_ImportOverlays();
 978
 979 1;