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