File | /usr/share/perl5/XML/SAX/Exception.pm |
Statements Executed | 18 |
Total Time | 0.0006275 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | XML::SAX::Exception::
0 | 0 | 0 | 0s | 0s | new | XML::SAX::Exception::
0 | 0 | 0 | 0s | 0s | stackstring | XML::SAX::Exception::
0 | 0 | 0 | 0s | 0s | stacktrace | XML::SAX::Exception::
0 | 0 | 0 | 0s | 0s | stringify | XML::SAX::Exception::
0 | 0 | 0 | 0s | 0s | throw | XML::SAX::Exception::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package XML::SAX::Exception; | |||
2 | ||||
3 | 3 | 30µs | 10µs | use strict; # spent 7µs making 1 call to strict::import |
4 | ||||
5 | use overload '""' => "stringify", # spent 58µs making 1 call to overload::import | |||
6 | 3 | 37µs | 12µs | 'fallback' => 1; |
7 | ||||
8 | 3 | 38µs | 13µs | use vars qw/$StackTrace $VERSION/; # spent 37µs making 1 call to vars::import |
9 | 1 | 700ns | 700ns | $VERSION = '1.01'; |
10 | 3 | 490µs | 163µs | use Carp; # spent 64µs making 1 call to Exporter::import |
11 | ||||
12 | 1 | 1µs | 1µs | $StackTrace = $ENV{XML_DEBUG} || 0; |
13 | ||||
14 | # Other exception classes: | |||
15 | ||||
16 | 1 | 12µs | 12µs | @XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception'); |
17 | 1 | 5µs | 5µs | @XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception'); |
18 | 1 | 4µs | 4µs | @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 | 11µs | 11µs | 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 |