Perl

ここでは純粋にPerlでのプログラム例です。CGIの話は別のページで。

• Perlのインストール
• 古いバージョンのActivePerlが欲しい
• お勧めのエディタは？
• Perl上達のコツ
• 関数を抜け出しても値を保持するスタティックな変数を使いたい
• テキストファイルの最終行を更新したい
• 指定ファイルの行数を知る
• FTPクライアントを書く
• インストール
• サンプル
• 指定したディレクトリ以下の全てのファイルに対して処理を行いたい
• 文字列を「あかさたな・・・」で行分類したい
• 閏年（うるうどし）の処理
• 数値の桁揃え
• 単純なファイルバックアップ処理
• ODBC経由でデータベースに接続する
• ADOでデータベースに接続する
• 擬似ハッシュ
• 月末の日付を求める
• 文字列の前後のスペースを除去する

Perlのインストール

WindowsユーザならはAcrivePerlが便利でよろしいです。

• http://www.activestate.com/ より、ページ右下のDownLoadというところからリンクしています。
• メールアドレスや名前を入力して、Nextを押します。（入力しなくてもいけます。）
• ActivePerl 5.6.1 build 635、ActivePerl 5.8.0 build 806、の2種類があります(2003/06/05現在)。
• どちらでも好きな方をダウンロード。普通に使うならあまり大差はないですが、一般的なCGIなどの開発に利用するのであれば、ActivePerl 5.6.1 build 635を御奨めします。理由は5.8に対応しているWEBサーバが少ないためです。普通の処理をするのに大差はないので、もし必要になったら上のバージョンをインストールすればよいでしょう。私の場合、PerlでのCGI開発が仕事なので5.8実験したり、時には低いバージョン5.005 などを止む無くインストールしたりしています。（頻繁にインストール、アンインストールを繰り返しているのであった（涙））
• 各バージョンWindowsのMSIとASPackageがありますが、MSIのほうは、Microsoft Windows Installerというプログラムがコンピュータに入っている必要があります。）
• ダウンロードしたファイルをダブルクリックしてインストールします。
• インストールが終わったら再起動します。
• 試しにMS-DOSプロンプトを立ち上げて Perl -v と入力してバージョンとか表示されれば正常にインストールされています。
• 「コマンドまたはファイル名が違います」とかエラー表示された場合は、Autoexec.bat にPerl.exe へのパスを追加します。「スタート」->「ファイル名を指定して実行」を選択。sysedit と入力します。
• 立ち上がったらautoexec.bat のウィンドウを選び、PATH C:\Perl\bin;・・・・ とPerl.exe のある場所をPATHに追加します。ちょっと説明が面倒なので、私のautoexec.bat を晒しますので参考にしてください。（%PATH% は それ以前に登録したPATH のことです。）

 PATH C:\Perl\bin\;C:\php;C:\j2sdk1.4.1_02\bin;C:\mysql\bin;C:\perl\site\lib\auto\Image\Magick
 PATH %PATH%;"C:\Program Files\ImageMagick-5.5.7-Q8;C:\Program Files\Microsoft SQL Server\80\Tools\Binn;C:\PROGRA~1\MICROS~7\80\TOOLS\BINN;C:\Program Files\Mts"

これで再起動すれば、Perl -v が通るはずです。

古いバージョンのActivePerlが欲しい

先ほどちょっと触れましたが、開発でどうしても古いバージョンが必要になることがあります。実行時の環境と開発環境をあわせる必要がある場合などです。私もつい先月、5.005_03を使わなければならなくなり結構な時間探しました。灯台もと暗しでhttp://downloads.activestate.com/ActivePerl/からダウンロードできました。

お勧めのエディタは？

私がCGIの開発によく利用しているのが、サクラエディタというフリー＆オープンソースのエディタです。このエディタはPerlのみならず色々な言語に対応していますので、是非一度お試しあれ。マクロも使えます。http://members.tripod.co.jp/sakura_editor/index.html

簡単な使い方

• F11 で関数のアウトライン表示
• Ctrl + F5 でPerlを実行。名前欄に 「Perl "$F"」 と書きます。「標準出力を得る」にチェックを付けると、標準出力をトラップして、エラー行からタグジャンプすることができます。
• F12でタグジャンプ

もう一つ。最近使い始めたのですが、EPICというexlipse用のプラグインです。こちらは本格的な開発に向いているかもしれません。まだ機能が完全でないので、あせってインストールする必要はないでしょう。多くの言語を同じ開発環境で扱いたい人にはお勧めします。

