基本で忘れやすい構文†
init hash†
%hash = ("key"=>"value");
※ HASH でも () を使う。{}とかに間違えやすいので注意
ヒアドキュメント†
$html =<< "_HTML_";
<html>
<body>
hello
</body>
</html>
_HTML_
switch case†
use Switch;
switch ($val) {
case /abc/ { print "1\n"; }
case /def/ { print "2\n"; }
case /ghi/ { print "3\n"; }
else { print "0\n"; }
}
date†
($sec,$min,$hour,$mday,$month,$year,$wday,$stime) = localtime(time());
printf("%04d/%02d/%02d %02d:%02d:%02d\n",$year+1900,$month+1,$mday,$hour,$min,$sec);
stat†
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks) = stat($file);
[0] DEV
[1] ino
[2] mode
[3] nlink
[4] uid
[5] gid
[6] rdev
[7] size
[8] atime
[9] mtime
[10] ctime
[11] blksize
[12] blocks
ファイルテスト演算子†
-r 読み込み可能
-w 書き込み可能
-x 実行可能で
-o 実行者とファイルの所有者が同一
-R 実uid/gidで読み込み可能
-W 実uid/gidで書き込み可能
-X 実uid/gidで実行可能
-O 実uidとファイルの所有者が同一
-e ファイルが存在する
-z ファイルサイズが 0
-s ファイルサイズが 0 以外(大きさを返す)
-f ファイルは通常ファイル
-d ファイルはディレクトリ
-l ファイルはシンボリックリンク
-p ファイルは名前付きパイプ
-S ファイルはソケット
-b ファイルはブロック型の特殊ファイル
-c ファイルはキャラクタ型の特殊ファイル
-t ファイルハンドルが tty としてオープンされている
-u ファイルの setuid ビットがセットされている
-g ファイルの setgif ビットがセットされている
-k ファイルの sticky ビットがセットされている
-T ファイルがテキストファイル
-B ファイルがバイナリファイル
-M perl起動時における、ファイルの更新時刻からの日数
-A perl起動時における、ファイルの参照時刻からの日数
-C perl起動時における、ファイルの作成時刻からの日数
配列の要素数†
$#hoge;
CGI関連†
CGI.pm†
use CGI;
$cgi = CGI->new;
foreach $key ($cgi->param()){$param{$key} = $cgi->param($key);}
foreach $line (@ARGV){@pair = split(/=/,$arg);if ($pair[1]){$param{$pair[0]} = $pair[1];}}
print $cgi->header(-charset=>'euc-jp');
urlencode†
sub urlencode{
my $URLencode=shift;
$URLencode=~s/([^0-9A-Za-z_ \.\/:])/'%'.unpack('H2',$1)/ge;
$URLencode=~s/\s/%20/g;
return \$URLencode;
}
File Path 関連†
basename†
ファイルのパスを分解して、ファイル名だけとか、ディレクトリとかを得る
use File::Basename;
($name,$path,$suffix) = fileparse($fullname,@suffixlist)
fileparse_set_fstype($os_string);
$basename = basename($fullname,@suffixlist);
$dirname = dirname($fullname);
※ こうなる
$a = dirname("/aaa/bbb/ccc/");
$a : /aaa/bbb/;
$a = basename("/aaa/bbb/ccc/");
$a : ccc
($name,$path,$suffix) = fileparse("lib/File/Basename.pm",".pm");
fileparse_set_fstype("VMS");
$basename = basename("lib/File/Basename.pm",".pm");
$dirname = dirname("lib/File/Basename.pm");
参考:http://www.att.or.jp/perl/man/basename.3pm.html
canonical name (フルパスを得る)†
use FindBin;
my $script_dir = $FindBin::Bin;
sub canonical{
my $filename = shift;
if (($filename !~ m|^/|) && ($filename !~ m|^.:|)){
$cwd = `/bin/pwd`;
$cwd =~ s/[\r\n]//g;
if ($cwd =~ m|^/home|){
$cwd = "c:/cygwin$cwd";
}
$filename = "$cwd/$filename";
}
my @components = ();
foreach $component (split('/',$filename)){
if ($component eq "" ){ next; }
if ($component eq "." ){ next; }
if ($component eq ".." ){
pop (@components);
next;
}
push(@components,$component);
}
$filename = "/".join('/',@components);
# ドライブレターの場合は / を削除
if ($filename =~ m|^/.:|){
$filename =~ s|^/||;
}
# ネットワークファイルの場合は / を追記
if ($filename =~ m|^/\d+\.\d+\.\d+\.\d+/|){
$filename = "/$filename";
}
return $filename;
}
エクセルリーダ†
#!/usr/bin/perl
print "Content-type: text/html;\r\n\r\n";
use Spreadsheet::ParseExcel;
use Spreadsheet::ParseExcel::FmtJapan2;
$xls_url = "http://hoge.com/hogehoge.xls";
`wget -q -Y off \"$xls_url\" -O /tmp/tmp.xls`;
my $oExcel = new Spreadsheet::ParseExcel;
my $oFmtJ = Spreadsheet::ParseExcel::FmtJapan2->new(Code => 'euc');
my $oBook = $oExcel->Parse('/tmp/tmp.xls', $oFmtJ);
system("rm /tmp/tmp.xls");
if(defined $oBook) {
for(my $iSheet=0; $iSheet < $oBook->{SheetCount} -1; $iSheet++) {
$oWkS = $oBook->{Worksheet}[$iSheet];
for(my $iR = $oWkS->{MinRow} ;
defined $oWkS->{MaxRow} && $iR <= $oWkS->{MaxRow} ; $iR++) {
for(my $iC = $oWkS->{MinCol} ;
defined $oWkS->{MaxCol} && $iC <= $oWkS->{MaxCol} ; $iC++) {
$oWkC = $oWkS->{Cells}[$iR][$iC];
print "( $iR , $iC ) =>", $oWkC->Value, "\n" if($oWkC);
}
}
}
}
package†
package を使うとその前で宣言された変数はキャンセルされてしまう・・
jpeg titler†
jpegread.pl
suidperl†
汚染回避†
$val = ~m/(.*)/;
$val = $1;
※本当はちゃんとチェックしなくてはいけない。
UDP socket client†
#!/usr/bin/perl
use Socket;
socket(SOCKET, PF_INET , SOCK_DGRAM , 0);
$add .= chr(192);
$add .= chr(168);
$add .= chr(11);
$add .= chr(255);
$sock_addr = pack_sockaddr_in(4000,$add);
send(SOCKET , "hello" ,0,$sock_addr);
UDP socket server†
#!/usr/bin/perl
use Socket;
socket(SOCKET, PF_INET, SOCK_DGRAM, 0);
bind(SOCKET, pack_sockaddr_in(4000, INADDR_ANY));
while (1){
recv(SOCKET, $buf, 10000, 0);
printf "$buf\n";
}
TCP Socket Client†
#!/usr/bin/perl
use Socket;
use FileHandle;
$ip = '192.168.0.100';
$port = 80;
$ip = inet_aton($ip) || die "inet_aton";
$sockaddr = pack_sockaddr_in($port , $ip);
socket(SOCKET, PF_INET, SOCK_STREAM, 0) || die "socket error.\n";
connect(SOCKET, $sockaddr) || die "connect $con_host $con_port error.\n";
autoflush SOCKET (1);
print SOCKET "file://test.ts\n\n";
while (chomp($buf=<SOCKET>)) {
print "$buf\n";
}
close(SOCKET);
TCP socket server†
#!/usr/bin/perl
use Socket;
$port = 4321;
socket( CLIENT_WAITING, PF_INET , SOCK_STREAM , 0);
setsockopt(CLIENT_WAITING , SOL_SOCKET ,SO_REUSEADDR, 1);
bind (CLIENT_WAITING, pack_sockaddr_in($port,INADDR_ANY));
listen(CLIENT_WAITING , SOMAXCONN);
print "$port を見張ります\n";
while(1){
$paddr = accept(CLIENT, CLIENT_WAITING);
($client_port , $client_iaddr) = unpack_sockaddr_in($paddr);
$client_ip = inet_ntoa($client_iaddr);
print "$client_hostname ($client_ip) $client_port \n";
select(CLIENT);
$|=1;
select(STDOUT);
while(<CLIENT>){
print "$_";
print CLIENT $_;
}
close(CLIENT);
print "end\n";
}
BOOK MARK†
code†
file handler†
#!/bin/perl
@fhs = ();
for ($i=0;$i<16;$i++){
$file = sprintf("file_%x",$i);
open(${$file},">> $file");
push(@fhs, ${$file});
}
for ($i=0;$i<16;$i++){
printf ${$fhs[$i]}("%x\n",$i);
}
for ($i=0;$i<16;$i++){
close( ${$fhs[$i]} );
}
snipet†
#!/bin/perl
use Time::Local;
while(<>){
$line=$_;
$line=~s/[\r\n]+//g;
}
1;
sub command{
my ($com) = shift;
print "> $com\n";
$result = `$com`;
return $result;
}
sub date2unix{
my $line=shift;
$line=~s/[\/\-:\s ]//g;
$line=~m/(\d{4})(\d{2})(\d{2})(\d{0,2})(\d{0,2})(\d{0,2})/;
my ($yy,$mm,$dd,$hh,$mi,$ss) = ($1,$2,$3,$4,$5,$6);
$mm --;
return timelocal($ss,$mi,$hh,$dd,$mm,$yy-1900);
}
sub unix2date{
my $epoc=shift;
my $format=shift;
unless ($format){$format = "%04d-%02d-%02d %02d:%02d:%02d"};
my ($sec,$min,$hour,$mday,$month,$year,$wday,$stime) = localtime($epoc);
$year += 1900;
$month ++;
return sprintf($format,$year,$month,$mday,$hour,$min,$sec);
}