add rate tier tables to Mason.pm, RT#15155
[freeside.git] / rt / lib / RT.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2011 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
52 package RT;
53
54
55 use File::Spec ();
56 use Cwd ();
57
58 use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_INSTALL_MODE);
59
60 our $VERSION = '3.8.10';
61
62
63
64 our $BasePath = '/opt/rt3';
65 our $EtcPath = '/opt/rt3/etc';
66 our $BinPath = '/opt/rt3/bin';
67 our $SbinPath = '/opt/rt3/sbin';
68 our $VarPath = '/opt/rt3/var';
69 our $PluginPath = '';
70 our $LocalPath = '/opt/rt3/local';
71 our $LocalEtcPath = '/opt/rt3/local/etc';
72 our $LocalLibPath        =    '/opt/rt3/local/lib';
73 our $LocalLexiconPath = '/opt/rt3/local/po';
74 our $LocalPluginPath = $LocalPath."/plugins";
75
76
77 # $MasonComponentRoot is where your rt instance keeps its mason html files
78
79 our $MasonComponentRoot = '/var/www/freeside/rt';
80
81 # $MasonLocalComponentRoot is where your rt instance keeps its site-local
82 # mason html files.
83
84 our $MasonLocalComponentRoot = '/opt/rt3/local/html';
85
86 # $MasonDataDir Where mason keeps its datafiles
87
88 our $MasonDataDir = '/usr/local/etc/freeside/masondata';
89
90 # RT needs to put session data (for preserving state between connections
91 # via the web interface)
92 our $MasonSessionDir = '/opt/rt3/var/session_data';
93
94 unless (  File::Spec->file_name_is_absolute($EtcPath) ) {
95
96 # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
97 # otherwise RT.pm will make src dir(where we configure RT) be the BasePath 
98 # instead of the --prefix one
99     unless ( -d $BasePath && File::Spec->file_name_is_absolute($BasePath) ) {
100         my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
101
102        # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
103        # is not always absolute
104         $BasePath =
105           File::Spec->rel2abs(
106             File::Spec->catdir( $pm_path, File::Spec->updir ) );
107     }
108
109     $BasePath = Cwd::realpath( $BasePath );
110
111     for my $path ( qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath
112             LocalLibPath LocalLexiconPath PluginPath LocalPluginPath 
113             MasonComponentRoot MasonLocalComponentRoot MasonDataDir 
114             MasonSessionDir/ ) {
115         no strict 'refs';
116         # just change relative ones
117         $$path = File::Spec->catfile( $BasePath, $$path )
118           unless File::Spec->file_name_is_absolute( $$path );
119     }
120 }
121
122
123 =head1 NAME
124
125 RT - Request Tracker
126
127 =head1 SYNOPSIS
128
129 A fully featured request tracker package
130
131 =head1 DESCRIPTION
132
133 =head2 INITIALIZATION
134
135 =head2 LoadConfig
136
137 Load RT's config file.  First, the site configuration file
138 (F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
139 settings like hostname and name of RT instance.  Then, the core
140 configuration file (F<RT_Config.pm>) is loaded to set fallback values
141 for all settings; it bases some values on settings from the site
142 configuration file.
143
144 In order for the core configuration to not override the site's
145 settings, the function C<Set> is used; it only sets values if they
146 have not been set already.
147
148 =cut
149
150 sub LoadConfig {
151     require RT::Config;
152     $Config = new RT::Config;
153     $Config->LoadConfigs;
154     require RT::I18N;
155
156     # RT::Essentials mistakenly recommends that WebPath be set to '/'.
157     # If the user does that, do what they mean.
158     $RT::WebPath = '' if ($RT::WebPath eq '/');
159
160     # fix relative LogDir and GnuPG homedir
161     unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
162         $Config->Set( LogDir =>
163               File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
164     }
165
166     my $gpgopts = $Config->Get('GnuPGOptions');
167     unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
168         $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} );
169     }
170     
171     RT::I18N->Init;
172 }
173
174 =head2 Init
175
176 L<Connect to the database /ConnectToDatabase>, L<initilizes system objects /InitSystemObjects>,
177 L<preloads classes /InitClasses> and L<set up logging /InitLogging>.
178
179 =cut
180
181 sub Init {
182
183     my @arg = @_;
184
185     CheckPerlRequirements();
186
187     InitPluginPaths();
188
189     #Get a database connection
190     ConnectToDatabase();
191     InitSystemObjects();
192     InitClasses();
193     InitLogging(@arg); 
194     InitPlugins();
195     RT->Config->PostLoadCheck;
196
197 }
198
199 =head2 ConnectToDatabase
200
201 Get a database connection. See also </Handle>.
202
203 =cut
204
205 sub ConnectToDatabase {
206     require RT::Handle;
207     $Handle = new RT::Handle unless $Handle;
208     $Handle->Connect;
209     return $Handle;
210 }
211
212 =head2 InitLogging
213
214 Create the Logger object and set up signal handlers.
215
216 =cut
217
218 sub InitLogging {
219
220     my %arg = @_;
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}\n";
284             } else {
285                 return "$p{message} ($filename:$line)\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('LogToScreen') ) {
337             require Log::Dispatch::Screen;
338             $RT::Logger->add( Log::Dispatch::Screen->new
339                          ( name => 'screen',
340                            min_level => $Config->Get('LogToScreen'),
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(%arg);
358 }
359
360 sub InitSignalHandlers {
361
362     my %arg = @_;
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     unless ( $arg{'NoSignalHandlers'} ) {
371
372         $SIG{__WARN__} = sub {
373             # The 'wide character' warnings has to be silenced for now, at least
374             # until HTML::Mason offers a sane way to process both raw output and
375             # unicode strings.
376             # use 'goto &foo' syntax to hide ANON sub from stack
377             if( index($_[0], 'Wide character in ') != 0 ) {
378                 unshift @_, $RT::Logger, qw(level warning message);
379                 goto &Log::Dispatch::log;
380             }
381         };
382
383         #When we call die, trap it and log->crit with the value of the die.
384
385         $SIG{__DIE__}  = sub {
386             # if we are not in eval and perl is not parsing code
387             # then rollback transactions and log RT error
388             unless ($^S || !defined $^S ) {
389                 $RT::Handle->Rollback(1) if $RT::Handle;
390                 $RT::Logger->crit("$_[0]") if $RT::Logger;
391             }
392             die $_[0];
393         };
394
395     }
396 }
397
398
399 sub CheckPerlRequirements {
400     if ($^V < 5.008003) {
401         die sprintf "RT requires Perl v5.8.3 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. Ususally 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
468     # on a cold server (just after restart) people could have an object
469     # in the session, as we deserialize it so we never call constructor
470     # of the class, so the list of accessible fields is empty and we die
471     # with "Method xxx is not implemented in RT::SomeClass"
472     $_->_BuildTableAttributes foreach qw(
473         RT::Ticket
474         RT::Transaction
475         RT::Attachment
476         RT::User
477         RT::Principal
478         RT::Template
479         RT::Queue
480         RT::ScripAction
481         RT::ScripCondition
482         RT::Scrip
483         RT::Group
484         RT::GroupMember
485         RT::CustomField
486         RT::CustomFieldValue
487         RT::ObjectCustomField
488         RT::ObjectCustomFieldValue
489         RT::Attribute
490     );
491
492     if ( $args{'Heavy'} ) {
493         # load scrips' modules
494         my $scrips = RT::Scrips->new($RT::SystemUser);
495         $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' );
496         while ( my $scrip = $scrips->Next ) {
497             local $@;
498             eval { $scrip->LoadModules } or
499                 $RT::Logger->error("Invalid Scrip ".$scrip->Id.".  Unable to load the Action or Condition.  ".
500                                    "You should delete or repair this Scrip in the admin UI.\n$@\n");
501         }
502
503         foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
504             local $@;
505             eval "require $class; 1" or $RT::Logger->error(
506                 "Class '$class' is listed in CustomFieldValuesSources option"
507                 ." in the config, but we failed to load it:\n$@\n"
508             );
509         }
510
511         RT::I18N->LoadLexicons;
512     }
513 }
514
515 =head2 InitSystemObjects
516
517 Initializes system objects: C<$RT::System>, C<$RT::SystemUser>
518 and C<$RT::Nobody>.
519
520 =cut
521
522 sub InitSystemObjects {
523
524     #RT's system user is a genuine database user. its id lives here
525     require RT::CurrentUser;
526     $SystemUser = new RT::CurrentUser;
527     $SystemUser->LoadByName('RT_System');
528
529     #RT's "nobody user" is a genuine database user. its ID lives here.
530     $Nobody = new RT::CurrentUser;
531     $Nobody->LoadByName('Nobody');
532
533     require RT::System;
534     $System = RT::System->new( $SystemUser );
535 }
536
537 =head1 CLASS METHODS
538
539 =head2 Config
540
541 Returns the current L<config object RT::Config>, but note that
542 you must L<load config /LoadConfig> first otherwise this method
543 returns undef.
544
545 Method can be called as class method.
546
547 =cut
548
549 sub Config { return $Config }
550
551 =head2 DatabaseHandle
552
553 Returns the current L<database handle object RT::Handle>.
554
555 See also L</ConnectToDatabase>.
556
557 =cut
558
559 sub DatabaseHandle { return $Handle }
560
561 =head2 Logger
562
563 Returns the logger. See also L</InitLogging>.
564
565 =cut
566
567 sub Logger { return $Logger }
568
569 =head2 System
570
571 Returns the current L<system object RT::System>. See also
572 L</InitSystemObjects>.
573
574 =cut
575
576 sub System { return $System }
577
578 =head2 SystemUser
579
580 Returns the system user's object, it's object of
581 L<RT::CurrentUser> class that represents the system. See also
582 L</InitSystemObjects>.
583
584 =cut
585
586 sub SystemUser { return $SystemUser }
587
588 =head2 Nobody
589
590 Returns object of Nobody. It's object of L<RT::CurrentUser> class
591 that represents a user who can own ticket and nothing else. See
592 also L</InitSystemObjects>.
593
594 =cut
595
596 sub Nobody { return $Nobody }
597
598 =head2 Plugins
599
600 Returns a listref of all Plugins currently configured for this RT instance.
601 You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
602
603 =cut
604
605 our @PLUGINS = ();
606 sub Plugins {
607     my $self = shift;
608     unless (@PLUGINS) {
609         $self->InitPluginPaths;
610         @PLUGINS = $self->InitPlugins;
611     }
612     return \@PLUGINS;
613 }
614
615 =head2 PluginDirs
616
617 Takes optional subdir (e.g. po, lib, etc.) and return plugins' dirs that exist.
618
619 This code chacke plugins names or anything else and required when main config
620 is loaded to load plugins' configs.
621
622 =cut
623
624 sub PluginDirs {
625     my $self = shift;
626     my $subdir = shift;
627
628     require RT::Plugin;
629
630     my @res;
631     foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
632         my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
633         next unless -d $path;
634         push @res, $path;
635     }
636     return @res;
637 }
638
639 =head2 InitPluginPaths
640
641 Push plugins' lib paths into @INC right after F<local/lib>.
642 In case F<local/lib> isn't in @INC, append them to @INC
643
644 =cut
645
646 sub InitPluginPaths {
647     my $self = shift || __PACKAGE__;
648
649     my @lib_dirs = $self->PluginDirs('lib');
650
651     my @tmp_inc;
652     my $added;
653     for (@INC) {
654         if ( Cwd::realpath($_) eq $RT::LocalLibPath) {
655             push @tmp_inc, $_, @lib_dirs;
656             $added = 1;
657         } else {
658             push @tmp_inc, $_;
659         }
660     }
661
662     # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
663     push @tmp_inc, @lib_dirs unless $added;
664
665     my %seen;
666     @INC = grep !$seen{$_}++, @tmp_inc;
667 }
668
669 =head2 InitPlugins
670
671 Initialze all Plugins found in the RT configuration file, setting up their lib and HTML::Mason component roots.
672
673 =cut
674
675 sub InitPlugins {
676     my $self    = shift;
677     my @plugins;
678     require RT::Plugin;
679     foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
680         $plugin->require;
681         die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
682         push @plugins, RT::Plugin->new(name =>$plugin);
683     }
684     return @plugins;
685 }
686
687
688 sub InstallMode {
689     my $self = shift;
690     if (@_) {
691          $_INSTALL_MODE = shift;
692          if($_INSTALL_MODE) {
693              require RT::CurrentUser;
694             $SystemUser = RT::CurrentUser->new();
695          }
696     }
697     return $_INSTALL_MODE;
698 }
699
700
701 =head1 BUGS
702
703 Please report them to rt-bugs@bestpractical.com, if you know what's
704 broken and have at least some idea of what needs to be fixed.
705
706 If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
707
708 =head1 SEE ALSO
709
710 L<RT::StyleGuide>
711 L<DBIx::SearchBuilder>
712
713
714 =cut
715
716 require RT::Base;
717 RT::Base->_ImportOverlays();
718
719 1;