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