社内のProjectで、前の会社に影響されないようなコードを書く必要性が出てきた。
今まで蓄積していたモジュール達はいろいろ厄介なことになっているので、これを機に書き換えてみようと思った第一弾がログ出力モジュール。

「書き換えるなら、もう何十週も遅れてるとは思うけども、LTSVで出したいよね～
じゃあLog::Log4perlやLog::Dispatchでいいじゃんよ！」

と思ってた時代が私にもありました・・・。
社内では業務が縦割りで、開発者にはrootやsudoが無いのでCPANのインストールがこけるこける（汗
じゃあつくっちまえよ！って出来たのが以下のLog::LTSV。

要件は

ログローテーション必須
LTSVで出したい
出力レベルはinfo・debug・warning・error・fatalで十二分
実行ホストが複数台あるのでhost/pidも出しちゃおう

とまぁ簡単な仕様。
ちょっとgetDateTimeとgetTimeが冗長というかコピペ臭がするけどご愛敬・・・(´・ω・｀)

Log::LTSV.pm

package Log::LTSV;
use strict;
use warnings;
use Fcntl ":flock";
use File::Basename;
use IO::File;
use POSIX 'strftime';
use Sys::Hostname;


sub new {
    my ( $class, %args ) = @_;
    my $self = bless{ %args }, $class;
    $self->{level} ||= 'INFO';
    return $self;
}

sub _write {
    my $self = shift @_;
    my $date = $self->_getDate();
    my $datetime = $self->_getDateTime();
    my @extlist = ('.pl','.pm');
    my $scriptname = basename ( $0, @extlist );
    my $logfile = $self->{logpath} . "/" . $scriptname . $date . ".log";
    my $log = IO::File->new(">>$logfile");
    flock($log, LOCK_EX);
    $log->printf ("time:[%s]\thost:%s\tpid:%d\tlevel:[%s]\tmsg:%s\n"
                    , $datetime
                    , hostname()
                    , $$
                    , $self->{level}
                    , $self->{msg});
    chmod 0664, $logfile;
    flock($log, LOCK_UN);
    $log->close;
    return $self;
}

sub _getDate {
    my $self = shift @_;
    my $date = strftime "%Y%m%d", localtime;
    return $date;
}

sub _getDateTime {
    my $self = shift @_;
    my $datetime = strftime "%F %T", localtime;
    return $datetime;
}

sub info {
    my $self = shift @_;
    $self->{msg} = shift;
    $self->{level} = 'INFO';
    $self->_write();
    return;
}

sub debug {
    my $self = shift @_;
    $self->{msg} = shift;
    $self->{level} = 'DEBUG';
    $self->_write();
    return;
}

sub warning {
    my $self = shift @_;
    $self->{msg} = shift;
    $self->{level} = 'WARN';
    $self->_write();
    return;
}

sub error {
    my $self = shift @_;
    $self->{msg} = shift;
    $self->{level} = 'ERROR';
    $self->_write();
    return;
}

sub fatal {
    my $self = shift @_;
    $self->{msg} = shift;
    $self->{level} = 'FATAL';
    $self->_write();
    return;
}

1;
# EOF

使用方法は書かなくてもわかるだろうけど・・・

app.pl

# !/usr/bin/perl
use strict;
use warnings;

use lib '/apps/lib';
use Log::LTSV;

my $log = Log::LTSV->new( 'logpath' => '/apps/logs' );

$log->info( "Information" );
$log->debug( "Debug Message" );
$log->warning( "Warning Message" );
$log->error( "Error Message" );
$log->fatal( "Fatal Message" );

すると指定したpathに

app20130605.log

なんてファイルが出来ます。
中身は

app20130605.log

time:[2013-06-05 23:00:00]<tab>host:tomoyo<tab>pid:4649<tab>level:INFO<tab>msg:Information
time:[2013-06-05 23:00:00]<tab>host:tomoyo<tab>pid:4649<tab>level:DEBUG<tab>msg:Debug Message
time:[2013-06-05 23:00:00]<tab>host:tomoyo<tab>pid:4649<tab>level:WARN<tab>msg:Warning Message
time:[2013-06-05 23:00:00]<tab>host:tomoyo<tab>pid:4649<tab>level:ERROR<tab>msg:Error Message
time:[2013-06-05 23:00:00]<tab>host:tomoyo<tab>pid:4649<tab>level:FATAL<tab>msg:Fatal Message

ってな感じ。
これからはLTSVっすなー！

一応、perlcriticの-3辺りまで通ってます。Unpackの所は好みもあるのでアレですが・・・