home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
discus_admin_1357211388
/
source
/
debug.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
3KB
|
116 lines
# FILE: debug.pl
# DESCRIPTION: Various tools for debugging that we've found useful during development
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
# http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------
use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
###
### recursive_dump
###
### Displays the contents of a hash in a human-readable format
###
sub recursive_dump {
my ($s, $c, $n) = @_;
header() if $c == 0;
if ($c == 0) {
print "<pre>+ $n (", scalar(keys(%{ $s })), " keys)\n" ;
} else {
print " " x ($c);
print "+ $n (", scalar(keys(%{ $s })), " keys)\n" ;
}
foreach my $k (keys(%{ $s })) {
if ($k =~ /^_/ && ref $s->{$k} eq "HASH") {
print " " x (1 + $c);
print "+ $k (HASH)\n";
} elsif (ref $s->{$k} eq "HASH") {
recursive_dump($s->{$k}, 1+$c, $k);
} elsif (ref $s->{$k} eq "ARRAY") {
array_dump($s->{$k}, 1+$c, $k);
} else {
print " " x (1 + $c);
print "+ $k: $s->{$k}\n";
}
}
print "</pre>\n" if $c == 0;
}
###
### array_dump
###
### Dumps an array
###
sub array_dump {
my ($s, $c, $n) = @_;
header() if $c == 0;
if ($c == 0) {
print "<pre>+ \@$n (", scalar(@{$s}), " rows)\n" ;
} else {
print " " x ($c);
print "+ \@$n (", scalar(@{ $s }), " rows)\n" ;
}
foreach my $row (@{ $s }) {
if (ref $row eq "HASH") {
recursive_dump($row, 1+$c, $row);
} elsif (ref $row eq "ARRAY") {
array_dump($row, 1+$c, $row);
} else {
print " " x (1 + $c);
print "+ $row\n";
}
}
print "</pre>\n" if $c == 0;
}
###
### string_analyze
###
### Presents a string in a variety of ways
###
sub string_analyze {
header();
dreq("template");
while (my $s = shift @_) {
print "<pre>\n";
print "Absolute string length: ", length($s), "\n";
print "Source-viewable string: ";
my $i = $s;
$i =~ s/\n/\[\\n\]/g;
$i =~ s/\r/\[\\r\]/g;
print string_escaper($i);
print "\n</pre><hr noshade>";
}
}
###
### string_escaper
###
### For displaying a string on the screen, escaping all characters
### that are not alphanumeric.
###
sub string_escaper {
my @u = ();
while (my $i = shift @_) {
$i =~ s/(\W)/join("", "", ord($1), ";")/ge;
push @u, $i;
}
return $u[0] if $#u == 0;
return @u;
}
1;