SEARCH

Linux Install

Android

Linux Tools

Linux AV

Linux Memo

WINDOWS

PROGRAM

動画 Memo

音楽 Memo

モバイルアプリ Memo

FILE FORMAT

PROTOCOL

DEVICE

BookMark

その他


PERL   

基本で忘れやすい構文

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

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

filejpegread.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

  • perl 表技集
    http://www2u.biglobe.ne.jp/~MAS/perl/waza/menu.html

code

#!/bin/perl
while(<>){
    $line=$_;
    $line=~s/[\r\n]+//g;
}
sub command{
    my ($com) = shift;
    print ">  $com\n";
    $result = `$com`;
    return $result;
}