cvs commit: p5ee/App-Context/lib App.pm

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(@_);
   }