Subversion Repositories DevTools

Rev

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

Rev 4085 Rev 5109
Line 51... Line 51...
51 
                      Verbose0 Verbose Verbose2 Verbose3
 51 
                      Verbose0 Verbose Verbose2 Verbose3
52 
                      Debug0 Debug Debug2 Debug3
 52 
                      Debug0 Debug Debug2 Debug3
53 
                      IsVerbose IsDebug IsQuiet
 53 
                      IsVerbose IsDebug IsQuiet
54 
                      DebugDumpData DebugDumpPackage DebugTraceBack
 54 
                      DebugDumpData DebugDumpPackage DebugTraceBack
55 
                      DebugPush DebugPop
 55 
                      DebugPush DebugPop
- 
 
 56 
                      StartCapture
- 
 
 57 
                      DumpCapture
56 
                      );
 58 
                      );
57 
 
 59 
 
58 
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
 60 
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
59 
 
 61 
 
60 
    # your exported package globals go here,
 62 
    # your exported package globals go here,
Line 91... Line 93...
91 
 
 93 
 
92 
# non-exported package globals go here
 94 
# non-exported package globals go here
93 
$ScmErrorCount = 0;
 95 
$ScmErrorCount = 0;
94 
$ScmExitCode = 1;
 96 
$ScmExitCode = 1;
95 
 
 97 
 
- 
 
 98 
 
96 
my $EName = '';
 99 
my $EName = '';
97 
my $EFn = '';
 100 
my $EFn = '';
- 
 
 101 
my @captured;
- 
 
 102 
my $capturing;
98 
 
 103 
 
99 
#  initialize package globals, first exported ones
 104 
#  initialize package globals, first exported ones
100 
 
 105 
 
101 
 
 106 
 
102 
#-------------------------------------------------------------------------------
 107 
#-------------------------------------------------------------------------------
Line 368... Line 373...
368 
        if ( $count == 1 )
 373 
        if ( $count == 1 )
369 
        {
 374 
        {
370 
            my $bol = $eol ? "" : "\n";
 375 
            my $bol = $eol ? "" : "\n";
371 
            $prefix = $bol . ' ' x length($prefix);
 376 
            $prefix = $bol . ' ' x length($prefix);
372 
        }
 377 
        }
373 
 
 - 
 
374 
        print "$prefix $line$eol";
 - 
 
375 
        $count++;
 378 
        $count++;
- 
 
 379 
 
- 
 
 380 
        if ($capturing && $tag =~ m/[MWEF]/)
- 
 
 381 
        {
- 
 
 382 
            push @captured, "$prefix $line$eol"
- 
 
 383 
        }
- 
 
 384 
        else
- 
 
 385 
        {
- 
 
 386 
            print "$prefix $line$eol";
- 
 
 387 
        }
376 
    }
 388 
    }
377 
}
 389 
}
378 
 
 390 
 
379 
#-------------------------------------------------------------------------------
 391 
#-------------------------------------------------------------------------------
380 
# Function        : Information
 392 
# Function        : Information
Line 552... Line 564...
552 
 
 564 
 
553 
sub ErrorDoExit
 565 
sub ErrorDoExit
554 
{
 566 
{
555 
    if ( $ScmErrorCount )
 567 
    if ( $ScmErrorCount )
556 
    {
 568 
    {
- 
 
 569 
        # If capturing, then force the captured messages to be displayed
- 
 
 570 
        DumpCapture();
- 
 
 571 
 
557 
        #
 572 
        #
558 
        #   Prevent recusion.
 573 
        #   Prevent recusion.
559 
        #   Kill error processing while doing error exit processing
 574 
        #   Kill error processing while doing error exit processing
560 
        #
 575 
        #
561 
        if ( my $func = $ScmOnExit )
 576 
        if ( my $func = $ScmOnExit )
Line 666... Line 681...
666 
    my( $level) = @_;
 681 
    my( $level) = @_;
667 
    return $::ScmDebug >= $level;
 682 
    return $::ScmDebug >= $level;
668 
}
 683 
}
669 
 
 684 
 
670 
#-------------------------------------------------------------------------------
 685 
#-------------------------------------------------------------------------------
- 
 
 686 
# Function        : StartCapture
- 
 
 687 
#
- 
 
 688 
# Description     : Start capturing non-debug non-verbose messages
- 
 
 689 
#
- 
 
 690 
# Inputs          : mode    - True: Start
- 
 
 691 
#
- 
 
 692 
# Returns         :
- 
 
 693 
#
- 
 
 694 
sub StartCapture
- 
 
 695 
{
- 
 
 696 
    my ($mode) = @_;
- 
 
 697 
    $capturing = $mode;
- 
 
 698 
}
- 
 
 699 
 
- 
 
 700 
#-------------------------------------------------------------------------------
- 
 
 701 
# Function        : DumpCapture
- 
 
 702 
#
- 
 
 703 
# Description     : Dump the captured output
- 
 
 704 
#
- 
 
 705 
# Inputs          : None
- 
 
 706 
#
- 
 
 707 
# Returns         : Nothing
- 
 
 708 
#
- 
 
 709 
sub DumpCapture
- 
 
 710 
{
- 
 
 711 
    foreach my $line ( @captured) {
- 
 
 712 
        print $line;
- 
 
 713 
    }
- 
 
 714 
    @captured = ();
- 
 
 715 
    $capturing = 0;
- 
 
 716 
}
- 
 
 717 
 
- 
 
 718 
#-------------------------------------------------------------------------------
671 
# Function        : DebugDumpData
 719 
# Function        : DebugDumpData
672 
#
 720 
#
673 
# Description     : Dump a data structure
 721 
# Description     : Dump a data structure
674 
#
 722 
#
675 
# Inputs          : $name           - A name to give the structure
 723 
# Inputs          : $name           - A name to give the structure