Subversion Repositories DevTools

Rev

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

Rev 279 Rev 283
Line 16... Line 16...
16 
#                 For use with existing scripts
 16 
#                 For use with existing scripts
17 
#
 17 
#
18 
#
 18 
#
19 
#......................................................................#
 19 
#......................................................................#
20 
 
 20 
 
- 
 
 21 
package JatsError;
- 
 
 22 
use base qw(Exporter);
- 
 
 23 
 
21 
require 5.006_001;
 24 
require 5.006_001;
22 
use strict;
 25 
use strict;
23 
use warnings;
 26 
use warnings;
24 
use Data::Dumper;
 27 
use Data::Dumper;
25 
use IO::Handle;
 28 
use IO::Handle;
26 
 
 29 
 
27 
package JatsError;
 - 
 
28 
 
 - 
 
29 
#-------------------------------------------------------------------------------
 30 
#-------------------------------------------------------------------------------
30 
# Function        : BEGIN
 31 
# Function        : BEGIN
31 
#
 32 
#
32 
# Description     : Standard Package Interface
 33 
# Description     : Standard Package Interface
33 
#
 34 
#
Line 35... Line 36...
35 
#
 36 
#
36 
# Returns         :
 37 
# Returns         :
37 
#
 38 
#
38 
 
 39 
 
39 
BEGIN {
 40 
BEGIN {
40 
    use Exporter   ();
 - 
 
41 
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 41 
    our ($VERSION, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
42 
 
 42 
 
43 
    # set the version for version checking
 43 
    # set the version for version checking
44 
    $VERSION     = 1.00;
 44 
    $VERSION     = 1.00;
45 
 
 45 
 
46 
    @ISA         = qw(Exporter);
 - 
 
47 
    @EXPORT      = qw(ErrorConfig ErrorReConfig ErrorDoExit
 46 
    @EXPORT      = qw(ErrorConfig ErrorReConfig ErrorDoExit
48 
                      ReportError Fatal Error Warning
 47 
                      ReportError Fatal Error Warning
49 
                      Message Message1
 48 
                      Message Message1
50 
                      Information Information1
 49 
                      Information Information1
51 
                      Question
 50 
                      Question
Line 361... Line 360...
361 
    my $eol = ( $tag =~ m/Q/ ) ? "" : "\n";
 360 
    my $eol = ( $tag =~ m/Q/ ) ? "" : "\n";
362 
    foreach my $nextline ( @_ )
 361 
    foreach my $nextline ( @_ )
363 
    {
 362 
    {
364 
        next unless ( defined $nextline );              # Ignore undefined arguments
 363 
        next unless ( defined $nextline );              # Ignore undefined arguments
365 
        chomp( my $line = $nextline );
 364 
        chomp( my $line = $nextline );
366 
        if ( $count eq 1 )
 365 
        if ( $count == 1 )
367 
        {
 366 
        {
368 
            my $bol = $eol ? "" : "\n";
 367 
            my $bol = $eol ? "" : "\n";
369 
            $prefix = $bol . ' ' x length($prefix);
 368 
            $prefix = $bol . ' ' x length($prefix);
370 
        }
 369 
        }
371 
 
 370 
 
Line 550... Line 549...
550 
        #   Kill error processing while doing error exit processing
 549 
        #   Kill error processing while doing error exit processing
551 
        #
 550 
        #
552 
        if ( my $func = $ScmOnExit )
 551 
        if ( my $func = $ScmOnExit )
553 
        {
 552 
        {
554 
            $ScmOnExit = undef;
 553 
            $ScmOnExit = undef;
555 
            &$func();
 554 
            &$func( $ScmExitCode );
556 
        }
 555 
        }
557 
        exit $ScmExitCode;
 556 
        exit $ScmExitCode;
558 
    }
 557 
    }
559 
}
 558 
}
560 
 
 559 
 
Line 766... Line 765...
766 
    no strict "vars";
 765 
    no strict "vars";
767 
    no strict "refs";
 766 
    no strict "refs";
768 
    my ($packageName) = @_;
 767 
    my ($packageName) = @_;
769 
    print "==DebugDumpPackage: $packageName =============================\n";
 768 
    print "==DebugDumpPackage: $packageName =============================\n";
770 
 
 769 
 
771 
 
 - 
 
772 
    local (*alias);             # a local typeglob
 - 
 
773 
    local $Data::Dumper::Pad = "\t ";
 770 
    local $Data::Dumper::Pad = "\t ";
774 
    local $Data::Dumper::Maxdepth = 2;
 771 
    local $Data::Dumper::Maxdepth = 2;
775 
    local $Data::Dumper::Indent  = 1;
 772 
    local $Data::Dumper::Indent  = 1;
776 
 
 773 
 
777 
    # We want to get access to the stash corresponding to the package name
 774 
    # We want to get access to the stash corresponding to the package name
Line 782... Line 779...
782 
    # indexed by symbol names.
 779 
    # indexed by symbol names.
783 
    while (my ($varName, $globValue) = each %stash)
 780 
    while (my ($varName, $globValue) = each %stash)
784 
    {
 781 
    {
785 
        print "$varName =============================\n";
 782 
        print "$varName =============================\n";
786 
        next if ( $varName eq 'stash' );
 783 
        next if ( $varName eq 'stash' );
787 
        *alias = $globValue;
 784 
        local *alias = $globValue;
788 
        if (defined ($alias)) {
 785 
        if (defined ($alias)) {
789 
            print Data::Dumper->Dump ( [$alias], ["*$varName" ]);
 786 
            print Data::Dumper->Dump ( [$alias], ["*$varName" ]);
790 
#            print "\t \$$varName $alias \n";
 787 
#            print "\t \$$varName $alias \n";
791 
        }
788 
        }
792 
        if (defined (@alias)) {
 789 
        if (defined (@alias)) {