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)) {