Perl reference 筆記

兩種建立 reference 方法

1. 利用 \

$aref = \@array;
$href = \%hash;
$sref = \$scalar;

2. 用 [ item ] 產生匿名陣列或 { item }產生匿名 hash

$aref = [ 1, "string", udef, 13 ];
$href = { Arp => 4, Aug => 8 };
$emptyaref = [ ];  #產生空的陣列參考
$emptyhref = { };  #產生空的 hash 參考

如何使用 reference

@a  等同 @{$aref}
$a[3] 等同  ${$aref}[3]    等同  $aref->[3]
%b  等同  %{$href}
$b{'key'}  等同  ${$href}{'key'}   等同   $href->{'key'}

槽狀陣列
@a = ( [1, 2, 3], [4, 5, 6], [7, 8, 9] );
print $a[1]->[2];  結果為 6
print $a[0]->[1];  結果為 2
其實就是 $a[ROW]->[Column];
※ $a[ROW]->[COLUMN] 又能簡寫為 $a[ROW][COLUMN]

擋掉某個國家的網段 -以中國為例

程式原理：

透過 twnic 網站所提供的國家網段資訊下來分析
並換算遮罩，最後用 iptables 阻擋

code:

#!/usr/bin/perl -w

use strict;
use LWP::Simple;

my $url = "http://trace.twnic.net.tw/ipstats/ipv4net.php?ipv4_cc=CN&ipv4_country=CHINA&ccountry=%A4%A4%B0%EA%A4j%B3%B0";
my $file = "/tmp/chinaIp.html";
my $status = getstore($url, $file);
die "error $status on $url" unless is_success($status);


my $counter = 0;
my @IPlists;

open(FH,"< /tmp/chinaIp.html") or die "can't open file: $!";
while() {
  # 去除不是  next if $_ !~ /^
  #過濾HTML標籤
  s/\<[^\<]+\>//g;

  #利用$counter計算並取出第2,3行的資料並存到陣列
  $counter++;
  if( ($counter == 2) or ($counter == 3) ) {
    push(@IPlists, $_);
  } elsif( $counter == 5) {
    $counter = 0;
  }
}
close(FH);

my $i;
for($i=0; $i<$#IPlists; $i+=2){
 chomp($IPlists[$i]);
 system("/sbin/iptables -A INPUT -p tcp -s " . $IPlists[$i] . '/' . &ConvertMask($IPlists[$i+1]) . " --dport 80 -j DROP");
}

#轉換成遮罩
sub ConvertMask {
  my $input = shift;
  chomp($input);
  return 32 - (log($input) / log(2));
}

Perl bookmarkers

Perl & LWP :
http://lwp.interglacial.com/index.html

Perl PAR :
http://par.perl.org/wiki/Main_Page

Perl In a NUTShell :
http://docstore.mik.ua/orelly/perl/perlnut/index.htm

Perl cookbook :
http://docstore.mik.ua/orelly/perl/cookbook/index.htm

Advanced Perl Programming :
http://docstore.mik.ua/orelly/perl/advprog/index.htm

Practical mod_perl:
http://modperlbook.org/

Mason:
http://www.masonbook.com/book/

log4perl:
CPAN log4perl
Retire your debugger, log smartly with Log::Log4perl

file lock:
File Locking on perlmonks

如何用Perl將date轉換成unixtime

用Class::Date模組

use Class::Date qw(date);
$unixtime = date("2010-10-25 12:11:53")->epoch;

PAR打包Encode模組時出現找不到編碼問題

我會用Encode模組進行字型編碼轉換，程式碼如下
#!/usr/bin/perl
use Encode;
$instring = "測試";
$outstring = encode('utf8',decode('big5', $instring));
print $outstring;


在沒有用PAR打包時，直接用perl執行程式是沒問題的，一旦打包後卻會出現編碼問題
shell>% pp -o output input.pl
shell>%./output
Unknown encoding 'big5' at script/csv2ldif.pl line 180

解決辦法就是將程式碼改寫一下，加上use Encode::TW就可以解決了。若你不是要用big5編碼，可參閱Encode模組手冊，對照一下就知道要使用哪個編碼。

perlmodinstall 筆記

Q:如何查模組是否已經安裝於系統
A:perl -MFOO::BAR -e 1

