Subversion Repositories DevTools

Rev

Rev 227 | Rev 255 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 227 Rev 231
Line 54... Line 54...
54 
                      Information Information1
 54 
                      Information Information1
55 
                      Question
 55 
                      Question
56 
                      Verbose Verbose2 Verbose3
 56 
                      Verbose Verbose2 Verbose3
57 
                      Debug0 Debug Debug2 Debug3
 57 
                      Debug0 Debug Debug2 Debug3
58 
                      IsVerbose IsDebug IsQuiet
 58 
                      IsVerbose IsDebug IsQuiet
59 
                      DebugDumpData DebugDumpPackage
 59 
                      DebugDumpData DebugDumpPackage DebugTraceBack
60 
                      DebugPush DebugPop
 60 
                      DebugPush DebugPop
61 
                      );
 61 
                      );
62 
 
 62 
 
63 
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
 63 
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
64 
 
 64 
 
Line 256... Line 256...
256 
    #   Generate the message prefix
 256 
    #   Generate the message prefix
257 
    #   This will only be used on the first line
 257 
    #   This will only be used on the first line
258 
    #   All other lines will have a space filled prefix
 258 
    #   All other lines will have a space filled prefix
259 
    #
 259 
    #
260 
    my $prefix = $::ScmWho . $tag;
 260 
    my $prefix = $::ScmWho . $tag;
261 
 
 - 
 
262 
    #
 261 
    #
263 
    #   Kill the eol if the Question is being asked
 262 
    #   Kill the eol if the Question is being asked
264 
    #
 263 
    #
265 
    my $eol = ( $tag =~ m/Q/ ) ? "" : "\n";
 264 
    my $eol = ( $tag =~ m/Q/ ) ? "" : "\n";
266 
 
 - 
 
267 
    foreach my $nextline ( @_ )
 265 
    foreach my $nextline ( @_ )
268 
    {
 266 
    {
- 
 
 267 
        next unless ( defined $nextline );              # Ignore undefined arguments
269 
        chomp( my $line = $nextline );
 268 
        chomp( my $line = $nextline );
270 
        if ( $count eq 1 )
 269 
        if ( $count eq 1 )
271 
        {
 270 
        {
272 
            my $bol = $eol ? "" : "\n";
 271 
            my $bol = $eol ? "" : "\n";
273 
            $prefix = $bol . ' ' x length($prefix);
 272 
            $prefix = $bol . ' ' x length($prefix);
Line 520... Line 519...
520 
        $ii++
 519 
        $ii++
521 
    }
 520 
    }
522 
}
 521 
}
523 
 
 522 
 
524 
#-------------------------------------------------------------------------------
 523 
#-------------------------------------------------------------------------------
- 
 
 524 
# Function        : DebugTraceBack
- 
 
 525 
#
- 
 
 526 
# Description     : Display the call stack
- 
 
 527 
#
- 
 
 528 
# Inputs          : $tag
- 
 
 529 
#
- 
 
 530 
# Returns         : Nothing
- 
 
 531 
#
- 
 
 532 
sub DebugTraceBack
- 
 
 533 
{
- 
 
 534 
    my ($tag) = @_;
- 
 
 535 
    $tag = 'TraceBack' unless ( $tag );
- 
 
 536 
 
- 
 
 537 
    #
- 
 
 538 
    #   Limit the stack stace.
- 
 
 539 
    #   It can't go on forever
- 
 
 540 
    #
- 
 
 541 
    foreach my $ii ( 0 .. 20 )
- 
 
 542 
    {
- 
 
 543 
         my ($package, $filename, $line) = caller($ii);
- 
 
 544 
         last unless ( $package );
- 
 
 545 
         print "$tag: $ii: $package, $filename, $line\n";
- 
 
 546 
    }
- 
 
 547 
}
- 
 
 548 
 
- 
 
 549 
#-------------------------------------------------------------------------------
525 
# Function        : DebugPush
 550 
# Function        : DebugPush
526 
#
 551 
#
527 
# Description     : Save the current debug level and then use a new name and
 552 
# Description     : Save the current debug level and then use a new name and
528 
#                   debug level for future reporting
 553 
#                   debug level for future reporting
529 
#
 554 
#