Subversion Repositories DevTools

Rev

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

Rev 7307 Rev 7308
Line 36... Line 36...
36 
 
 36 
 
37 
my $EPrefix = '';
 37 
my $EPrefix = '';
38 
my $EName = '';
 38 
my $EName = '';
39 
my $EFn = '';
 39 
my $EFn = '';
40 
my $ElPrefix = '';
 40 
my $ElPrefix = '';
- 
 
 41 
my $EIndent = '';
- 
 
 42 
my $EOffset = '';
41 
 
 43 
 
42 
#-------------------------------------------------------------------------------
 44 
#-------------------------------------------------------------------------------
43 
# Function        : BEGIN
 45 
# Function        : BEGIN
44 
#
 46 
#
45 
# Description     : Standard Package Interface
 47 
# Description     : Standard Package Interface
Line 109... Line 111...
109 
#                   @vars           - User Config Options
 111 
#                   @vars           - User Config Options
110 
#                   Config Options:
 112 
#                   Config Options:
111 
#                       :name=xxxx
 113 
#                       :name=xxxx
112 
#                       :function=xxxx
 114 
#                       :function=xxxx
113 
#                       :prefix=xxxx
 115 
#                       :prefix=xxxx
- 
 
 116 
#                       :indent=nn/xxx
- 
 
 117 
#                       :offset=nn/xxx
114 
#                       :quiet=xxx
 118 
#                       :quiet=xxx
115 
#                       :debug=xxx
 119 
#                       :debug=xxx
116 
#                       :verbose=xxx
 120 
#                       :verbose=xxx
117 
#                       :delay_exit=xxx
 121 
#                       :delay_exit=xxx
118 
#
 122 
#
Line 153... Line 157...
153 
#
 157 
#
154 
# Inputs          : A hash of option,value pairs
 158 
# Inputs          : A hash of option,value pairs
155 
#                   Valid options
 159 
#                   Valid options
156 
#                       name        - Name to report in error
 160 
#                       name        - Name to report in error
157 
#                       function    - Name of enclosing function
 161 
#                       function    - Name of enclosing function
- 
 
 162 
#                       prefix      - 1st line prefix
158 
#                       verbose     - vebosity level
 163 
#                       verbose     - vebosity level
159 
#                       debug       - debug level
 164 
#                       debug       - debug level
160 
#                       on_exit     - Register on-exit function
 165 
#                       on_exit     - Register on-exit function
161 
#                       delay_exit  - Delay exit on error
 166 
#                       delay_exit  - Delay exit on error
162 
#                       prefix      - Optional prefix. First line only
 167 
#                       prefix      - Optional prefix. First line only
- 
 
 168 
#                       indent      - Optional. All lines (number or text)
- 
 
 169 
#                       offset      - Optional. Extra lines (number or text)
163 
#
 170 
#
164 
# Returns         :
 171 
# Returns         :
165 
#
 172 
#
166 
sub ErrorConfig
 173 