Q:如何查詢perl library path
A:perl -e "print qq(@INC)"

Q:如何安裝模組-unix or unix-like
A: 先閱讀模組內的README或INSTALL文件，下面的流程並不是所有模組都通用
1.tar xzvf yourmodule.tar.gz
2.perl Makefile.PL PREFIX=/my/perl_directory
3.make test
4.make install

Perl Module PAR::Packer 筆記 perl convert to exe

要把perl打包成可執行檔有三種方法：
PAR::Packer, perl2exe, ActiveState的Perl Dev kit
但perl2exe與Perl Dev Kit屬商業軟體，有使用限制(試用版也有時間的限制)，所以我選擇使用PAR來打包成執行檔，當然商業軟體有他的優點，若有需要還是請到閱讀官網所提供的資訊。


於Windows環境安裝PAR::Packer

windows環境的大多都是用ActiveState的ActivePerl，這裡有一份PAR PPM的相容列表，請先查閱你所安裝的ActivePerl是否相容。

由於ActiveStat的repository並沒有提供PAR::Packer，所以要另外安裝bribes這個repository。

請開啟一個「命令提示字元」並執行
ppm repo add http://www.bribes.org/perl/ppm bribes



安裝PAR::Packer
ppm install PAR-Packer

再來把我寫好的perl script打包成可獨立執行的程式。使用的方法很簡單，執行如下指令
pp -o find.exe find.pl



當然PAR::Packer的功能當然沒這麼少，詳細的功能請參閱CPAN上的文件

用 perl 列出指定目錄下的檔案及目錄

update on 2012/1/14

方法一：
Find::Find 是 perl 內含的模組，他可以列出指定目錄下的檔案及目錄

#!/usr/bin/perl -w

use strict;
use File::Find;

find( \&wanted, "/etc");
sub wanted() {
    #列出目錄
  print $File::Find::dir . "\n";

    #列出檔案
    print $_ . "\n";

    #列出檔案的絕對路徑
    print $File::Find::name . "\n";
}


利用匿名 hash 設定 File::Find 的參數
這邊特別提到 no_chdir 參數，讓 File::Find 不要切換工作目錄，如此 $_ 的內容等同 於$File::Find::name

#!/usr/bin/perl -w

use File::Find;
use strict;

#啟用 no_chdir 參數，各位可以比對一下確實與 $File::Find::name 內容相同
find( { wanted => \&wanted, no_chdir => 1}, "/etc" );
sub wanted() {
    print $_ . "\n";
}

#利用匿名函式將找到的目錄存到陣列
#!/usr/bin/perl -w

use strict;
use File::Find;

my @FileList;
find( { wanted => sub { push(@FileList, $_) }, no_chdir => 1 }, "/etc" );



方法二：
File::Next是另一個遊走整個目錄樹以取得檔案或目錄列表的模組，可惜這個模組需要另外安裝，使用上比較不方便
http://search.cpan.org/dist/File-Next-1.02/Next.pm

#取得檔案列表
#!/usr/bin/perl -w

use strict;
use File::Next;

my $iter = File::Next::files( '/tmp' );

while ( defined ( my $file = $iter->() ) ) {
       print $file, "\n";
}

執行後得到
/tmp/file1
/tmp/file2
/tmp/a/file1
..

※若要取得目錄只要將File::Next::files改為File::Next::dirs
※若要取得所有的檔案、目錄 or whatever 就改為File::Next::everything

#搜尋檔案(同linux下的find指令)
#紅字部份為過濾條件，也就是你想找的檔案名稱。下面的程式會找出gd.txt的路徑
my $iter = File::Next::files( {file_filter => sub { /gd\.txt$/ } }, 'D:\\' );
while ( defined ( my $files = $iter->() ) ) {
print $files, "\n";
}

perl module Getopt::Long 筆記

Switch模式

GetOptions ( 'verbose' => \$verbose );
設定 --verbose 參數, 當給予--verbose參數時, 會設定參數 $verbose 且值為1

GetOptions ( 'verbose!' => \$verbose );
設定 --verbose -> $verbose = 1, --noverbose -> $verbose = 0

GetOptions ( 'count+' => \$count );
設定 --count -> $count值為參數使用的次數
example:
test.pl --count --count -> 此時得 $count = 2

帶值參數
※參數類型：整數, 浮點數, 字串

