#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
# <jesse@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
# 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., 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.
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
# CONTRIBUTION SUBMISSION POLICY:
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" ) {
- 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$@");
- }
+ require $SITE_CONFIG_FILE
+ || die ("Couldn't load RT config file '$SITE_CONFIG_FILE'\n$@");
}
- eval { require $CORE_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 '$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);
-
+ require $CORE_CONFIG_FILE
+ || die ("Couldn't load RT config file '$CORE_CONFIG_FILE'\n$@");
RT::I18N->Init;
}
sub Init {
- CheckPerlRequirements();
-
#Get a database connection
ConnectToDatabase();
InitLogging();
}
-
+
=head2 ConnectToDatabase
Get a database connection
}
$Handle->Connect();
}
-
+
=head2 InitLogging
Create the RT::Logger object.
unless ($RT::Logger) {
- $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"
- }
- };
+ $RT::Logger=Log::Dispatch->new();
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 "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,
- ));
+ 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.");
+ }
+
+ 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 => sub { my %p = @_;
+ my ($package, $filename, $line) = caller(5);
+ return "[".gmtime(time)."] [".$p{level}."]: $p{message} ($filename:$line)\n"}
+
+
+
+ ));
}
if ($RT::LogToScreen) {
- 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,
- ));
+ package Log::Dispatch::Screen;
+ 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
+ ));
}
if ($RT::LogToSyslog) {
- package Log::Dispatch::Syslog;
- 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 => $syslog_cb,
- stderr => 1,
- @RT::LogToSyslogConf
- ));
+ 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
+ ));
}
}
## Mason). It will log all problems through the standard logging
## mechanism (see above).
- $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;
- }
- };
+$SIG{__WARN__} = sub {
+ my $w = shift;
+ $w =~ s/(?:\r*\n)+$//;
+ # 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.
+ $RT::Logger->warning($w) if index($w, 'Wide character in ') != 0;
+};
#When we call die, trap it and log->crit with the value of the die.
}
-
-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
projects / freeside.git / blobdiff