end0tknrのkipple - web開発日記

Proc::Daemonでperlデーモンプログラムを書いてみる

perl

perlでデーモンを作成することになりそうなので、

調べてみると、次のurlで Proc::Daemon が紹介されていたので、試しに書いてみました。

http://perltips.twinkle.cc/perl/daemon.php

http://perltips.twinkle.cc/server/linux_daemon_startup_init_d.php

とりあえず、動作しているけど、どうなのかな?

#!/usr/local/bin/perl
use strict;
use warnings;
use utf8;
use DBI;
use Date::Calc qw/Today_and_Now/;
use FindBin;
use Proc::Daemon;

my $PID;	#process id
my $PID_FILE = $FindBin::Bin."/daemon.pid";
my $SLEEP_INTERVAL = 10;
my $CONF_DB =
    {host =>    "localhost",
     db_name=>  "test",
     db_user=>  "root",
     db_pass=>  ""
    };
my $DBH;

main(@ARGV);
exit(0);

sub main {
    my ($act) = @_;
    $act ||="";

    if ($act eq "start"){	#daemonの起動
	#複数の起動はできません
	if( get_pid_file() ){
	    print "$0 is already running\n";
	    return;
	}
	init();
	run();
	return;
    }

    if ($act eq "stop"){	#daemonの停止
	my $pid = get_pid_file();
	if(not defined $pid){
	    print "$0 is not running\n";
	    return;
	}
	#pid fileを削除すると、後でkillされます
	return del_pid_file();
    }

    print "usage: $0 [start|stop]\n";
    return;
}

sub init {
    Proc::Daemon::Init;	#daemon化

    #signal送信時に実行するmethod
    $SIG{INT} = $SIG{HUP} = $SIG{QUIT} = $SIG{KILL} = $SIG{TERM} ='interrupt';

    $PID = $$;
    set_pid_file($PID);
    $DBH = connect_db();
}

sub run {
    while(1) {
        action();	#actionの内容は、自由に編集してください
        sleep($SLEEP_INTERVAL);

	#pidファイルが削除されていれば、自分自身をkillします
	if (not get_pid_file() ){
	    $DBH->disconnect;
	    kill $PID;
	    return;
	}
    }
}

sub interrupt {	#signal送信時に実行されます
    my ($sig) = @_;
    $SIG{$sig} = 'IGNORE';
    return del_pid_file();
}

sub get_pid_file {	#pid fileの名称とpidの取得
    return undef if not -e $PID_FILE;

    open my $fh, $PID_FILE or die "can't open $PID_FILE :$!";
    my ($line) = <$fh>;
    close $fh or die "can't close $PID_FILE :$!";

    my ($pid) = $line =~ /(\d+)/o;
    return ($PID_FILE,$pid);
}

sub set_pid_file {	#pid fileにpidを書き込み
    my ($process_id) = @_;
    open my $fh, ">$PID_FILE" or die "can't open $PID_FILE :$!";
    print $fh $process_id;
    close $fh or die "can't close $PID_FILE :$!";
}
sub del_pid_file {
    unlink $PID_FILE or die "can't unlink $PID_FILE :$!";
}

sub action {
    my $sql =<<EOF;
insert into test_sid (time_val) values(?)
EOF
    my $sth = $DBH->prepare($sql);
    my @now = Today_and_Now();
    my $now_str = "$now[0]-$now[1]-$now[2] $now[3]:$now[4]:$now[5]";
    $sth->execute($now_str);
    $DBH->commit;
    return 1;
}

sub connect_db {
    my $db = "DBI:mysql:database=$CONF_DB->{db_name};host=$CONF_DB->{host}";
    return DBI->connect($db, $CONF_DB->{db_user}, $CONF_DB->{db_pass});
}
1;

参考までに、使用可能なシグナル名は、$Config{sig_name} で表示

使用可能なシグナル名は環境によって異なると思いますが、

使用可能なシグナル名は$Config{sig_name}で一覧表示できます。

#!/usr/local/bin/perl
use strict;
use warnings;
use utf8;
use Config;

print $Config{sig_name},"\n";

実行結果

[endo@colinux tmp]$ ./foo.pl 
ZERO HUP INT QUIT ILL TRAP ABRT BUS FPE KILL USR1 SEGV USR2
PIPE ALRM TERM STKFLT CHLD CONT STOP TSTP TTIN TTOU URG XCPU
XFSZ VTALRM PROF WINCH IO PWR SYS
NUM32 NUM33 RTMIN NUM35 NUM36 NUM37 NUM38 NUM39
NUM40 NUM41 NUM42 NUM43 NUM44 NUM45 NUM46 NUM47 NUM48 NUM49
NUM50 NUM51 NUM52 NUM53 NUM54 NUM55 NUM56 NUM57 NUM58 NUM59
NUM60 NUM61 NUM62 NUM63 RTMAX IOT CLD POLL UNUSED
[endo@colinux tmp]$

gihyo.jpのPerl Hackers Hubも参考になるかも?

※2011/4/26追記

次のurlにあるPerl Hackers Hubでは、「第6回　UNIXプログラミングの勘所（3）」として

シグナル制御が記載されていました。

http://gihyo.jp/dev/serial/01/perl-hackers-hub/000603

シグナル名もよく忘れるので、機会があれば、読み返すつもりです

シグナル名	意味
SIGHUP	主に設定ファイルの再読み込みを要求するために使用
SIGINT	割り込みを要求（Ctrl-Cが押された場合など）
SIGKILL	プロセスを強制終了
SIGPIPE	閉じられたパイプやソケットに書き込もうとした
SIGALRM	alarmで設定した時間が経過
SIGTERM	プロセスの終了を要請
SIGCHLD	子プロセスが終了

ツイートする

Permalink | コメント(2) | トラックバック(3) | 17:15