GetOptions( 'tag=s' => \$tag );
'='表示此參數一定要有參數值, 若改用':'代替表示參數不一定要有參數值
's'表示傳遞字串參數, 若為'i'表傳遞整數參數, 若為'f'表傳遞浮點數
example:
test.pl --tag=string
or
test.pl --tag string

多參數值的參數
GetOptions ("library=s" => \@libfiles);
參數傳到 @tag
or
GetOptions ("library=s@" => \$libfiles);
參數傳到 @$tag
example:
test.pl --library lib/stdlib --library lib/extlib

hash參數值(有名稱及參數值)
GetOptions ("define=s" => \%defines);
or
GetOptions ("define=s%" => \$defines);
example:
test.pl --define os=linux --define vendor=redhat

參數別名
GetOptions ('length|height=f' => \$length);
第一個名稱為primary name, 其他的名稱為alias(可有多個alias名稱)
當使用hash參數時, 使用primary name作為key值

參數的簡稱及大小寫
GetOptions ('length|height=f' => \$length, "head" => \$head);
若沒有特別設定, Getopt會忽略參數的大小寫, 也就是 -l or -L 指的都
是同一個參數(--length)

perl 自然對數函式筆記

題目：若2的N次方等於65536，求N為

shell> perl -e 'print log(65536)/log(2) . "\n";'

註：log(2)為母數。若要改求10的N次方時，就要改成log(100)/log(10)

openwebmail ldap 公用通訊錄更新程式

這是我用Perl寫的LDAP公用通訊錄更新程式，功能為抓取LDAP的cn及mail屬性後製成OpenWebMail的通訊錄，若有需要的人請 點我 下載。(我使用的Openwebmail為2.51版)

Perl模組需求：

請確定你的主機有Net::LDAP模組，若沒有的話可以透過CPAN安裝，確認方式如下。
Shell>perl -e '"use Net::LDAP;"'
#若出現以下訊息表示您的主機找不到或沒有安裝Net::LDAP模組
Can't locate Net/LDAP.pm in @INC (@INC contains: /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi /usr/lib/perl5/site_perl/5.8.7/i386-linux-thread-multi /usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi /usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi /usr/lib/perl5/site_perl/5.8.8
__略__

若沒有模組的可以透過CPAN安裝
Shell> cpan
#進入CPAN提示符號後
cpan> install Net::LDAP
~~請耐心等待編譯過程 ~~
cpan> exit

使用方式：

參數設定
請先用編輯器開啟程式，修改必要的參數(程式裡我都有加上註解)
#ldap主機位置
my $ldapHost = "ldap.example.com";
#ldap的連接埠，預設為389
my $ldapPort = "389";
#ldap 通訊協定版本，預設為3
my $ldapVersion = "3";
#bind DN，登入ldap認證用的帳號
my $bindDN = "uid=checkme,ou=people,ou=example,o=com";
#bind DN 密碼
my $bindDNPassWord = "checkcheck";
#搜尋的起始點
my $searchBase = "ou=people,ou=example,o=com";
#過濾條件
my $filter = "(objectClass=posixAccount)";
#搜尋路徑設定，預設為sub，表示會搜尋searchBase下所有項目
my $scope = "sub";
#OpwnWebMail公用通訊錄檔案位置
my $globalAddressBook = "/var/www/html/cgi-bin/openwebmail/etc/addressbooks/global";
#於螢幕顯示ldap撈出的資料，1 -> on , 0 -> off
my $debug = 0;

程式動作流程
connect ldap -> bind -> search ldap(cn&mail屬性) ->計算資料數-> 刪除舊的通訊錄 -> 建立通訊錄

執行方式
Shell> perl OWM-GAdrBook-LDAP.pl

設定crontab
Shell> vi /etc/crontab
新增
0 0 * * * root /path/to/OWM-GAdrBook-LDAP.pl > /dev/null 2>&1


點選通訊錄後的畫面

第一次用perl做整個目錄樹的搜尋及修改檔案內容

由於客戶的程式碼某一行少了一個斷行(\n)導致網頁無法正常觀看
，只知道整個網站5萬多支程式裡有問題的檔名為play.html及test.html
，在無法預知有多少支檔案有相同問題狀況下，我決定試著自己寫
程式處理。回想起來我算膽子滿大的，我並不是程式人員，自己學
習寫程式也不過皮毛而已，我只知道要給自己機會練習才能進步，
所以這隻程式包含測試老實說也花了我大約5個鐘頭，以下我就大略
記錄一下當時的想法。

