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