PERL の変更点
- 追加された行はこの色です。
- 削除された行はこの色です。
- PERL へ行く。
#author("2021-06-04T04:05:19+00:00","default:pentacle","pentacle")
* 基本で忘れやすい構文 [#gd707192]
** init hash [#cb31df2e]
%hash = ("key"=>"value");
※ HASH でも () を使う。{}とかに間違えやすいので注意
** ヒアドキュメント [#w67d211b]
$html =<< "_HTML_";
<html>
<body>
hello
</body>
</html>
_HTML_
** switch case [#qe33e8fd]
#pre{{
use Switch;
switch ($val) {
case /abc/ { print "1\n"; }
case /def/ { print "2\n"; }
case /ghi/ { print "3\n"; }
else { print "0\n"; }
}
}}
** date [#ka49e726]
($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 [#r1308c38]
($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
** ファイルテスト演算子 [#a39f08c1]
-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起動時における、ファイルの作成時刻からの日数
*** 配列の要素数 [#fbaa3e0b]
$#hoge;
* CGI関連 [#xce37560]
** CGI.pm [#jca91239]
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 [#zf6ca690]
#include(urlencode);
* File Path 関連 [#s6b146b3]
** basename [#f2667c1c]
ファイルのパスを分解して、ファイル名だけとか、ディレクトリとかを得る
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 (フルパスを得る) [#k1f75291]
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;
}
* エクセルリーダ [#zf5a20bd]
#!/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 [#sca7840c]
package を使うとその前で宣言された変数はキャンセルされてしまう・・
*** jpeg titler [#h79903ef]
&attachref(jpegread.pl);
* suidperl [#mde39551]
*** 汚染回避 [#p475e940]
$val = ~m/(.*)/;
$val = $1;
※本当はちゃんとチェックしなくてはいけない。
* UDP socket client [#y7d20ba2]
#!/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 [#y00b0f48]
#!/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 [#k8cc1e32]
#pre{{
#!/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[#sf45c526]
#!/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 [#vb0e6e02]
- perl 表技集
http://www2u.biglobe.ne.jp/~MAS/perl/waza/menu.html
* code [#m510c7f8]
*** file handler [#me68ae7d]
#pre{{
#!/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 [#na5c497c]
#pre{{
#!/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);
}
}}