annotate Lib/IMPL/AppException.pm @ 253:0a228a35645c

added application exception class
author sergey
date Mon, 19 Nov 2012 17:54:01 +0400
parents
children 93963ec449c5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
253
0a228a35645c added application exception class
sergey
parents:
diff changeset
1 package IMPL::AppException;
0a228a35645c added application exception class
sergey
parents:
diff changeset
2 use strict;
0a228a35645c added application exception class
sergey
parents:
diff changeset
3 use mro 'c3';
0a228a35645c added application exception class
sergey
parents:
diff changeset
4 use overload
0a228a35645c added application exception class
sergey
parents:
diff changeset
5 '""' => 'ToString',
0a228a35645c added application exception class
sergey
parents:
diff changeset
6 'bool' => sub { return 1; },
0a228a35645c added application exception class
sergey
parents:
diff changeset
7 'fallback' => 1;
0a228a35645c added application exception class
sergey
parents:
diff changeset
8
0a228a35645c added application exception class
sergey
parents:
diff changeset
9 use Carp qw(longmess shortmess);
0a228a35645c added application exception class
sergey
parents:
diff changeset
10 use Scalar::Util qw(refaddr);
0a228a35645c added application exception class
sergey
parents:
diff changeset
11
0a228a35645c added application exception class
sergey
parents:
diff changeset
12 use IMPL::Const qw(:prop);
0a228a35645c added application exception class
sergey
parents:
diff changeset
13 use IMPL::Resources::Strings {
0a228a35645c added application exception class
sergey
parents:
diff changeset
14 messageFormat => "Application exception"
0a228a35645c added application exception class
sergey
parents:
diff changeset
15 };
0a228a35645c added application exception class
sergey
parents:
diff changeset
16
0a228a35645c added application exception class
sergey
parents:
diff changeset
17 use IMPL::declare {
0a228a35645c added application exception class
sergey
parents:
diff changeset
18 base => [
0a228a35645c added application exception class
sergey
parents:
diff changeset
19 'IMPL::Object' => '@_'
0a228a35645c added application exception class
sergey
parents:
diff changeset
20 ],
0a228a35645c added application exception class
sergey
parents:
diff changeset
21 props => [
0a228a35645c added application exception class
sergey
parents:
diff changeset
22 source => PROP_RO,
0a228a35645c added application exception class
sergey
parents:
diff changeset
23 callStack => PROP_RO,
0a228a35645c added application exception class
sergey
parents:
diff changeset
24 _cachedMessage => PROP_RW
0a228a35645c added application exception class
sergey
parents:
diff changeset
25 ]
0a228a35645c added application exception class
sergey
parents:
diff changeset
26 };
0a228a35645c added application exception class
sergey
parents:
diff changeset
27
0a228a35645c added application exception class
sergey
parents:
diff changeset
28 sub new {
0a228a35645c added application exception class
sergey
parents:
diff changeset
29 my $self = shift;
0a228a35645c added application exception class
sergey
parents:
diff changeset
30 local $Carp::CarpLevel = 0;
0a228a35645c added application exception class
sergey
parents:
diff changeset
31
0a228a35645c added application exception class
sergey
parents:
diff changeset
32 my $instance = $self->next::method(@_);
0a228a35645c added application exception class
sergey
parents:
diff changeset
33
0a228a35645c added application exception class
sergey
parents:
diff changeset
34 $instance->callStack(longmess);
0a228a35645c added application exception class
sergey
parents:
diff changeset
35 $instance->source(shortmess);
0a228a35645c added application exception class
sergey
parents:
diff changeset
36
0a228a35645c added application exception class
sergey
parents:
diff changeset
37 return $instance;
0a228a35645c added application exception class
sergey
parents:
diff changeset
38 }
0a228a35645c added application exception class
sergey
parents:
diff changeset
39
0a228a35645c added application exception class
sergey
parents:
diff changeset
40
0a228a35645c added application exception class
sergey
parents:
diff changeset
41 sub message {
0a228a35645c added application exception class
sergey
parents:
diff changeset
42 my ($this) = @_;
0a228a35645c added application exception class
sergey
parents:
diff changeset
43
0a228a35645c added application exception class
sergey
parents:
diff changeset
44 if (my $msg = $this->_cachedMessage) {
0a228a35645c added application exception class
sergey
parents:
diff changeset
45 return $msg;
0a228a35645c added application exception class
sergey
parents:
diff changeset
46 } else {
0a228a35645c added application exception class
sergey
parents:
diff changeset
47 my $formatter = $this->can('messageFormat');
0a228a35645c added application exception class
sergey
parents:
diff changeset
48 return $this->_cachedMessage($formatter->($this));
0a228a35645c added application exception class
sergey
parents:
diff changeset
49 }
0a228a35645c added application exception class
sergey
parents:
diff changeset
50 }
0a228a35645c added application exception class
sergey
parents:
diff changeset
51
0a228a35645c added application exception class
sergey
parents:
diff changeset
52 sub ToString {
0a228a35645c added application exception class
sergey
parents:
diff changeset
53 my ($this) = @_;
0a228a35645c added application exception class
sergey
parents:
diff changeset
54
0a228a35645c added application exception class
sergey
parents:
diff changeset
55 return join("\n", $this->message, $this->callStack);
0a228a35645c added application exception class
sergey
parents:
diff changeset
56 }
0a228a35645c added application exception class
sergey
parents:
diff changeset
57
0a228a35645c added application exception class
sergey
parents:
diff changeset
58 1;