Upgrade to 4.2.2
[usit-rt.git] / 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;