[Rt-commit] r3935 - in rt/branches/3.5-TESTING: etc lib
ruz at bestpractical.com
ruz at bestpractical.com
Wed Oct 5 21:39:58 EDT 2005
Author: ruz
Date: Wed Oct 5 21:39:58 2005
New Revision: 3935
Modified:
rt/branches/3.5-TESTING/etc/RT_Config.pm.in
rt/branches/3.5-TESTING/lib/RT.pm.in
Log:
* new config option LogStackTraces
Modified: rt/branches/3.5-TESTING/etc/RT_Config.pm.in
==============================================================================
--- rt/branches/3.5-TESTING/etc/RT_Config.pm.in (original)
+++ rt/branches/3.5-TESTING/etc/RT_Config.pm.in Wed Oct 5 21:39:58 2005
@@ -274,6 +274,11 @@
Set($LogDir, '@RT_LOG_PATH@');
Set($LogToFileNamed , "rt.log"); #log to rt.log
+# If true generates stack traces to file log or screen
+# never generates traces to syslog
+
+Set($LogStackTraces , 0);
+
# On Solaris or UnixWare, set to ( socket => 'inet' ). Options here
# override any other options RT passes to Log::Dispatch::Syslog.
# Other interesting flags include facility and logopt. (See the
Modified: rt/branches/3.5-TESTING/lib/RT.pm.in
==============================================================================
--- rt/branches/3.5-TESTING/lib/RT.pm.in (original)
+++ rt/branches/3.5-TESTING/lib/RT.pm.in Wed Oct 5 21:39:58 2005
@@ -193,80 +193,100 @@
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.");
- }
-
- 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"}
-
-
-
- ));
+ 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) {
- 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
- ));
+ 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) {
- 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 => 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
+ ));
}
}
@@ -278,28 +298,32 @@
## Mason). It will log all problems through the standard logging
## mechanism (see above).
-$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;
-};
+ $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.
-$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];
- }
-};
+ $SIG{__DIE__} = sub {
+ unless ($^S || !defined $^S ) {
+ $RT::Handle->Rollback();
+ $RT::Logger->crit("$_[0]");
+ # XXX: we should never exit, even if we are not in eval context
+ # could someone explane this code?
+ exit(-1);
+ }
+ else {
+ # Get out of here if we're in an eval
+ die $_[0];
+ }
+ };
# }}}
More information about the Rt-commit
mailing list