cvsuser 04/09/02 13:52:24
Modified: App-Context/lib App.pm
Log:
added trace_width as a standard option/feature
Revision Changes Path
1.13 +46 -32 p5ee/App-Context/lib/App.pm
Index: App.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Context/lib/App.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- App.pm 14 May 2004 16:06:38 -0000 1.12
+++ App.pm 2 Sep 2004 20:52:24 -0000 1.13
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: App.pm,v 1.12 2004/05/14 16:06:38 spadkins Exp $
+## $Id: App.pm,v 1.13 2004/09/02 20:52:24 spadkins Exp $
#############################################################################
package App;
@@ -288,6 +288,7 @@
$scope .= "," if ($scope);
$scope .= $trace;
}
+ $App::trace_width = $App::options{trace_width} || 79;
my $debug = $App::options{debug};
if ($debug) {
@@ -371,7 +372,9 @@
sub use ($) {
&App::sub_entry if ($App::trace);
my ($self, $class) = @_;
- return if (defined $used{$class});
+ if (! defined $used{$class}) {
+ # if we try to use() it again, we won't get an exception
+ $used{$class} = 1;
if ($class =~ /^([A-Za-z0-9_:]+)$/) {
eval "use $1;";
if ($@) {
@@ -385,7 +388,7 @@
error => "Tried to load class [$class] with illegal characters\n",
);
}
- $used{$class} = 1;
+ }
&App::sub_exit() if ($App::trace);
}
@@ -721,7 +724,7 @@
sub sub_entry {
if ($App::trace) {
- my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs,
$wantarray);
+ my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs,
$wantarray, $text);
$stacklevel = 1;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) =
caller($stacklevel);
while (defined $subroutine && $subroutine eq "(eval)") {
@@ -759,45 +762,51 @@
if ($method) {
if (ref($obj)) { # dynamic method, called on an object
if ($obj->isa("App::Service")) {
- print "| " x $calldepth, "+-", $obj->{name}, "->${method}(";
+ $text = ("| " x $calldepth) . "+-" . $obj->{name} .
"->${method}(";
}
else {
- print "| " x $calldepth, "+-", $obj, "->${method}(";
+ $text = ("| " x $calldepth) . "+-" . $obj . "->${method}(";
}
$trailer = " [$package]";
}
else { # static method, called on a class
- print "| " x $calldepth, "+-", "${class}->${method}(";
+ $text = ("| " x $calldepth) . "+-" . "${class}->${method}(";
$trailer = ($class eq $package) ? "" : " [$package]";
}
$firstarg = 1;
}
else {
- print "| " x $calldepth, "+-", $subroutine, "(";
+ $text = ("| " x $calldepth) . "+-" . $subroutine . "(";
$firstarg = 0;
$trailer = "";
}
my ($narg);
for ($narg = $firstarg; $narg <= $#_; $narg++) {
- print "," if ($narg > $firstarg);
+ $text .= "," if ($narg > $firstarg);
if (!defined $_[$narg]) {
- print "undef";
+ $text .= "undef";
}
elsif (ref($_[$narg]) eq "") {
- print $_[$narg];
+ $text .= $_[$narg];
}
elsif (ref($_[$narg]) eq "ARRAY") {
- print "[", join(",", @{$_[$narg]}), "]";
+ $text .= ("[" . join(",", @{$_[$narg]}) . "]");
}
elsif (ref($_[$narg]) eq "HASH") {
- print "{", join(",", %{$_[$narg]}), "}";
+ $text .= ("{" . join(",", %{$_[$narg]}) . "}");
}
else {
- print $_[$narg];
+ $text .= $_[$narg];
}
}
#$trailer .= " [package=$package sub=$sub subroutine=$subroutine
class=$class method=$method]";
- print ")$trailer\n";
+ $text .= ")$trailer";
+ if (length($text) > $App::trace_width) {
+ print substr($text, 0, $App::trace_width), "\n";
+ }
+ else {
+ print $text, "\n";
+ }
$calldepth++;
}
}
@@ -819,7 +828,7 @@
sub sub_exit {
if ($App::trace) {
- my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs,
$wantarray);
+ my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs,
$wantarray, $text);
$stacklevel = 1;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) =
caller($stacklevel);
while (defined $subroutine && $subroutine eq "(eval)") {
@@ -837,25 +846,30 @@
return if (%App::scope && !$App::scope{$package} &&
!$App::scope{"$package.$sub"});
$calldepth--;
- print "| " x $calldepth, "+-> $sub()";
+ $text = ("| " x $calldepth) . "+-> $sub()";
my ($narg, $arg);
for ($narg = 0; $narg <= $#_; $narg++) {
- print $narg ? "," : " : ";
+ $text .= $narg ? "," : " : ";
$arg = $_[$narg];
if (ref($arg) eq "") {
- print $arg;
+ $text .= $arg;
}
elsif (ref($arg) eq "ARRAY") {
- print "[", join(",", @$arg), "]";
+ $text .= ("[" . join(",", @$arg) . "]");
}
elsif (ref($arg) eq "HASH") {
- print "{", join(",", %$arg), "}";
+ $text .= ("{" . join(",", %$arg) . "}");
}
else {
- print $arg;
+ $text .= $arg;
+ }
}
+ if (length($text) > $App::trace_width) {
+ print substr($text, 0, $App::trace_width), "\n";
+ }
+ else {
+ print $text, "\n";
}
- print "\n";
}
return(@_);
}
