uh_parser/XML/SAX/Exception.pm
changeset 177 6d3c3db11e72
equal deleted inserted replaced
176:266a7e9b9237 177:6d3c3db11e72
       
     1 package XML::SAX::Exception;
       
     2 
       
     3 use strict;
       
     4 
       
     5 use overload '""' => "stringify",
       
     6     'fallback' => 1;
       
     7 
       
     8 use vars qw/$StackTrace $VERSION/;
       
     9 $VERSION = '1.01';
       
    10 use Carp;
       
    11 
       
    12 $StackTrace = $ENV{XML_DEBUG} || 0;
       
    13 
       
    14 # Other exception classes:
       
    15 
       
    16 @XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception');
       
    17 @XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception');
       
    18 @XML::SAX::Exception::Parse::ISA = ('XML::SAX::Exception');
       
    19 
       
    20 
       
    21 sub throw {
       
    22     my $class = shift;
       
    23     if (ref($class)) {
       
    24         die $class;
       
    25     }
       
    26     die $class->new(@_);
       
    27 }
       
    28 
       
    29 sub new {
       
    30     my $class = shift;
       
    31     my %opts = @_;
       
    32     confess "Invalid options: " . join(', ', keys %opts) unless exists $opts{Message};
       
    33     
       
    34     bless { ($StackTrace ? (StackTrace => stacktrace()) : ()), %opts },
       
    35         $class;
       
    36 }
       
    37 
       
    38 sub stringify {
       
    39     my $self = shift;
       
    40     local $^W;
       
    41     my $error;
       
    42     if (exists $self->{LineNumber}) {
       
    43         $error = $self->{Message} . " [Ln: " . $self->{LineNumber} . 
       
    44                 ", Col: " . $self->{ColumnNumber} . "]";
       
    45     }
       
    46     else {
       
    47         $error = $self->{Message};
       
    48     }
       
    49     if ($StackTrace) {
       
    50         $error .= stackstring($self->{StackTrace});
       
    51     }
       
    52     $error .= "\n";
       
    53     return $error;
       
    54 }
       
    55 
       
    56 sub stacktrace {
       
    57     my $i = 2;
       
    58     my @fulltrace;
       
    59     while (my @trace = caller($i++)) {
       
    60         my %hash;
       
    61         @hash{qw(Package Filename Line)} = @trace[0..2];
       
    62         push @fulltrace, \%hash;
       
    63     }
       
    64     return \@fulltrace;
       
    65 }
       
    66 
       
    67 sub stackstring {
       
    68     my $stacktrace = shift;
       
    69     my $string = "\nFrom:\n";
       
    70     foreach my $current (@$stacktrace) {
       
    71         $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n";
       
    72     }
       
    73     return $string;
       
    74 }
       
    75 
       
    76 1;
       
    77 
       
    78 __END__
       
    79 
       
    80 =head1 NAME
       
    81 
       
    82 XML::SAX::Exception - Exception classes for XML::SAX
       
    83 
       
    84 =head1 SYNOPSIS
       
    85 
       
    86   throw XML::SAX::Exception::NotSupported(
       
    87           Message => "The foo feature is not supported",
       
    88           );
       
    89 
       
    90 =head1 DESCRIPTION
       
    91 
       
    92 This module is the base class for all SAX Exceptions, those defined in
       
    93 the spec as well as those that one may create for one's own SAX errors.
       
    94 
       
    95 There are three subclasses included, corresponding to those of the SAX
       
    96 spec:
       
    97 
       
    98   XML::SAX::Exception::NotSupported
       
    99   XML::SAX::Exception::NotRecognized
       
   100   XML::SAX::Exception::Parse
       
   101 
       
   102 Use them wherever you want, and as much as possible when you encounter
       
   103 such errors. SAX is meant to use exceptions as much as possible to 
       
   104 flag problems.
       
   105 
       
   106 =head1 CREATING NEW EXCEPTION CLASSES
       
   107 
       
   108 All you need to do to create a new exception class is:
       
   109 
       
   110   @XML::SAX::Exception::MyException::ISA = ('XML::SAX::Exception')
       
   111 
       
   112 The given package doesn't need to exist, it'll behave correctly this 
       
   113 way. If your exception refines an existing exception class, then you
       
   114 may also inherit from that instead of from the base class.
       
   115 
       
   116 =head1 THROWING EXCEPTIONS
       
   117 
       
   118 This is as simple as exemplified in the SYNOPSIS. In fact, there's 
       
   119 nothing more to know. All you have to do is:
       
   120 
       
   121   throw XML::SAX::Exception::MyException( Message => 'Something went wrong' );
       
   122 
       
   123 and voila, you've thrown an exception which can be caught in an eval block.
       
   124 
       
   125 =cut
       
   126