File Coverage

blib/lib/Continual/Process/Instance.pm
Criterion Covered Total %
statement 39 41 95.1
branch 12 14 85.7
condition 9 12 75.0
subroutine 11 11 100.0
pod 2 3 66.6
total 73 81 90.1


line stmt bran cond sub pod time code
1             package Continual::Process::Instance;
2 2     2   456 use strict;
  2         2  
  2         46  
3 2     2   5 use warnings;
  2         2  
  2         63  
4              
5 2     2   5 use constant WINDOWS => ($^O eq 'MSWin32');
  2         2  
  2         127  
6              
7             BEGIN {
8 2     2   29 if (WINDOWS) {
9             ## no critic (ProhibitStringyEval)
10             eval q{
11             use Win32::Process;
12             };
13              
14             die $@ if $@;
15             }
16             }
17              
18 2     2   390 use POSIX qw(:sys_wait_h);
  2         4216  
  2         8  
19             use Class::Tiny qw(name instance_id code pid parent_pid), {
20             id => sub {
21 0         0 my ($self) = @_;
22              
23 0         0 return sprintf '%s.%s', $self->name, $self->instance_id;
24             }
25 2     2   2091 };
  2         4787  
  2         12  
26              
27             =head1 NAME
28              
29             Continual::Process::Instance - one instance
30              
31             =head1 SYNOPSIS
32              
33             $instance = Continual::Process::Instance->new(
34             name => 'job1',
35             instance_id => 1,
36             code => sub {
37             ...
38             return $pid;
39             }
40             )->start();
41              
42             while(1) {
43             if (!$instance->is_alive()) {
44             $instance->start();
45             }
46             }
47              
48             =head1 DESCRIPTION
49              
50             This class represents one instance of L
51              
52             =head1 METHODS
53              
54             =head2 new(%attributes)
55              
56             =head3 %attributes
57              
58             =head4 name
59              
60             name of process
61              
62             =head4 instance_id
63              
64             id of instance (number)
65              
66             =head4 code
67              
68             CodeRef
69              
70             =cut
71              
72             sub BUILD {
73 19     19 0 3500 my ($self) = @_;
74              
75 19         28 foreach my $req (qw/name instance_id code/) {
76 54 100       832 die "$req attribute required" if !defined $self->$req;
77             }
78              
79 16 100       243 if (ref $self->code ne 'CODE') {
80 1         8 die 'code attribute must be CodeRef';
81             }
82              
83 15         257 $self->parent_pid($$);
84             }
85              
86             =head2 start()
87              
88             start this instance
89              
90             =cut
91              
92             sub start {
93 3     3 1 113 my ($self) = @_;
94              
95 3         42 $self->pid($self->_pid_check($self->code->($self)));
96              
97 1 50       17 print "# Start " . $self->id . " and run with pid: " . $self->pid . "\n" if $ENV{C_P_DEBUG};
98              
99 1         43 return $self;
100             }
101              
102             sub _pid_check {
103 3     3   604 my ($self, $pid) = @_;
104              
105 3 100       7 if (!defined $pid) {
106 1         7 die 'Undefined PID';
107             }
108 2 100       27 if ($pid !~ /^(?:-)?\d+$/) {
109 1         14 die "Returned PID ($pid) " . $self->name . " isn't number!";
110             }
111              
112 1         105 return $pid;
113             }
114              
115             =head2 is_alive()
116              
117             is this instance alive?
118              
119             =cut
120              
121             sub is_alive {
122 2     2 1 500 my ($self) = @_;
123              
124 2   66     39 return defined $self->pid && !waitpid $self->pid, WNOHANG;
125             }
126              
127             sub DESTROY {
128 19     19   1977 my ($self) = @_;
129              
130             # destroy only in parent (main) process
131             # ignore pseudo-process (<0) is threads and threads died with main
132 19 100 66     295 if (defined $self->parent_pid && $self->parent_pid == $$ && $self->pid && $self->pid > 0) {
      100        
      66        
133 1 50       103 print "# Kill PID ".$self->pid."\n" if $ENV{C_P_DEBUG};
134              
135 1         1 if (WINDOWS) {
136             Win32::Process::KillProcess($self->pid, 0);
137             }
138             else {
139 1         20 kill 15, $self->pid;
140             }
141             }
142             }
143              
144             =head1 LICENSE
145              
146             Copyright (C) Avast Software.
147              
148             This library is free software; you can redistribute it and/or modify
149             it under the same terms as Perl itself.
150              
151             =head1 AUTHOR
152              
153             Jan Seidl Eseidl@avast.comE
154              
155             =cut
156              
157             1;