1 # $Id: Exception.pm,v 1.2 2001/11/14 11:07:25 matt Exp $ |
|
2 |
|
3 package XML::SAX::PurePerl::Exception; |
|
4 |
|
5 use strict; |
|
6 |
|
7 use overload '""' => "stringify"; |
|
8 |
|
9 use vars qw/$StackTrace/; |
|
10 |
|
11 $StackTrace = $ENV{XML_DEBUG} || 0; |
|
12 |
|
13 sub throw { |
|
14 my $class = shift; |
|
15 die $class->new(@_); |
|
16 } |
|
17 |
|
18 sub new { |
|
19 my $class = shift; |
|
20 my %opts = @_; |
|
21 die "Invalid options" unless exists $opts{Message}; |
|
22 |
|
23 if ($opts{reader}) { |
|
24 return bless { Message => $opts{Message}, |
|
25 Exception => undef, # not sure what this is for!!! |
|
26 ColumnNumber => $opts{reader}->column, |
|
27 LineNumber => $opts{reader}->line, |
|
28 PublicId => $opts{reader}->public_id, |
|
29 SystemId => $opts{reader}->system_id, |
|
30 $StackTrace ? (StackTrace => stacktrace()) : (), |
|
31 }, $class; |
|
32 } |
|
33 return bless { Message => $opts{Message}, |
|
34 Exception => undef, # not sure what this is for!!! |
|
35 }, $class; |
|
36 } |
|
37 |
|
38 sub stringify { |
|
39 my $self = shift; |
|
40 local $^W; |
|
41 return $self->{Message} . " [Ln: " . $self->{LineNumber} . |
|
42 ", Col: " . $self->{ColumnNumber} . "]" . |
|
43 ($StackTrace ? stackstring($self->{StackTrace}) : "") . "\n"; |
|
44 } |
|
45 |
|
46 sub stacktrace { |
|
47 my $i = 2; |
|
48 my @fulltrace; |
|
49 while (my @trace = caller($i++)) { |
|
50 my %hash; |
|
51 @hash{qw(Package Filename Line)} = @trace[0..2]; |
|
52 push @fulltrace, \%hash; |
|
53 } |
|
54 return \@fulltrace; |
|
55 } |
|
56 |
|
57 sub stackstring { |
|
58 my $stacktrace = shift; |
|
59 my $string = "\nFrom:\n"; |
|
60 foreach my $current (@$stacktrace) { |
|
61 $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n"; |
|
62 } |
|
63 return $string; |
|
64 } |
|
65 |
|
66 1; |
|
67 |
|