Mercurial > pub > Impl
annotate Lib/IMPL/AppException.pm @ 269:dacfe7c0311a
SQL schema updated (unstable)
| author | sergey |
|---|---|
| date | Thu, 24 Jan 2013 20:00:27 +0400 |
| parents | 89179bb8c388 |
| children | 4ddb27ff4a0b |
| rev | line source |
|---|---|
| 253 | 1 package IMPL::AppException; |
| 2 use strict; | |
| 3 use mro 'c3'; | |
| 4 use overload | |
| 5 '""' => 'ToString', | |
| 6 'bool' => sub { return 1; }, | |
| 7 'fallback' => 1; | |
| 8 | |
| 9 use Carp qw(longmess shortmess); | |
| 10 use Scalar::Util qw(refaddr); | |
| 11 | |
| 12 use IMPL::Const qw(:prop); | |
| 13 use IMPL::Resources::Strings { | |
| 14 messageFormat => "Application exception" | |
| 15 }; | |
| 16 | |
| 17 use IMPL::declare { | |
| 18 base => [ | |
|
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
261
diff
changeset
|
19 'IMPL::Object' => undef |
| 253 | 20 ], |
| 21 props => [ | |
| 22 source => PROP_RO, | |
| 23 callStack => PROP_RO, | |
| 24 _cachedMessage => PROP_RW | |
| 25 ] | |
| 26 }; | |
| 27 | |
| 28 sub new { | |
| 29 my $self = shift; | |
| 30 | |
| 31 my $instance = $self->next::method(@_); | |
|
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
261
diff
changeset
|
32 |
|
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
261
diff
changeset
|
33 $instance->source(shortmess); |
|
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
261
diff
changeset
|
34 $instance->callStack(longmess); |
| 253 | 35 |
| 36 return $instance; | |
| 37 } | |
| 38 | |
| 39 | |
| 40 sub message { | |
| 41 my ($this) = @_; | |
| 42 | |
| 43 if (my $msg = $this->_cachedMessage) { | |
| 44 return $msg; | |
| 45 } else { | |
| 46 my $formatter = $this->can('messageFormat'); | |
| 47 return $this->_cachedMessage($formatter->($this)); | |
| 48 } | |
| 49 } | |
| 50 | |
| 51 sub ToString { | |
| 52 my ($this) = @_; | |
| 53 | |
| 54 return join("\n", $this->message, $this->callStack); | |
| 55 } | |
| 56 | |
| 261 | 57 sub throw { |
| 58 my $self = shift; | |
| 59 | |
| 60 die $self->new(@_); | |
| 61 } | |
| 62 | |
| 253 | 63 1; |