Perl上達のコツ

関数を抜け出しても値を保持するスタティックな変数を使いたい

Perlにはstaticなどの宣言はないので、以下のようにブロック内で有効な変数を置く。

 #!/usr/bin/perl -w
 use strict;
 
 my $var = 100;
 
 func();
 func2();
 func();
 func2();
 func();
 func2();
 exit;
 
 {
     my $var;          # staticのように振舞う変数
     sub func {
         print $var++;
         print "\n";
     }
 }
 
 sub func2 {
     print $var++;
     print "\n";
 }

Perl5.6以降なら、our宣言を使って、もっとstaticらしく書ける

 #!/usr/bin/perl -w
 use strict;
 
 my $var = 100;
 
 func();
 func2();
 func();
 func2();
 func();
 func2();
 exit;
 
 sub func {
     our $var;
     print $var++;
     print "\n";
 }
 
 sub func2 {
     print $var++;
     print "\n";
 }

テキストファイルの最終行を更新したい

単純にファイル内容を配列に取り込んでしまうのも一つの手。

 #!/usr/bin/perl -w
 use strict;
 
 my $filename = 'testfile.txt';
 my $newwords = '新しい内容';
 
 open(FH, "+< $filename") or die $^E;
 my @line = <FH>;
 
 $line[$#line] = $newwords;
 
 seek(FH, 0, 0);
 print FH @line;
 truncate(FH, tell(FH));
 close(FH);

ただし大きなテキストファイルだった場合、上のプログラムでは大量にメモリを消費することになります。

そうならないようにするには最終行の位置を取得して書き込みを行います。

 #!/usr/bin/perl -w
 use strict;
 
 my $filename = 'testfile.txt';
 my $newwords = '新しい内容';
 my $pos = 0;
 
 open(FH, "+< $filename") or die $^E;
 while(<FH>){
     $pos = tell(FH) unless eof(FH);
 }
 seek(FH, $pos, 0) or die $^E;
 print FH $newwords;
 truncate(FH, tell(FH));
 close(FH);

指定ファイルの行数を知る

変数をインクリメントしないスッキリしたやり方です。$. は、最後に入力したファイルハンドルの現在の行番号を格納している特殊変数です。ファイルハンドルを最後まで読んでから、$. を参照します。print <RF>; ではなく、1 for <RF>; 等と書けば、ファイル内容を表示しません。

 #!/usr/bin/perl -w
 use strict;
 
 my $file = 'hogehoge';
 
 open(RF, $file) or die;
 print <RF>;
 print $file.'は'.$..'行です。';
 close(RF);
 exit;

FTPクライアントを書く

今日は、FTPのページを作ったので、ついでにPerlでの処理の仕方も書いておきます。

PerlでFTPクライアントを書くには、Net::FTPモジュールを使います。Net::FTPは libnet に収められています。

インストール

WindowsのActivePerlならパッケージマネージャを使うと簡単にインストールできます。コマンドプロンプトを開き、ppmと入力

 C:\> ppm
 PPM - Programmer's Package Manager version 3.1.
 Copyright (c) 2001 ActiveState SRL. All Rights Reserved.
 
 Entering interactive shell. Using Term::ReadLine::Stub as readline library.
 
 Type 'help' to get started.
 
 ppm>

と ppm> プロンプトになります。（画面はppmのバージョンによって若干違います。）

search libnet と入力して libnet があることを確認します。

 ppm> search libnet
 Searching in Active Repositories
   1. Bundle-libnet [1.00] A bundle to install all libnet related modules
   2. Bundle-libnet [1.00] A bundle to install all libnet related modules
   3. libnet        [1.13] Collection of Network protocol modules
 ppm> 

あることを確認したら install libnet と入力すればOKです。インストールが終了したら、quit で ppm を終了します。

サンプル

 #!/usr/bin/perl -w
 # FTPテスト - 指定ディレクトリのファイル一覧を表示する
 use strict;
 use Net::FTP;
 
 my $ftp;
 my $url  = "SERVER_URL";        # ftp:// は要らない
 my $user = "USER_NAME";
 my $pass = "PASSWORD";
 my $dir  = "hoge";
 
 $ftp = Net::FTP->new($url) or die "接続失敗！$@\n";
 $ftp->login($user, $pass)  or die "ログイン失敗！\n";
 $ftp->cwd($dir)            or die "ディレクトリの変更失敗！\n";
 print join("\n",$ftp->dir());

上記は $dir で指定したディレクトリのファイル一覧を表示するサンプルです。

指定したディレクトリ以下の全てのファイルに対して処理を行いたい

File::Find モジュールを使うと便利です。

以下のサンプルは、指定ディレクトリ下全てのリードオンリー属性を解除するプログラムです。CDからコピーしたデータ用に作成しました。

 #!/usr/bin/perl -w
 # chngatrib - CD-ROMから読み出したデータのリードオンリー属性を解除する
 use strict;
 use File::Find;
 
 # リードオンリーを解除するディレクトリ名のリスト
 # qw(dir1 dir2 dir3 ...) のように指定する
 my @dir = qw(temp);
 
 # @dir以下全てにch関数適用
 find  \&ch, @dir;
 
 # 属性解除
 sub ch{ chmod 0777, $_ }
 
 exit;

File::Findモジュールを利用できない場合は以下のように再帰処理を行います。

 #!/usr/bin/perl -w
 # モジュールを使わず再帰でディレクトリを探る
 use strict;
 
 my @dir = qw(temp);
 
 foreach(@dir){
     find_ch($_);
 }
 exit;
 
 # 再帰関数
 sub find_ch {
     my $dir = shift;
     my @file;
 
     # ディレクトリ内のファイルコレクション取得
     opendir(DIR, $dir) or die;
     @file = readdir(DIR);
     closedir(DIR);
 
     foreach(@file){
         my $path = "$dir/$_";
         # カレント、ペアレントは対象外
         next if(/^\.$/ || /^\.\.$/);
         # ディレクトリなら再帰処理
         find_ch($path) if(-d $path);
         # 属性変更
         chmod 0777, $path;
     }
 }

文字列を「あかさたな・・・」で行分類したい

人名などを扱うプログラムを書くことは多いと思いますが、あかさたなで自動振り分けするのはあまり需要がないかもね。私は会員管理のCGIの仕事などでたまに使います。

 SWITCH: {
     /^\x82[\xa0-\xa8]/ and $gyo = 'a',  last SWITCH;
     /^\x82[\xa9-\xb2]/ and $gyo = 'ka', last SWITCH;
     /^\x82[\xb3-\xbc]/ and $gyo = 'sa', last SWITCH;
     /^\x82[\xbd-\xc7]/ and $gyo = 'ta', last SWITCH;
     /^\x82[\xc8-\xcc]/ and $gyo = 'na', last SWITCH;
     /^\x82[\xcd-\xdb]/ and $gyo = 'ha', last SWITCH;
     /^\x82[\xdc-\xe0]/ and $gyo = 'ma', last SWITCH;
     /^\x82[\xe2-\xe6]/ and $gyo = 'ya', last SWITCH;
     /^\x82[\xe7-\xeb]/ and $gyo = 'ra', last SWITCH;
     /^\x82\xed/        and $gyo = 'wa', last SWITCH;
     $gyo = 'end';
 }

上記は、実際に仕事で書いたコードから抜粋しました。文字列の先頭を見て、「あ〜お」だったら、$gyo に 'a' という符号をセットします。

閏年（うるうどし）の処理

これは別にPerlに限った処理ではないのですが、Perlでの利用が多いかなと思ったのでこのページに書いておきます。

グレゴリオ暦の閏年の条件ですが、

• 4で割り切れる年は閏年
• しかし100で割り切れる年は閏年でない
• しかし400で割り切れる年は閏年

となります。こういう複雑そうな条件式も演算子の優先順位を知っていれば、意外と簡単に記述することができます。

 use strict;
 
 foreach my $year (1800..2500){
     if($year % 4 == 0 && $year % 100 != 0 || $year % 400 == 0){
         print $year . "年は閏年\n";
     }
 }

一般的な言語では、比較演算子の方が論理演算子より優先順位が高いです。また論理演算子では、or(||)よりand(&&)の方が優先順位が高いので、下のように順序を入れ替えても同様の結果が得られます。

    if($year%400 == 0 || $year % 4 == 0 && $year%100 != 0){

    if($year%400 == 0 || $year%100 != 0 && $year % 4 == 0){

数値の桁揃え

333 -> 003335874 -> 05874

などの桁揃えです。意外と初心者の頃には解りにくいかもしれません。PerlではC言語と同じ printf 関数が用意されています。

 #!/usr/bin/perl -w
 # 数値の桁揃え
 use strict;
 
 my $num = 333;
 printf("%05d", $num);

のように %05d と指定すると、先頭をゼロで補完した5桁の10進数に整形出力してくれます。

 printf("%.2f", $num);

のように %.2f と指定すると小数点第2位までで整形出力してくれます。（四捨五入もしてくれます）出力ではなく、文字列として必要なら、sprintf を使います。

 $ret = sprintf("%05d", $num);

詳細は避けますが、フォーマット部分は他にも沢山のフラグを指定できます。

最後に、このフォーマット部分を定数で指定する場合（SSIテキストカウンタなどで桁数を指定したり・・・）は、以下のようにブロックで囲むとうまくいきます。

 #!/usr/bin/perl -w
 # 数値の桁揃え
 use strict;
 
 my $FIG = 5;   # 桁数を指定
 my $num = 832;
 
 printf("%0${FIG}d", $num);

単純なファイルバックアップ処理

単純にリネーム処理するのが簡単です。PerlのrenameはPHPのと違い、ファイルが存在しても上書きでリネームしてくれます。数世代なら以下のように、世代の古い順にrenameを羅列すればいいでしょう。

 #!/usr/bin/perl -w
 # filebkup.pl - ファイルバックアップの一例
 use strict;
 
 my $file  = './datas/data.dat';
 
 rename($file.'.4', $file.'.5');
 rename($file.'.3', $file.'.4');
 rename($file.'.2', $file.'.3');
 rename($file.'.1', $file.'.2');
 rename($file,      $file.'.1');
 
 open(FH, '>'.$file) or die;
 print FH $$.' 新しい書き込み内容';
 close(FH);

世代が多い場合は、ループで処理するとスッキリします。

 #!/usr/bin/perl -w
 # filebkup.pl - ファイルバックアップの一例
 use strict;
 
 my $GEN = 100;    # 世代
 my $file  = './datas/data.dat';
 
 map rename("$file.".($_-1), "$file.$_"), reverse(2..$GEN);
 rename($file, "$file.1");
 
 open(FH, '>'.$file) or die;
 print FH $$.' 新しい書き込み内容';
 close(FH);

ODBC経由でデータベースに接続する

PerlからWindowsのODBC経由でのデータベース接続方法です。現在のActivePerlには、Win32::ODBCというライブラリが付属するのでそれを利用します。予め適当なDSNを登録しておいてください。下記サンプルは、SQL ServerのNorthwind データベースに接続してOrdersテーブルの内容をカンマ区切りで表示します。DSNはnwという名前で登録しています。

 #!/perl/bin/perl -w
 # odbctest.pl - ODBC接続テスト
 use strict;
 use Win32::ODBC;
 use vars qw/$CONN $SQL/;
 
 $CONN = 'DSN=nw;UID=sa;PWD=hoge';    # ODBC接続文字列
 $SQL  = 'SELECT * FROM Orders';
 
 my $db = new Win32::ODBC($CONN) or die Win32::ODBC::Error();
 
 if($db->Sql($SQL)){
     print "SQL Error: ".$db->Error()."\n";
     $db->Close();
     exit;
 }
 
 while($db->FetchRow){
     my @field = $db->Data();
     print join(",", map {$_||''} @field), "\n";
 }
 
 $db->Close();

ADOでデータベースに接続する

折角なので、ADOでの接続方法も書いておきます。ADOでの接続には、Win32::OLE というモジュールを利用します。こちらもActivePerlに標準でついてきます。ADO自体の命令は同じなので、ADOを知っている人ならPerlでの表記さえ覚えればすぐに利用できるでしょう。

 #!/perl/bin/perl -w
 # adotest.pl - PerlでADODB接続テスト
 use strict;
 use Win32::OLE;
 use Win32::OLE::Variant;
 
 my $cn = Win32::OLE->new("ADODB.Connection");
 $cn->Open("File Name=nw.udl");
 my $rs = $cn->Execute('SELECT * FROM 受注');
 
 if(!$rs){
     my $err = $cn->Error();
     die "Errors:\n", map { $_->{Description}."\n" } keys %$err;
 }
 
 while(!$rs->EOF){
     my @field = (
         $rs->Fields('受注コード')->Value,
         $rs->Fields('得意先コード')->Value,
         $rs->Fields('社員コード')->Value,
         $rs->Fields('出荷先名')->Value,
         $rs->Fields('出荷先郵便番号')->Value,
         $rs->Fields('出荷先都道府県')->Value,
         $rs->Fields('出荷先住所1')->Value,
         $rs->Fields('出荷先住所2')->Value,
         $rs->Fields('運送区分')->Value || '',
         Variant(VT_DATE, $rs->Fields('受注日')->Value),
         Variant(VT_DATE, $rs->Fields('締切日')->Value),
         Variant(VT_DATE, $rs->Fields('出荷日')->Value),
         $rs->Fields('運送料')->Value,
     );
     print join(',', @field), "\n";
     $rs->MoveNext();
 }
 $rs->Close();
 $cn->Close();

擬似ハッシュ

配列は比較的アクセス速度が速いが、インデックスが数値のためにわかりづらい。ハッシュ（連想配列）は文字列キーを使ってデータを管理できるので、わかりやすいが反面速度が遅い。

擬似ハッシュを使うと、そのようなジレンマを解消できます。擬似ハッシュは、ハッシュへのリファレンスのふりをする配列へのリファレンスです。第一要素にハッシュへのリファレンスを持たせて、配列へのインデックスをつけます。

 #!perl -w
 # pseudohash.pl - 擬似ハッシュ
 use strict;
 
 my $ph = [ {hoge=>1, foo=>2, bar=>3}, "Hogget!", "Fool!", "Barser!" ];
 #my $ph = [ {hoge=>3, foo=>1, bar=>2}, "Hogget!", "Fool!", "Barser!" ];
 
 print $ph->[1], "\n";
 print $ph->{hoge}, "\n";      # このようにハッシュなアクセスができる！
  
 print 'hogeのインデックスは'. $ph->[0]->{hoge}, "\n";
 print $ph->[$ph->[0]->{hoge}];

擬似ハッシュを利用する場合は、fieldsプラグマもセットで覚えた方がよいでしょう。fields プラグマを利用するとパッケージ名で修飾されたハッシュ%FIELDSを擬似ハッシュ用に初期化してくれます。そしてコンパイル時に、擬似ハッシュへのアクセスを配列への直接アクセスに置き換えてくれるので、高速にアクセスできるようになります。

 #!perl -w
 # pseudohash.pl - 擬似ハッシュ
 use strict;
 use fields qw(hoge foo bar);
 #use fields qw!bar hoge foo!;
 
 my $ph = [ \%::FIELDS, "Hogget!", "Fool!", "Barser!" ];
 
 print $ph->[1], "\n";
 print $ph->{hoge}, "\n";      # このようにハッシュなアクセスができる！
 
 print 'hogeのインデックスは'. $ph->[0]->{hoge}, "\n";
 print $ph->[$ph->[0]->{hoge}];

月末の日付を求める

指定した年月の翌月1日のエポック秒を求め、そのエポック秒から前日（月末）を求めます。日付をエポック秒に変換するには、Time::Localモジュールを使います。

 #!/usr/bin/perl -w
 use strict;
 use Time::Local;
 
 print join('/', lastday(2003, 2));  # 2003年2月の末日
 print "\n";
 print join('/', lastday(2004, 2));  # 2004年2月の末日
 print "\n";
 
 sub lastday {
     # 翌月の1日0時0分0秒のエポック秒
     my $epoch_sec = timelocal(0, 0, 0, 1, $_[1], $_[0]-1900);
 
     #僅か１秒だけ引いても前日だよね？
     my($day, $mon, $year) = ( localtime($epoch_sec-1) )[3..5];
 
     return ($year+1900, $mon+1, $day);
 }

文字列の前後のスペースを除去する

VBSにあるTrim関数と同じような奴です。ヒアドキュメントをインデントしたりできるので、コードの見栄えを正すのにも使えます。

 #!/usr/bin/perl -w
 use strict;
 
 print ltrim(<<_EOD_);
     我輩は猫であった。
     しかし今は人間である。
 _EOD_
 
 sub trim {
     my $str = shift;
     $str =~ s/^\s+//gm;
     $str =~ s/\s+$//gm;
     return $str;
 }
 
 sub ltrim {
     my $str = shift;
     $str =~ s/^\s+//gm;
     return $str;
 }
 
 sub rtrim {
     my $str = shift;
     $str =~ s/\s+$//gm;
     return $str;
 }