Line # Revision Author
1 3 ahitrov@rambler.ru package PidFile::File;
2
3 use strict;
4 use warnings 'all';
5
6 use Fcntl qw(:flock);
7 use FindBin;
8
9
10 sub new {
11 my ($class, $pid_dir, %opts) = @_;
12
13 die "PID directory required\n" unless $pid_dir && -d $pid_dir;
14 $pid_dir =~ s#/+$##;
15
16 my $self = {
17 file => "$pid_dir/".($opts{pid_name}||"$FindBin::RealScript.pid"),
18 host => $opts{host},
19 verbose => $opts{verbose},
20 };
21
22 bless $self, $class;
23 }
24
25 sub block {
26 my ($self, $now) = @_;
27
28 if (-f $self->{file}) {
29 warn "Found existing PID file, check for alive process...\n" if $self->{verbose};
30 open PID, "<$self->{file}" or die "Can't read existing PID file - $!\n";
31 chomp(local $_ = <PID>);
32 warn "Found previous PID: $_\n" if $self->{verbose};
33 unless (flock PID, LOCK_EX|LOCK_NB) {
34 if ($self->{verbose}) {
35 die "Found alive process, exit\n";
36 } else {
37 print "Found alive process, exit\n";
38 exit;
39 }
40 }
41 close PID;
42 warn "No alive process were found\n" if $self->{verbose};
43 }
44
45 open PID, ">$self->{file}" or die "Can't create PID file - $!\n";
46 flock PID, LOCK_EX or die "Can't lock PID files - $!\n";
47 select((select(PID), $|=1)[0]);
48 print PID $$;
49 $self->{handle} = *PID;
50
51 print "Created PID file (PID: $$) at ".localtime($now)."\n" if $self->{verbose};
52 }
53
54 sub release {
55 my ($self, $now) = @_;
56
57 return unless $self->{handle};
58
59 flock $self->{handle}, LOCK_UN;
60 close $self->{handle};
61 unlink $self->{file} or die "Can't unlink self PID file - $!\n";
62
63 print "Removed PID file (PID: $$) at ".localtime($now)."\n" if $self->{verbose};
64
65 return 0;
66 }
67
68 1;