Commit | Line | Data |
69aaad21 |
1 | package Object::Remote::WatchDog; |
2 | |
3 | use Object::Remote::MiniLoop; |
4 | use Object::Remote::Logging qw ( :log :dlog ); |
5 | use Moo; |
6 | |
69aaad21 |
7 | has timeout => ( is => 'ro', required => 1 ); |
8 | |
9 | around new => sub { |
10 | my ($orig, $self, @args) = @_; |
11 | our ($WATCHDOG); |
12 | |
13 | return $WATCHDOG if defined $WATCHDOG; |
14 | log_trace { "Constructing new instance of global watchdog" }; |
15 | return $WATCHDOG = $self->$orig(@args); |
16 | }; |
17 | |
18 | #start the watchdog |
19 | sub BUILD { |
20 | my ($self) = @_; |
e5b3f03f |
21 | |
22 | $SIG{ALRM} = sub { |
23 | #if the Watchdog is killing the process we don't want any chance of the |
24 | #process not actually exiting and die could be caught by an eval which |
25 | #doesn't do us any good |
26 | log_error { sprintf("Watchdog has expired, terminating the process at file %s line %s", __FILE__, __LINE__ + 1); }; |
27 | exit(1); |
28 | }; |
29 | |
69aaad21 |
30 | Dlog_debug { "Initializing watchdog with timeout of $_ seconds" } $self->timeout; |
31 | alarm($self->timeout); |
32 | } |
33 | |
34 | #invoke at least once per timeout to stop |
35 | #the watchdog from killing the process |
36 | sub reset { |
37 | our ($WATCHDOG); |
38 | die "Attempt to reset the watchdog before it was constructed" |
39 | unless defined $WATCHDOG; |
40 | |
bfbbdcff |
41 | log_debug { "Watchdog has been reset" }; |
69aaad21 |
42 | alarm($WATCHDOG->timeout); |
43 | } |
44 | |
45 | #must explicitly call this method to stop the |
46 | #watchdog from killing the process - if the |
47 | #watchdog is lost because it goes out of scope |
48 | #it makes sense to still terminate the process |
49 | sub shutdown { |
50 | my ($self) = @_; |
bfbbdcff |
51 | log_debug { "Watchdog is shutting down" }; |
69aaad21 |
52 | alarm(0); |
53 | } |
54 | |
55 | 1; |
56 | |
57 | |