local-lib5/lib/perl5/XML/SAX/Exception.pm

   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