lib/RT.pm

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