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