annotate Lib/IMPL/AppException.pm @ 261:93963ec449c5

sync
author sergey
date Fri, 28 Dec 2012 16:43:03 +0400
parents 0a228a35645c
children 89179bb8c388
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
0a228a35645c added application exception class
sergey
parents:
diff changeset
31 my $instance = $self->next::method(@_);
0a228a35645c added application exception class
sergey
parents:
diff changeset
32
0a228a35645c added application exception class
sergey
parents:
diff changeset
33 $instance->callStack(longmess);
0a228a35645c added application exception class
sergey
parents:
diff changeset
34 $instance->source(shortmess);
0a228a35645c added application exception class
sergey
parents:
diff changeset
35
0a228a35645c added application exception class
sergey
parents:
diff changeset
36 return $instance;
0a228a35645c added application exception class
sergey
parents:
diff changeset
37 }
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 sub message {
0a228a35645c added application exception class
sergey
parents:
diff changeset
41 my ($this) = @_;
0a228a35645c added application exception class
sergey
parents:
diff changeset
42
0a228a35645c added application exception class
sergey
parents:
diff changeset
43 if (my $msg = $this->_cachedMessage) {
0a228a35645c added application exception class
sergey
parents:
diff changeset
44 return $msg;
0a228a35645c added application exception class
sergey
parents:
diff changeset
45 } else {
0a228a35645c added application exception class
sergey
parents:
diff changeset
46 my $formatter = $this->can('messageFormat');
0a228a35645c added application exception class
sergey
parents:
diff changeset
47 return $this->_cachedMessage($formatter->($this));
0a228a35645c added application exception class
sergey
parents:
diff changeset
48 }
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 sub ToString {
0a228a35645c added application exception class
sergey
parents:
diff changeset
52 my ($this) = @_;
0a228a35645c added application exception class
sergey
parents:
diff changeset
53
0a228a35645c added application exception class
sergey
parents:
diff changeset
54 return join("\n", $this->message, $this->callStack);
0a228a35645c added application exception class
sergey
parents:
diff changeset
55 }
0a228a35645c added application exception class
sergey
parents:
diff changeset
56
261
sergey
parents: 253
diff changeset
57 sub throw {
sergey
parents: 253
diff changeset
58 my $self = shift;
sergey
parents: 253
diff changeset
59
sergey
parents: 253
diff changeset
60 die $self->new(@_);
sergey
parents: 253
diff changeset
61 }
sergey
parents: 253
diff changeset
62
253
0a228a35645c added application exception class
sergey
parents:
diff changeset
63 1;