Mercurial > pub > Impl
annotate Lib/IMPL/AppException.pm @ 266:89179bb8c388
*corrected TTView to handle plain (and undefined) values
*added URL generating methods to Application::Action
*fixed the compare validatior for schemas
author | cin |
---|---|
date | Mon, 14 Jan 2013 03:10:06 +0400 |
parents | 93963ec449c5 |
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; |