問題需求：
將 D:\htdocs\upload下所有名稱為test.html及play.html的檔案，內
容含有language=JScript.Encode>等字串改為 language=JScript.Encode>\n

處理想法：
1.利用Perl進行目錄樹掃描，遇到檔名為play.html及test.html則進行
讀檔，當有符合時就進行代換的動作。
2.在進行代換前必須備份，且要按照目錄樹來備，若執行有問題就可
以連同目錄蓋回去
3.簡單的log

程式碼：

#!c:\perl\bin\perl

use Cwd;
use strict;

#備份檔存放目錄
my $backupBaseDir = 'c:\backupBase';
#要進行內容檢查的檔案名稱
my @targetFiles = qw/test.html play.html/;

#主程式
scanDirectory('D:\htdocs\upload');


#----------------------------------------------------------------
# 搜尋目錄樹,若找到目錄就遞回呼叫,找到檔案就進行備份及取代
#----------------------------------------------------------------
sub scanDirectory() {
my $workDir = shift;
my $startDir = &cwd;
my @names;

&logme("cd to $workDir");
chdir($workDir)
or die "Unable to enter dir $workDir: $!\n";
opendir(DIR, ".")
or die "Unable to open $workDir: $!\n";
@names = readdir(DIR)
or die "Unable to read $workDir:$!\n";
closedir(DIR);

foreach my $name (@names) {
next if ($name eq '.');
next if ($name eq '..');

if (-d $name) {
&scanDirectory($name);
next;
}

foreach my $target (@targetFiles) {
if ("$name" eq "$target") {
&logme("fix file $name");
&do_backup($name);
&do_replace($name);
}
}
}

chdir($startDir)
or die "Unable to change dir to $startDir:$!\n";
&logme("exit dir to $startDir");
}

#-------------------------------------------------------------
# 備份目錄樹及要更動的檔案
#-------------------------------------------------------------
sub do_backup() {
my $workDir = &cwd();
my $name = shift;
my $backupdir;
my $cmd;

#把&cwd取得的/改成\
$workDir =~ s#/#\\#g;

#重組目錄,加上$backupBaseDir
#eg. c:\321 => $backupBaseDir\321
$workDir =~ /:/;
$backupdir = "$backupBaseDir$'";

#檢查$backupdir是否存在,沒有的話就建立
if (!-d $backupdir) {
$cmd = "mkdir $backupdir";
&logme("mkdir by command $cmd");
system "$cmd";
}

#複製目標檔案至備份目錄
$cmd = "copy $workDir\\$name $backupdir";
print "$cmd\n";
&logme("backup target file by command $cmd");
system "$cmd";

}

#-------------------------------------------------------------
#進行正規表示代換，會建立一個新檔去覆蓋原本的檔案
#-------------------------------------------------------------
sub do_replace() {
my $name = shift;
my $newname = "new_" . $name;
my $cmd;

#開啟需要被更改的檔案
open(FILE, $name)
or die "Unable to open file $name: $!\n";

open(NEWFILE,">$newname")
or die "Unable to open file: $!\n";

&logme("replacing file $name");

while() {
#假如已經有斷行就直接寫到新的檔案
if ($_ =~ /language\s?=\s?\"?JScript.Encode\"?>\n/i) {
print NEWFILE;
} else {
#比對到的話就取代後寫到新檔
$_ =~ s/language\s?=\s?\"?JScript.Encode\"?>/ \
language=\"JScript.Encode\">\n/ig; #這行跟上面那行為同一行
print NEWFILE;
}
}

#關閉開啟的檔案
close(FILE);
close(NEWFILE);

#用新檔覆蓋舊檔
$cmd = "move /y $newname $name";
system("$cmd");
}

#-------------------------------------------------------------
# log函式
#-------------------------------------------------------------
sub logme() {
my $msg = $_[0];
my $logfile = 'c:\fixEncode.log';

open LOGME, ">> $logfile"
or die "Unable to open file $logfile: $!\n";
print LOGME "$msg\n";
close(LOGME);
}