Line # Revision Author
1 3 ahitrov@rambler.ru package PidFile::Database;
2
3 use strict;
4 use warnings 'all';
5
6 use DBI;
7 use Digest::MD5 qw(md5);
8 use FindBin;
9 use POSIX qw(strftime);
10
11
12 sub new {
13 my ($class, $keeper, %opts) = @_;
14
15 my ($crc1, $crc2) = map {abs unpack 'j',$_} grep {$_} split /(.{8})/, md5(($opts{pid_name}||$FindBin::RealScript).($opts{per_host} ? $opts{host} : ''));
16
17 my $self = {
18 dbh => $keeper->SQL,
19 delay => exists $opts{delay} ? $opts{delay} : 30,
20 host => $opts{host},
21 mutex => $crc1^$crc2,
22 per_host => $opts{per_host},
23 script => "$FindBin::RealBin/$FindBin::RealScript",
24 verbose => $opts{verbose},
25 };
26
27 $self->{dbh}{PrintError} = 0;
28 $self->{dbh}{RaiseError} = 1;
29
30 bless $self, $class;
31 }
32
33 sub block {
34 my ($self, $now) = @_;
35
36 $self->{started} = $now;
37
38 unless ($self->{dbh}->selectrow_arrayref("SELECT pg_try_advisory_lock(?);", {}, $self->{mutex})->[0]) {
39 my $err = "Found alive process, exit\n";
40 die $err if $self->{verbose};
41 print $err;
42 exit;
43 }
44
45 $self->{dbh}->do("INSERT INTO pid (pid, mutex, host, script, started) VALUES (?,?,?,?,?)", {}, $$, $self->{mutex}, $self->{host}, $self->{script}, strftime('%Y-%m-%d %H:%M:%S', localtime $now));
46 $self->{id} = $self->{dbh}->selectrow_array("SELECT currval('documents_id_seq')");
47
48 print "Created PID record (PID: $$) at ".localtime($now)."\n" if $self->{verbose};
49 }
50
51 sub release {
52 my ($self, $now) = @_;
53
54 my $sleep = $self->{delay} ? $self->{delay} - ($now - $self->{started}) : 0;
55 $sleep = 0 if $sleep<0;
56
57 if ($sleep) {
58 print "Sleeping for $sleep seconds before exit...\n" if $self->{verbose};
59 sleep $sleep;
60 }
61
62 $self->{dbh}->do("UPDATE pid SET finished=? WHERE id=?", {}, strftime('%Y-%m-%d %H:%M:%S', localtime $now), $self->{id});
63 $self->{dbh}->do("SELECT pg_advisory_unlock(?);", {}, $self->{mutex});
64
65 print "Removed PID record (PID: $$) at ".localtime($now)."\n" if $self->{verbose};
66
67 return $sleep;
68 }
69
70 sub DESTROY {
71 my $self = shift;
72
73 eval {
74 $self->{dbh}->disconnect;
75 };
76 }
77
78 1;