sub ErrorConfig
167 
{
 174 
{
Line 176... Line 183...
176 
            $EFn = ':' . $value;
 183 
            $EFn = ':' . $value;
177 
 
 184 
 
178 
        } elsif ( $key =~ /^prefix/ ) {
 185 
        } elsif ( $key =~ /^prefix/ ) {
179 
            $ElPrefix = $value;
 186 
            $ElPrefix = $value;
180 
 
 187 
 
- 
 
 188 
        } elsif ( $key =~ /^indent/ ) {
- 
 
 189 
            my $pad = $value;
- 
 
 190 
            if ($pad =~ m~^\d+$~) {
- 
 
 191 
                $pad = ' ' x $value;
- 
 
 192 
            }
- 
 
 193 
            $EIndent = $EIndent . $pad;
- 
 
 194 
 
- 
 
 195 
        } elsif ( $key =~ /^offset/ ) {
- 
 
 196 
            $EOffset = $value;
- 
 
 197 
            if ($EOffset =~ m~^\d+$~) {
- 
 
 198 
                $EOffset = ' ' x $value;
- 
 
 199 
            }
- 
 
 200 
 
181 
        } elsif ( $key =~ /^debug/ ) {
 201 
        } elsif ( $key =~ /^debug/ ) {
182 
            $::ScmDebug = $value
 202 
            $::ScmDebug = $value
183 
                if ( defined $value && $value > $::ScmDebug  );
 203 
                if ( defined $value && $value > $::ScmDebug  );
184 
 
 204 
 
185 
        } elsif ( $key =~ /^verbose/ ) {
 205 
        } elsif ( $key =~ /^verbose/ ) {
Line 205... Line 225...
205 
 
 225 
 
206 
    #
 226 
    #
207 
    #   Calculate the prefix to all messages
 227 
    #   Calculate the prefix to all messages
208 
    #   Based on Name and Function( if provided
 228 
    #   Based on Name and Function( if provided
209 
    #
 229 
    #
210 
    $EPrefix = "[$EName$EFn] ";
 230 
    $EPrefix = "[$EName$EFn] " if $EName;
211 
 
 231 
 
212 
    #
 232 
    #
213 
    #   Extract program specfic debug flags from the environment
 233 
    #   Extract program specfic debug flags from the environment
214 
    #   These will be based on the reporting 'name'
 234 
    #   These will be based on the reporting 'name'
215 
    #       GBE_name_DEBUG
 235 
    #       GBE_name_DEBUG
Line 274... Line 294...
274 
    #
 294 
    #
275 
    my $self;
 295 
    my $self;
276 
 
 296 
 
277 
    $self->{EPrefix}        =  $EPrefix;
 297 
    $self->{EPrefix}        =  $EPrefix;
278 
    $self->{ElPrefix}       =  $ElPrefix;
 298 
    $self->{ElPrefix}       =  $ElPrefix;
- 
 
 299 
    $self->{EIndent}        =  $EIndent;
- 
 
 300 
    $self->{EOffset}        =  $EOffset;
279 
    $self->{ScmVerbose}     =  $::ScmVerbose;
 301 
    $self->{ScmVerbose}     =  $::ScmVerbose;
280 
    $self->{ScmDebug}       =  $::ScmDebug;
 302 
    $self->{ScmDebug}       =  $::ScmDebug;
281 
    $self->{ScmQuiet}       =  $::ScmQuiet;
 303 
    $self->{ScmQuiet}       =  $::ScmQuiet;
282 
    $self->{ScmOnExit}      =  $ScmOnExit;
 304 
    $self->{ScmOnExit}      =  $ScmOnExit;
283 
    $self->{ScmDelayExit}   =  $ScmDelayExit;
 305 
    $self->{ScmDelayExit}   =  $ScmDelayExit;
Line 316... Line 338...
316 
sub DESTROY
 338 
sub DESTROY
317 
{
 339 
{
318 
    my ($self) = @_;
 340 
    my ($self) = @_;
319 
    $EPrefix          = $self->{EPrefix};
 341 
    $EPrefix          = $self->{EPrefix};
320 
    $ElPrefix         = $self->{ElPrefix};
 342 
    $ElPrefix         = $self->{ElPrefix};
- 
 
 343 
    $EIndent          = $self->{EIndent};
- 
 
 344 
    $EOffset          = $self->{EOffset};
321 
    $::ScmVerbose     = $self->{ScmVerbose};
 345 
    $::ScmVerbose     = $self->{ScmVerbose};
322 
    $::ScmDebug       = $self->{ScmDebug};
 346 
    $::ScmDebug       = $self->{ScmDebug};
323 
    $::ScmQuiet       = $self->{ScmQuiet};
 347 
    $::ScmQuiet       = $self->{ScmQuiet};
324 
    $ScmOnExit        = $self->{ScmOnExit};
 348 
    $ScmOnExit        = $self->{ScmOnExit};
325 
    $ScmDelayExit     = $self->{ScmDelayExit};
 349 
    $ScmDelayExit     = $self->{ScmDelayExit};
Line 359... Line 383...
359 
    #
 383 
    #
360 
    #   Generate the message prefix
 384 
    #   Generate the message prefix
361 
    #   This will only be used on the first line
 385 
    #   This will only be used on the first line
362 
    #   All other lines will have a space filled prefix
 386 
    #   All other lines will have a space filled prefix
363 
    #
 387 
    #
364 
    my $prefix = $EPrefix . $tag;
 388 
    my $prefix = $EPrefix . $tag. $EIndent;
365 
    #
 389 
    #
366 
    #   Kill the eol if the Question is being asked
 390 
    #   Kill the eol if the Question is being asked
367 
    #
 391 
    #
368 
    my $eol = ( $tag =~ m/Q/ ) ? "" : "\n";
 392 
    my $eol = ( $tag =~ m/Q/ ) ? "" : "\n";
369 
    foreach my $nextline ( @_ ) {
 393 
    foreach my $nextline ( @_ ) {
Line 372... Line 396...
372 
        if ( $count == 0 ) {
 396 
        if ( $count == 0 ) {
373 
            $line = ($ElPrefix || '') . $line;
 397 
            $line = ($ElPrefix || '') . $line;
374 
 
 398 
 
375 
        } elsif ( $count == 1 ) {
 399 
        } elsif ( $count == 1 ) {
376 
            my $bol = $eol ? "" : "\n";
 400 
            my $bol = $eol ? "" : "\n";
377 
            $prefix = $bol . ' ' x length($prefix);
 401 
            $prefix = $bol . ' ' x length($prefix) . $EOffset;
378 
        }
 402 
        }
379 
        $count++;
 403 
        $count++;
380 
 
 404 
 
381 
        if ($capturing && $tag =~ m/[MWEF]/) {
 405 
        if ($capturing && $tag =~ m/[MWEF]/) {
382 
            push @captured, "$prefix $line$eol"
406 
            push @captured, "$prefix $line$eol"