lib/exception.pm

   1 package exception;
   2
   3 use strict;
   4 use warnings;
   5
   6 use overload '""' => \&to_string;
   7
   8 use Devel::StackTrace;
   9
  10 # use Moose; ## Haha, if only.
  11
  12 ##### ACCESSORS #####
  13 sub message { shift->{message}; }
  14 sub stacktrace { shift->{stacktrace}; }
  15
  16 # Builder for stacktrace
  17 sub _build_stacktrace {
  18     shift->{stacktrace} = Devel::StackTrace->new(ignore_class => __PACKAGE__);
  19 }
  20
  21 # Stringification
  22 sub to_string {
  23     my ($self) = @_;
  24     my $first = 1;
  25     my @lines;
  26     while (my $frame = $self->{stacktrace}->next_frame) {
  27         if ($first) {
  28             $first = 0;
  29             # message at foo.pl line 1
  30             push @lines, sprintf("%s at %s line %s", $self->message, $frame->filename, $frame->line);
  31         } else {
  32             my @args = map { ref $_ ? "$_" : "'$_'" } $frame->args;
  33             # main::foo called at foo.pl line 1
  34             push @lines, sprintf("\t%s(%s) called at %s line %s", $frame->subroutine, join(", ", @args), $frame->filename, $frame->line);
  35         }
  36     }
  37     join("\n", @lines);
  38 }
  39
  40 # Constructor
  41 sub new {
  42     my ($class, %kwargs) = @_;
  43     $class = ref $class if ref $class; # Also take another exception object, if we must.
  44     my $message = $kwargs{message} || ''; # Default to no error message
  45
  46     # Construction
  47     my $self = bless {message => $message}, $class;
  48     $self->_build_stacktrace;
  49
  50     $self;
  51 }
  52
  53 1;
  54 __END__