<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># $Id$

package XML::SAX::PurePerl::Exception;

use strict;

use overload '""' =&gt; "stringify";

use vars qw/$StackTrace/;

$StackTrace = $ENV{XML_DEBUG} || 0;

sub throw {
    my $class = shift;
    die $class-&gt;new(@_);
}

sub new {
    my $class = shift;
    my %opts = @_;
    die "Invalid options" unless exists $opts{Message};
    
    if ($opts{reader}) {
        return bless { Message =&gt; $opts{Message},
                        Exception =&gt; undef, # not sure what this is for!!!
                        ColumnNumber =&gt; $opts{reader}-&gt;column,
                        LineNumber =&gt; $opts{reader}-&gt;line,
                        PublicId =&gt; $opts{reader}-&gt;public_id,
                        SystemId =&gt; $opts{reader}-&gt;system_id,
                        $StackTrace ? (StackTrace =&gt; stacktrace()) : (),
                    }, $class;
    }
    return bless { Message =&gt; $opts{Message},
                    Exception =&gt; undef, # not sure what this is for!!!
                  }, $class;
}

sub stringify {
    my $self = shift;
    local $^W;
    return $self-&gt;{Message} . " [Ln: " . $self-&gt;{LineNumber} . 
                ", Col: " . $self-&gt;{ColumnNumber} . "]" .
                ($StackTrace ? stackstring($self-&gt;{StackTrace}) : "") . "\n";
}

sub stacktrace {
    my $i = 2;
    my @fulltrace;
    while (my @trace = caller($i++)) {
        my %hash;
        @hash{qw(Package Filename Line)} = @trace[0..2];
        push @fulltrace, \%hash;
    }
    return \@fulltrace;
}

sub stackstring {
    my $stacktrace = shift;
    my $string = "\nFrom:\n";
    foreach my $current (@$stacktrace) {
        $string .= $current-&gt;{Filename} . " Line: " . $current-&gt;{Line} . "\n";
    }
    return $string;
}

1;

</pre></body></html>