Perl用こぴーあんどぺーすとライブラリ

これは私(小菅)がPerlでプログラムを書くときに良く使う口癖のようなものです。^^; 「ライブラリを作らなくても"Copy & Paste"で貼り付けちゃえば いいかぁ」と言うのがこのページのコンセプトです。
中には使い方の誤ったものもあると思います。以下を真似していただいても 良いですが、その事によりトラブルが発生しても一切、責任は負いません。^^; また、「こんな使い方は間違いだぁー」と間違いを発見した方は是非ご連絡下さい。

Takashi Kosuge <takashi.kosuge@kek.jp>

Yes/Noの入力を求めて結果を返す

$rt = yesno("Ok?");   #Default is no.
$rt = yesno("Ok?",1); #Default is yes.

sub yesno{
    my $comment = shift;
    my $default = shift;
    if($default){
        $comment .= " ([y]/n)> ";
    }else{
        $comment .= " (y/[n])> ";
        $default = 0;
    }
    my $prv = $|;
    $| = 1;
    print $comment;
    $| = $prv;
    my $ans = <STDIN>;
    chomp($ans);
    $ans = uc($ans);
    if($ans eq 'Y'){
        return(1);
    }elsif($ans eq 'N'){
        return(0);
    }
    return($default);
}

オプション入力

use Getopt::Long;

# Options ---------------------------------------------------
GetOptions(
'd'      => \$::Debug,
'file=s' => \$::Filename,
'n=i'    => \$::Number,
'h'      => \&usage,
) or die "Bad switch.\n";

# Print usage. ---------------------------------------------
sub usage{
print <<__USAGE__;
$0 $::Version
Usage: $0 [-h] [-d] [-file FileName]
       -h   Show this help.
       -d   Run with debug mode.
       -file FileName   Set file name.
       -i   Number.
__USAGE__
exit(0);
}

TCP/IP Socket のオープン(クライアント)

use IO::Socket;

my $host='.jp';
my $port=0;

my $server =
new IO::Socket::INET(PeerAddr=>$host, PeerPort=>$port, Proto=>'tcp')
||die "Socket: $@\n";

Socketで相手のホスト名を得る関数 (分からなかったらIPアドレスを返す)

#-- Get Hostname -----------------------------------------------
sub ksg_gethost{
my $s = shift(@_);
my $host = gethostbyaddr($s->peeraddr(), AF_INET);
unless($host){$host = $s->peerhost();}
return($host);
}

Symbolとgensym()を使ってファイルを開く

use Symbol;

my $fh = gensym(); open($fh,"filename");

"yyyy-mm-dd hh:mm:ss" 形式で日付(local time)を返す関数

#-- Get "yyyy-mm-dd hh:mm:ss" style date -------------------------
sub ksg_localtime{
my $tm = shift(@_);
if($tm eq ''){$tm=time();}
my @tt = localtime($tm);
return(sprintf("%04d-%02d-%02d %02d:%02d:%02d",
$tt[5]+1900,$tt[4]+1,$tt[3],$tt[2],$tt[1],$tt[0]));
}

"yyyy-mm-dd hh:mm:ss" 形式から(timelocal)を返す関数

#hh:mm:ss 又は :ss の部分は省略できる。なお、以下のようにTime::Localが必要。

use Time::Local;

#-- Get seconds from 1970-01-01 00:00:00 (GMT) -------------------
sub ksg_timelocal{
my $bf=shift(@_);
my($sec,$min,$hours,$mday,$mon,$year);
if($bf=~/^(\d\d\d\d)[\-\/](\d+)[\-\/](\d+)$/){
$sec = 0; $min = 0; $hours = 0;
}elsif($bf=~/^(\d\d\d\d)[\-\/](\d+)[\-\/](\d+)\s+(\d+):(\d+)$/){
$sec = 0; $min = $5; $hours = $4;
}elsif($bf=~/^(\d\d\d\d)[\-\/](\d+)[\-\/](\d+)\s+(\d+):(\d+):(\d+)$/){
$sec = $6; $min = $5; $hours = $4;
}else{(return(-1));}
$mday = $3; $mon = $2-1; $year = $1-1900;
return(timelocal($sec,$min,$hours,$mday,$mon,$year));
}

プロセスなどを排他ロックするためのサブルーチン

#LOCKIDには識別の為の名前を設定、LOCKDIRはロックファイルを作るディレクトリ。 ロックできれば1をできなければnull文字を返す。$::Errorにエラー内容が セットされる。

use constant LOCKID => 'webup';
use constant LOCKDIR => '/tmp/';

##Sub for lock precess##
##Lock##
sub lock_proc{
my $prelock= LOCKDIR.LOCKID."$$.tmp";
my $lock = LOCKDIR.LOCKID.".lock";
if(-e $prelock){
$::Error = 'ID "'.LOCKID
.$$.'" is being locked by other process.';
return('');
}
unless(open(BUFFFORPROCESSLOCK,">$prelock")){
$::Error ='Could not open prelock file.';
return('');
}
print BUFFFORPROCESSLOCK "$$\n";
close(BUFFFORPROCESSLOCK);
unless(-e $lock){
rename($prelock,$lock);
return(1);
}
unlink($prelock);
$::Error = 'ID "'.LOCKID.'" is being locked by other process.';
return('');
}

##unlock##
sub unlock_proc{
my $lock = LOCKDIR.LOCKID.".lock";
my $buff ='';
unless(-e $lock){
$::Error='Lock file is not found.';
return('');
}
open(BUFFFORPROCESSLOCK,"$lock");
$buff=<BUFFFORPROCESSLOCK>;
chop($buff);$buff=~s/\r//;
close(BUFFFORPROCESSLOCK);
if($buff != $$){
$::Error = 'ID "'.LOCKID.'" is being locked by other process.';
return('');
}
unlink($lock);
return(1);
}