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