[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