import rt 3.6.6
[freeside.git] / rt / lib / RT.pm.in
index db37250..1a9bf08 100644 (file)
@@ -1,8 +1,8 @@
-# {{{ BEGIN BPS TAGGED BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
 #  
-# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC 
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -22,7 +22,9 @@
 # 
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/copyleft/gpl.html.
 # 
 # 
 # CONTRIBUTION SUBMISSION POLICY:
@@ -42,7 +44,7 @@
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
 # 
-# }}} END BPS TAGGED BLOCK
+# END BPS TAGGED BLOCK }}}
 package RT;
 use strict;
 use RT::I18N;
@@ -59,6 +61,7 @@ use vars qw($VERSION $System $SystemUser $Nobody $Handle $Logger
         $LocalEtcPath
         $LocalLexiconPath
         $LogDir
+        $BinPath
         $MasonComponentRoot
         $MasonLocalComponentRoot
         $MasonDataDir
@@ -74,6 +77,7 @@ $SITE_CONFIG_FILE = "@CONFIG_FILE_PATH@/RT_SiteConfig.pm";
 $BasePath = '@RT_PATH@';
 
 $EtcPath = '@RT_ETC_PATH@';
+$BinPath = '@RT_BIN_PATH@';
 $VarPath = '@RT_VAR_PATH@';
 $LocalPath = '@RT_LOCAL_PATH@';
 $LocalEtcPath = '@LOCAL_ETC_PATH@';
@@ -100,43 +104,90 @@ $MasonSessionDir = '@MASON_SESSION_PATH@';
 
 =head1 NAME
 
-       RT - Request Tracker
+RT - Request Tracker
 
 =head1 SYNOPSIS
 
-       A fully featured request tracker package
+A fully featured request tracker package
 
 =head1 DESCRIPTION
 
+=head2 LoadConfig
 
-=cut
-
-=item LoadConfig
+Load RT's config file.  First, the site configuration file
+(C<RT_SiteConfig.pm>) is loaded, in order to establish overall site
+settings like hostname and name of RT instance.  Then, the core
+configuration file (C<RT_Config.pm>) is loaded to set fallback values
+for all settings; it bases some values on settings from the site
+configuration file.
 
-Load RT's config file. First, go after the core config file. 
-After that, go after the site config.
+In order for the core configuration to not override the site's
+settings, the function C<Set> is used; it only sets values if they
+have not been set already.
 
 =cut
 
 sub LoadConfig {
      local *Set = sub { $_[0] = $_[1] unless defined $_[0] }; 
+
+    my $username = getpwuid($>);
+    my $group = getgrgid($();
+    my $message = <<EOF;
+
+RT couldn't load RT config file %s as:
+    user: $username 
+    group: $group
+
+The file is owned by user %s and group %s.  
+
+This usually means that the user/group your webserver is running
+as cannot read the file.  Be careful not to make the permissions
+on this file too liberal, because it contains database passwords.
+You may need to put the webserver user in the appropriate group
+(%s) or change permissions be able to run succesfully.
+EOF
+
+
     if ( -f "$SITE_CONFIG_FILE" ) {
-        require $SITE_CONFIG_FILE
-          || die ("Couldn't load RT config file  '$SITE_CONFIG_FILE'\n$@");
+        eval { require $SITE_CONFIG_FILE };
+        if ($@) {
+            my ($fileuid,$filegid) = (stat($SITE_CONFIG_FILE))[4,5];
+            my $fileusername = getpwuid($fileuid);
+            my $filegroup = getgrgid($filegid);
+            my $errormessage = sprintf($message, $SITE_CONFIG_FILE,
+                                       $fileusername, $filegroup, $filegroup);
+            die ("$errormessage\n$@");
+        }
+    }
+    eval { require $CORE_CONFIG_FILE };
+    if ($@) {
+        my ($fileuid,$filegid) = (stat($CORE_CONFIG_FILE))[4,5];
+        my $fileusername = getpwuid($fileuid);
+        my $filegroup = getgrgid($filegid);
+        my $errormessage = sprintf($message, $CORE_CONFIG_FILE,
+                                   $fileusername, $filegroup, $filegroup);
+        die ("$errormessage\n$@") 
     }
-    require $CORE_CONFIG_FILE
-      || die ("Couldn't load RT config file '$CORE_CONFIG_FILE'\n$@");
+
+    # RT::Essentials mistakenly recommends that WebPath be set to '/'.
+    # If the user does that, do what they mean.
+    $RT::WebPath = '' if ($RT::WebPath eq '/');
+
+    $ENV{'TZ'} = $RT::Timezone if ($RT::Timezone);
+
     RT::I18N->Init;
 }
 
-=item Init
+=head2 Init
+
+Conenct to the database, set up logging.
 
-    Conenct to the database, set up logging.
-    
 =cut
 
 sub Init {
 
+    CheckPerlRequirements();
+
     #Get a database connection
     ConnectToDatabase();
 
@@ -150,16 +201,17 @@ sub Init {
   
     $System = RT::System->new();
 
-   InitLogging(); 
+    InitClasses();
+    InitLogging(); 
 }
 
-  
+
 =head2 ConnectToDatabase
 
 Get a database connection
 
 =cut
+
 sub ConnectToDatabase {
     require RT::Handle;
     unless ($Handle && $Handle->dbh && $Handle->dbh->ping) {
@@ -167,15 +219,16 @@ sub ConnectToDatabase {
     } 
     $Handle->Connect();
 }
-    
+
 =head2 InitLogging
 
 Create the RT::Logger object. 
 
 =cut
+
 sub InitLogging {
 
-    # We have to set the record seperator ($, man perlvar)
+    # We have to set the record separator ($, man perlvar)
     # or Log::Dispatch starts getting
     # really pissy, as some other module we use unsets it.
 
@@ -184,77 +237,100 @@ sub InitLogging {
 
     unless ($RT::Logger) {
 
-    $RT::Logger=Log::Dispatch->new();
+    $RT::Logger = Log::Dispatch->new();
+
+    my $simple_cb = sub {
+        # if this code throw any warning we can get segfault
+        no warnings;
+
+        my %p = @_;
+
+        my $frame = 0; # stack frame index
+        # skip Log::* stack frames
+        $frame++ while( caller($frame) && caller($frame) =~ /^Log::/ );
+
+        my ($package, $filename, $line) = caller($frame);
+        $p{message} =~ s/(?:\r*\n)+$//;
+        my $str = "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n";
+
+        if( $RT::LogStackTraces ) {
+            $str .= "\nStack trace:\n";
+            # skip calling of the Log::* subroutins
+            $frame++ while( caller($frame) && (caller($frame))[3] =~ /^Log::/ );
+            while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
+                $str .= "\t". $sub ."() called at $filename:$line\n";
+            }
+        }
+        return $str;
+    };
+
+    my $syslog_cb = sub {
+        my %p = @_;
+
+        my $frame = 0; # stack frame index
+        # skip Log::* stack frames
+        $frame++ while( caller($frame) && caller($frame) =~ /^Log::/ );
+        my ($package, $filename, $line) = caller($frame);
+
+        # syswrite() cannot take utf8; turn it off here.
+        Encode::_utf8_off($p{message});
+
+        $p{message} =~ s/(?:\r*\n)+$//;
+        if ($p{level} eq 'debug') {
+            return "$p{message}\n"
+        } else {
+            return "$p{message} ($filename:$line)\n"
+        }
+    };
     
     if ($RT::LogToFile) {
-       my ($filename, $logdir);
-       if ($RT::LogToFileNamed =~ m![/\\]!) {
-           # looks like an absolute path.
-           $filename = $RT::LogToFileNamed;
-           ($logdir) = $RT::LogToFileNamed =~ m!^(.*[/\\])!;
-       }
-       else {
-           $filename = "$RT::LogDir/$RT::LogToFileNamed";
-           $logdir = $RT::LogDir;
-       }
-
-    unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
-        # localizing here would be hard when we don't have a current user yet
-        # die $self->loc("Log directory [_1] not found or couldn't be written.\n RT can't run.", $RT::LogDir);
-        die ("Log file $filename couldn't be written or created.\n RT can't run.");
-    }
-
-    require Log::Dispatch::File;
-
-
-         $RT::Logger->add(Log::Dispatch::File->new
-                      ( name=>'rtlog',
-                        min_level=> $RT::LogToFile,
-                        filename=> $filename,
-                        mode=>'append',
-                        callbacks => sub { my %p = @_;
-                                my ($package, $filename, $line) = caller(5);
-                                return "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n"}
-             
-             
-             
-                      ));
+        my ($filename, $logdir);
+        if ($RT::LogToFileNamed =~ m![/\\]!) {
+            # looks like an absolute path.
+            $filename = $RT::LogToFileNamed;
+            ($logdir) = $RT::LogToFileNamed =~ m!^(.*[/\\])!;
+        }
+        else {
+            $filename = "$RT::LogDir/$RT::LogToFileNamed";
+            $logdir = $RT::LogDir;
+        }
+
+        unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
+            # localizing here would be hard when we don't have a current user yet
+            die "Log file $filename couldn't be written or created.\n RT can't run.";
+        }
+
+        package Log::Dispatch::File;
+        require Log::Dispatch::File;
+        $RT::Logger->add(Log::Dispatch::File->new
+                       ( name=>'rtlog',
+                         min_level=> $RT::LogToFile,
+                         filename=> $filename,
+                         mode=>'append',
+                         callbacks => $simple_cb,
+                       ));
     }
     if ($RT::LogToScreen) {
-       require Log::Dispatch::Screen;
-       $RT::Logger->add(Log::Dispatch::Screen->new
-                    ( name => 'screen',
-                      min_level => $RT::LogToScreen,
-                        callbacks => sub { my %p = @_;
-                                my ($package, $filename, $line) = caller(5);
-                                return "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n"
-                               },
-             
-                      stderr => 1
-                    ));
+        package Log::Dispatch::Screen;
+        require Log::Dispatch::Screen;
+        $RT::Logger->add(Log::Dispatch::Screen->new
+                     ( name => 'screen',
+                       min_level => $RT::LogToScreen,
+                       callbacks => $simple_cb,
+                       stderr => 1,
+                     ));
     }
     if ($RT::LogToSyslog) {
-       require Log::Dispatch::Syslog;
-       $RT::Logger->add(Log::Dispatch::Syslog->new
-                    ( name => 'syslog',
+        package Log::Dispatch::Syslog;
+        require Log::Dispatch::Syslog;
+        $RT::Logger->add(Log::Dispatch::Syslog->new
+                     ( name => 'syslog',
                        ident => 'RT',
-                      min_level => $RT::LogToSyslog,
-                        callbacks => sub { my %p = @_;
-                                my ($package, $filename, $line) = caller(5);
-
-                               # syswrite() cannot take utf8; turn it off here.
-                               Encode::_utf8_off($p{message});
-
-                               if ($p{level} eq 'debug') {
-
-                                return "$p{message}\n" }
-                               else {
-                                return "$p{message} ($filename:$line)\n"}
-                               },
-             
-                      stderr => 1,
-               @RT::LogToSyslogConf
-                    ));
+                       min_level => $RT::LogToSyslog,
+                       callbacks => $syslog_cb,
+                       stderr => 1,
+                       @RT::LogToSyslogConf
+                     ));
     }
 
     }
@@ -266,7 +342,16 @@ sub InitLogging {
 ## Mason).  It will log all problems through the standard logging
 ## mechanism (see above).
 
-$SIG{__WARN__} = sub {$RT::Logger->warning($_[0])};
+    $SIG{__WARN__} = sub {
+        # The 'wide character' warnings has to be silenced for now, at least
+        # until HTML::Mason offers a sane way to process both raw output and
+        # unicode strings.
+        # use 'goto &foo' syntax to hide ANON sub from stack
+        if( index($_[0], 'Wide character in ') != 0 ) {
+            unshift @_, $RT::Logger, qw(level warning message);
+            goto &Log::Dispatch::log;
+        }
+    };
 
 #When we call die, trap it and log->crit with the value of the die.
 
@@ -274,18 +359,72 @@ $SIG{__DIE__}  = sub {
     unless ($^S || !defined $^S ) {
         $RT::Handle->Rollback();
         $RT::Logger->crit("$_[0]");
-        exit(-1);
-    }
-    else {
-        #Get out of here if we're in an eval
-        die $_[0];
     }
+    die $_[0];
 };
 
 # }}}
 
 }
 
+
+sub CheckPerlRequirements {
+    if ($^V < 5.008003) {
+        die sprintf "RT requires Perl v5.8.3 or newer.  Your current Perl is v%vd\n", $^V; 
+    }
+
+    local ($@);
+    eval { 
+        my $x = ''; 
+        my $y = \$x;
+        require Scalar::Util; Scalar::Util::weaken($y);
+    };
+    if ($@) {
+        die <<"EOF";
+
+RT requires the Scalar::Util module be built with support for  the 'weaken'
+function. 
+
+It is sometimes the case that operating system upgrades will replace 
+a working Scalar::Util with a non-working one. If your system was working
+correctly up until now, this is likely the cause of the problem.
+
+Please reinstall Scalar::Util, being careful to let it build with your C 
+compiler. Ususally this is as simple as running the following command as
+root.
+
+    perl -MCPAN -e'install Scalar::Util'
+
+EOF
+
+    }
+}
+
+
+=head2 InitClasses
+
+Load all modules that define base classes
+
+=cut
+
+sub InitClasses {
+    require RT::Tickets;
+    require RT::Transactions;
+    require RT::Users;
+    require RT::CurrentUser;
+    require RT::Templates;
+    require RT::Queues;
+    require RT::ScripActions;
+    require RT::ScripConditions;
+    require RT::Scrips;
+    require RT::Groups;
+    require RT::GroupMembers;
+    require RT::CustomFields;
+    require RT::CustomFieldValues;
+    require RT::ObjectCustomFields;
+    require RT::ObjectCustomFieldValues;
+}
+
 # }}}
 
 
@@ -297,9 +436,6 @@ sub Nobody {
     return ($Nobody);
 }
 
-
-=head1 SYNOPSIS
-
 =head1 BUGS
 
 Please report them to rt-bugs@fsck.com, if you know what's broken and have at least 
@@ -312,21 +448,19 @@ If you're not sure what's going on, report them rt-devel@lists.bestpractical.com
 L<RT::StyleGuide>
 L<DBIx::SearchBuilder>
 
-
-
 =begin testing
 
-
 ok ($RT::Nobody->Name() eq 'Nobody', "Nobody is nobody");
 ok ($RT::Nobody->Name() ne 'root', "Nobody isn't named root");
 ok ($RT::SystemUser->Name() eq 'RT_System', "The system user is RT_System");
 ok ($RT::SystemUser->Name() ne 'noname', "The system user isn't noname");
 
-
 =end testing
 
 =cut
 
+eval "require RT_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT_Vendor.pm});
 eval "require RT_Local";
 die $@ if ($@ && $@ !~ qr{^Can't locate RT_Local.pm});