# To allow debugging of a category (e.g. 'chan') but not onto disc (just into the ring buffer)
# do: set/debug chan nologchan
#
+# To print the current contents into the debug log: show/debug_ring
+#
+# On exit or serious error the ring buffer is printed to the current debug log
+#
+# In Progress:
+# Expose a localhost listener on port (default) 27755 to things like watchdbg so that they can carry on
+# as normal, possibly with a "remember" button to permanently capture stuff observed.
+#
+# Future:
+# This is likely to be some form of triggering or filtering controlling (some portion
+# of) ring_buffer dumping.
+#
+#
package DXDebug;
require Exporter;
@ISA = qw(Exporter);
-@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck);
+@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck carp);
use strict;
use vars qw(%dbglevel $fp $callback $cleandays $keepdays $dbgringlth);
local $^W=0;
eval qq( sub confess {
\$SIG{__DIE__} = 'DEFAULT';
- DXDebug::dbgprintring() unless DXDebug::isdbg('chan');
- DXDebug::dbgclearring();
+ DXDebug::dbgprintring() if DXDebug::isdbg('nologchan');
DXDebug::dbg(\$@);
DXDebug::dbg(Carp::shortmess(\@_));
exit(-1);
}
sub croak {
\$SIG{__DIE__} = 'DEFAULT';
- DXDebug::dbgprintring() unless DXDebug::isdbg('chan');
- DXDebug::dbgclearring();
+ DXDebug::dbgprintring() if DXDebug::isdbg('nologchan');
DXDebug::dbg(\$@);
DXDebug::dbg(Carp::longmess(\@_));
exit(-1);
}
- sub carp { DXDebug::dbg(Carp::shortmess(\@_)); }
- sub cluck { DXDebug::dbg(Carp::longmess(\@_)); }
- );
+ sub carp {
+ DXDebug::dbgprintring(25) if DXDebug('nologchan');
+ DXDebug::dbg(Carp::shortmess(\@_));
+ }
+ sub cluck {
+ DXDebug::dbgprintring(25) if DXDebug('nologchan');
+ DXDebug::dbg(Carp::longmess(\@_));
+ } );
CORE::die(Carp::shortmess($@)) if $@;
-}
-else {
+} else {
eval qq( sub confess { die Carp::longmess(\@_); };
sub croak { die Carp::shortmess(\@_); };
sub cluck { warn Carp::longmess(\@_); };
for (@l) {
s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
print "$_\n" if defined \*STDOUT && !$no_stdout;
- my $str = "$t^$_";
+ my $tag = $_isdbg ? "($_isdbg) " : '';
+ my $str = "$t^$tag$_";
&$callback($str) if $callback;
if ($dbgringlth) {
shift @dbgring while (@dbgring > $dbgringlth);
sub dbgprintring
{
return unless $fp;
+ my $count = shift;
my $first;
- while (my $l = shift @dbgring) {
- my ($t, $str) = split /\^/, $l, 2;
+ my $l;
+ my $i = defined $count ? @dbgring-$count : 0;
+ $count = @dbgring;
+ for ( ; $i < $count; ++$i) {
+ my ($t, $str) = split /\^/, $dbgring[$i], 2;
next unless $t;
my $lt = time;
unless ($first) {
$fp->writeunix($lt, "$lt^###");
- $fp->writeunix($lt, "$lt^### RINGBUFFER START");
+ $fp->writeunix($lt, "$lt^### RINGBUFFER START at line $i (zero base)");
$fp->writeunix($lt, "$lt^###");
$first = $t;
}