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