projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
add CTY2613 prefixes
[spider.git]
/
perl
/
DXDebug.pm
diff --git
a/perl/DXDebug.pm
b/perl/DXDebug.pm
index 40cb3a257e1128651683a59dfe6fe0830d3334e3..1207492dbb0ec77209edb8816b4d574b95f8177a 100644
(file)
--- a/
perl/DXDebug.pm
+++ b/
perl/DXDebug.pm
@@
-4,7
+4,7
@@
#
# Copyright (c) 1998 - Dirk Koopman G1TLH
#
#
# Copyright (c) 1998 - Dirk Koopman G1TLH
#
-#
$Id$
+#
#
package DXDebug;
#
package DXDebug;
@@
-19,6
+19,7
@@
use vars qw(%dbglevel $fp $callback $cleandays $keepdays);
use DXUtil;
use DXLog ();
use Carp ();
use DXUtil;
use DXLog ();
use Carp ();
+use POSIX qw(isatty);
%dbglevel = ();
$fp = undef;
%dbglevel = ();
$fp = undef;
@@
-26,6
+27,8
@@
$callback = undef;
$keepdays = 10;
$cleandays = 100;
$keepdays = 10;
$cleandays = 100;
+our $no_stdout; # set if not running in a terminal
+
# Avoid generating "subroutine redefined" warnings with the following
# hack (from CGI::Carp):
if (!defined $DB::VERSION) {
# Avoid generating "subroutine redefined" warnings with the following
# hack (from CGI::Carp):
if (!defined $DB::VERSION) {
@@
-66,7
+69,7
@@
sub dbg($)
my @l = split /\n/, $r;
for (@l) {
s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
my @l = split /\n/, $r;
for (@l) {
s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
- print "$_\n" if defined \*STDOUT;
+ print "$_\n" if defined \*STDOUT
&& !$no_stdout
;
my $str = "$t^$_";
&$callback($str) if $callback;
$fp->writeunix($t, $str);
my $str = "$t^$_";
&$callback($str) if $callback;
$fp->writeunix($t, $str);
@@
-79,7
+82,7
@@
sub dbginit
$callback = shift;
# add sig{__DIE__} handling
$callback = shift;
# add sig{__DIE__} handling
-
if (!
defined $DB::VERSION) {
+
unless (
defined $DB::VERSION) {
$SIG{__WARN__} = sub {
if ($_[0] =~ /Deep\s+recursion/i) {
dbg($@);
$SIG{__WARN__} = sub {
if ($_[0] =~ /Deep\s+recursion/i) {
dbg($@);
@@
-92,6
+95,13
@@
sub dbginit
};
$SIG{__DIE__} = sub { dbg($@); dbg(Carp::longmess(@_)); };
};
$SIG{__DIE__} = sub { dbg($@); dbg(Carp::longmess(@_)); };
+
+ # switch off STDOUT printing if we are not talking to a TTY
+ unless ($^O =~ /^MS/ || $^O =~ /^OS-2/) {
+ unless (isatty(STDOUT->fileno)) {
+ ++$no_stdout;
+ }
+ }
}
$fp = DXLog::new('debug', 'dat', 'd');
}
$fp = DXLog::new('debug', 'dat', 'd');
@@
-106,9
+116,11
@@
sub dbgclose
sub dbgdump
{
sub dbgdump
{
+ return unless $fp;
+
my $l = shift;
my $m = shift;
my $l = shift;
my $m = shift;
- if ($
fp && ($dbglevel{$l} || $l eq 'err')
) {
+ if ($
dbglevel{$l} || $l eq 'err'
) {
foreach my $l (@_) {
for (my $o = 0; $o < length $l; $o += 16) {
my $c = substr $l, $o, 16;
foreach my $l (@_) {
for (my $o = 0; $o < length $l; $o += 16) {
my $c = substr $l, $o, 16;