| 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 | XML::SAX::Exception::BEGIN |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::Exception::new |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::Exception::stackstring |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::Exception::stacktrace |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::Exception::stringify |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::Exception::throw |
| 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 |