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