Proc::Daemonを使ったディレクトリ監視フレームワーク

業務上、よくあるシチュエーションで

• とあるディレクトリを監視し、来たファイルに対して処理を行う

というのがあるが、その際に

• ディレクトリの監視
• メイン処理

を毎回別物で書くのは非常にめんどくさい。
ディレクトリを監視するプロセスをフレームワークとして作っておけば、あとはメイン処理のコードを書くだけで終わるはず。
で、出来たのがProc::Daemonを使った監視用プログラム。
メイン処理用プログラムは、ファイルを引数渡しで実行できるようにしておけばOK

filewatchd.pl

#!/usr/bin/perl

use strict;
use warnings;
use Carp qw( croak );
use Config::Simple;
use English;
use File::Basename;
use FindBin;
use IO::File;
use Proc::Daemon;
use POSIX qw( WIFEXITED strftime );
use Sys::Hostname;

use lib '$FindBin::Bin/../lib';
use Log::LTSV;

my @extlist = ('.pl','.pm','.cgi');
my $SCRIPT = basename ($0, @extlist);
my $PID_FILE = $FindBin::Bin."/$SCRIPT.pid";

my $config          = Config::Simple->new( "$FindBin::Bin/../config/$SCRIPT.config" );
my $cfg             = $config->vars();
my $logpath         = $cfg->{'config.log_dir'};
my $input_dir       = $cfg->{'config.input_dir'};
my $sleep_interval  = $cfg->{'config.sleep_interval'};
my $log             = Log::LTSV->new( 'logpath' => $logpath );

main(@ARGV);
exit(0);

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

    # start daemon
    if ($act eq "start"){
        # Does not run as multiple processing
        my (undef, $pid, $run_host) = get_pid_file();
        if( defined $pid ){
            if( $run_host eq hostname()) {
                print "$0 is already running\n";
                $log->info( "$0 is already running." );
                return;
            }
            else {
                print "$0 is running on other host. Running on $run_host\n";
                $log->warning( "$0 is running on other host. Running on $run_host." );
                return;
            }
        }

        print "Daemoning...\n";
        $log->info( "Daemoning..." );
        init();
        run();
        return;
    }

    # stop daemon
    if ($act eq "stop"){
        my (undef, $pid, $run_host) = get_pid_file();
        if($run_host ne hostname()) {
            print "$0 is not running on this host. Running on $run_host\n";
            $log->warning( "$0 is not running on this host. Running on $run_host." );
            return;
        }
        if(not defined $pid){
            print "$0 is not running\n";
            $log->warning( "$0 is not running." );
            return;
        }
        print "Stopping $0...\n";
        $log->info( ">>>>> Stopped" );
        # if deleted a pid file, killing process after...
        return del_pid_file();
    }

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

sub init {
    Proc::Daemon::Init;

    # Method for send signal's
    local $SIG{INT}  = 'interrupt';
    local $SIG{HUP}  = 'interrupt';
    local $SIG{QUIT} = 'interrupt';
    local $SIG{KILL} = 'interrupt';
    local $SIG{TERM} = 'interrupt';

    set_pid_file($PID);
    return;
}

sub run {
    $log->info( ">>>>> Started" );
    while(1) {
        # action();
        print "RUN!\n";
        $log->info( "sleep $sleep_interval" );
        sleep($sleep_interval);

        # If deleted a pid file, kill oneself.
        if (not  get_pid_file() ){
            kill $PID;
            return;
        }
    }
    return;
}

sub interrupt {
    my ($sig) = @_;
    local $SIG{$sig} = 'IGNORE';
    return del_pid_file();
}

sub get_pid_file {
    return if not -e $PID_FILE;

    my $fh = IO::File->new($PID_FILE, '<')
        or croak $log->warning( "Can't open '$PID_FILE': $OS_ERROR" );
    my ($line) = <$fh>;
    $fh->close or croak $log->warning( "Can't close '$PID_FILE': $OS_ERROR" );

    my ($pid, $hostname) = $line =~ /(\d+):(\w+)/ox;
    return ($PID_FILE, $pid, $hostname);
}

sub set_pid_file {
    my ($process_id) = @_;
    my $hostname = hostname();
    my $fh = IO::File->new($PID_FILE, '>')
        or croak $log->warning( "Can't open '$PID_FILE': $OS_ERROR" );
    print $fh "$process_id:$hostname";
    $fh->close or croak $log->warning( "Can't close '$PID_FILE': $OS_ERROR" );
    return;
}

sub del_pid_file {
    unlink $PID_FILE or croak $log->warning( "can't unlink $PID_FILE : $OS_ERROR" );
    return;
}

sub exec_cmd {
    my $file = shift;
    my $nowdatetime = strftime "%Y%m%d%H%M%S", localtime;
    my $cmd = $cfg->{'config.command'};

    rename "$file", "${file}${nowdatetime}";
    $file .= $nowdatetime;

    $cmd .= ' ' . $file;
    WIFEXITED(system $cmd)
        or croak $log->warning( "Couldn't run: $cmd ($OS_ERROR)" );

    return 1;
}

sub action {
    my @files = glob( "$input_dir/*.*" );

    foreach my $file (@files){
        my $before_filesize = (stat( $file ))[7];
        sleep 1;
        my $after_filesize = (stat( $file ))[7];

        if( $before_filesize == $after_filesize ){
            if( $before_filesize != 0 ){
                $log->info( "Process start : $file" );
                exec_cmd( $file );
            }
            else {
                $log->info( "This file have no data : $file" );
                unlink ( $file );
            }
        }
        else {
            $log->info( "Some files are processing : $file" );
        }
    }
    return 1;
}
#EOF

ConfigはConfig::Simpleを使っているので

config

[config]
input_dir = 'some/directory'
log_dir = 'some/directory/logs'
command = 'some/directory/command.pl'
sleep_interval = 10

みたいに書けばOK。

また、こいつはコピーで配置せずともシンボリックリンクで別のプログラムとして動作可能にしてあるので

filewatchd.pl > WatchSomeDir.pl

ってリンクを張って、そのリンク名でconfigファイルを作ればいかようにでも処理できるようにしてある。
（上の例の場合はWatchSomeDir.config）
自分で作っておきながら非常に便利な代物である。
あ、Log::LTSVはどこか固定のlibパスに置いておくと吉。