Perl言語による簡単なCGIプログラムの作成方法を記述します。

基本
CGIプログラムの最初の1行目は「#!」に続いてPerlのパスを記述します。
コメントは「#」から始まり行末までです。
print文でHTMLを出力して表示します。文の末尾は「;」を付けます。
「\n」は改行です。但し、これはHTMLソースファイル上での改行です。表示上で改行する場合は<br>を使います。
最初に下記のHTTPヘッダーを出力します。ここでHTML言語テキストを指定します。
ヘッダーの区切りに空行が必要な為、\nを2個入れます。
  print "Content-type: text/html\n\n";

print "・・・"で「"」を使用しているので「"」を出力する場合はその前に「\」を付けます。
exitでプログラムの実行を終了します。
上記はCGIプログラムで共通に必要な部分です。以下のプログラムではこの部分を省略して記述します。
■プログラム (sample1.cgi)
#!/usr/bin/perl
#文字/画像の表示
print "Content-type: text/html\n\n";
print "<html><body>\n";
print "こんにちは<br><img src=\"banner.gif\">\n";
print "</body></html>\n";
exit;
■実行結果
こんにちは

スカラー
スカラーは数値や文字列です。
・スカラー変数($) 例:$data ← $(英字)(英字/数字/下線)、大/小文字を区別

シングルクォート文字列 ''
  改行も文字と見なします。「'」「\」を表示するには直前に「\」を付けます。
   例 print '太郎';  →太郎
     print '太郎\n'; →太郎\n
     print '太郎\''; →太郎'
     print '太郎\\'; →太郎\

ダブルクォート文字列 ""
  「\」の付いたメタ文字を使用できます。
  $スカラー変数、@配列変数は値に置換されます(変数展開)。
  「"」「\」「$」「@」を表示するには直前に「\」を付けます。
   例 print "太郎";  →太郎
     print "太郎\n"; →太郎            メタ文字 \n 改行
     print "\Qab+*()[]\E"; →ab\+\*\(\)\[\]  メタ文字 \Qから\Eまでの非英数文字の前に\を付ける
     print "太郎\""; →太郎"
     print "太郎\\"; →太郎\
     $a=2; print "太郎$a"; →太郎2
     print "太郎\$a"; →太郎$a
     print "太郎\@a"; →太郎@a

・演算例
     $a += 5;    $a = $a + 5;と同じ
     $a++; ++$a;  1を加算
     $a--; --$a;  1を減算
     $name = "山田" . "太郎"; →山田太郎(文字列の連結)

int  整数に変換します。 例 $a = int($data);
hex 16進数を表す文字列を10進数に変換します。 例 $a = hex("FF");
■プログラム (sample10.cgi)
print '太郎',' 太郎\n',' 太郎\'',' 太郎\\<br>';
$a = 2;
print "太郎"," 太郎\n","  \Qab+*()[]\E"," 太郎\""," 太郎\\"," 太郎$a"," 太郎\$a"," 太郎\@a<br>";

$a = 2;
$a += 5;
print "$a<br>";
$a++;
print "$a<br>";

$name = "山田" . "太郎"; print "$name<br>";
$data = 2.3; $a = int($data); print "$a<br>";
$a = hex("FF"); print "$a<br>";
■実行結果
太郎 太郎\n 太郎' 太郎\
太郎 太郎  ab\+\*\(\)\[\] 太郎" 太郎\ 太郎2 太郎$a 太郎@a
7
8
山田太郎
2
255

配列
配列はスカラーをインデックス順に並べたものです。インデックスは0,1,2・・・の数値です。
配列要素の並びはリストで表示されます。
・配列変数(@)  例:@data ← @(英字)(英字/数字/下線)、大/小文字を区別
・配列要素 $data[0],$data[1] ・・・
・(1 .. 5) は (1,2,3,4,5) と同じ
・(A .. E) は (A,B,C,D,E) と同じ
・@data = (4,6,8)とすると、
   $x = @data;  → $xは配列要素数3になる。
   ($x) = @data; → $xは最初の要素4になる。
   $x = $#data; → $xは最後のインデックス2になる。

push   配列の最後に要素を追加する。 例 push(@data,$x);
unshift 配列の最初に要素を追加する。 例 unshift(@data,$x); 
reverse 配列の順番を反転する。    例 @data = reverse @data;
sort   配列の要素を並べ替える。
      例 @data = sort @data;        配列の要素をアスキーコード順に並べ替える。
        @data = sort {$b <=> $a} @data; 配列の要素を数値の大きい順に並べ替える。
■プログラム (sample11.cgi)
@data = (1 .. 5); print "@data<br>";
@data = (A .. E); print "@data<br>";

@data = (4,6,8);
$x = @data; print "$x<br>";
($x) = @data; print "$x<br>";
$x = $#data; print "$x<br>";

$x = 10; $y = 2;
push(@data,$x); print "@data<br>";
unshift(@data,$y); print "@data<br>";
@data = reverse @data; print "@data<br>";

@data = ('B','C','A'); print "配列要素 :$data[0],$data[1],$data[2]<br>";
@sdata = sort @data; print "アスキー順:$sdata[0],$sdata[1],$sdata[2]<br>";
@data = (3,20,1); @sdata = sort @data; print "アスキー順:$sdata[0],$sdata[1],$sdata[2]<br>";
@sdata = sort {$b <=> $a} @data; print "数値順  :$sdata[0],$sdata[1],$sdata[2]";
■実行結果
1 2 3 4 5
A B C D E
3
4
2
4 6 8 10
2 4 6 8 10
10 8 6 4 2
配列要素 :B,C,A
アスキー順:A,B,C
アスキー順:1,20,3
数値順  :20,3,1

ハッシュ
ハッシュはキーと値を対にした集合で、キーに文字列を使用できます。
・ハッシュ変数(%) 例:%data ← %(英字)(英字/数字/下線)、大/小文字を区別
・ハッシュ値  $data{'key1'},$data{'key2'} ・・・

keys  ハッシュの全キーを取り出す。 例 @key = keys %data;
values ハッシュの全ての値を取り出す。 例 @val = values %data;

下記はハッシュ値の数値の大きい順にキーを並べる場合の例です。
 sort {$data{$b} <=> $data{$a}} keys(%data)
■プログラム (sample12.cgi)
%data = ('B',3,'C',1,'A',2);
@key = keys %data; print "ハッシュキー        :@key<br>";
@val = values %data; print "ハッシュ値          :@val<br>";

print "ハッシュキーのアスキー順:";
foreach (sort keys(%data)) {print "$_:$data{$_} ";}
print "<br>ハッシュ値の数値順    :";
foreach (sort {$data{$b} <=> $data{$a}} keys(%data)) {print "$_:$data{$_} ";}
■実行結果
ハッシュキー        :A B C
ハッシュ値          :2 3 1
ハッシュキーのアスキー順:A:2 B:3 C:1 
ハッシュ値の数値順    :B:3 A:2 C:1

条件分岐
条件分岐はif、unlessです。
条件は、<,>,<=,>=,==,!=,eq,neなどが使われます。
例: if ($a<5) { } elsif ($a==5) { } else { }
   if (!$a) { }         ! は論理否定
   if ($a eq '太郎') { }   文字列の場合は eq、ne
   if ($a ne '太郎') { }
■プログラム (sample13.cgi)
$a = 3; if ($a<5) {print "4以下です。";} elsif ($a==5) {print "5です。";} else {print "6以上です。";} print "<br>";
$a = 5; if ($a<5) {print "4以下です。";} elsif ($a==5) {print "5です。";} else {print "6以上です。";} print "<br>";
$a = 7; if ($a<5) {print "4以下です。";} elsif ($a==5) {print "5です。";} else {print "6以上です。";} print "<br>";
$a = 0; if (!$a) {print "0です。";} print "<br>";

$a = '太郎'; if ($a eq '太郎') {print "太郎です。 ";} print "<br>";
$a = '二郎'; if ($a ne '太郎') {print "太郎ではありません。";}
■実行結果
4以下です。
5です。
6以上です。
0です。
太郎です。 
太郎ではありません。

ループ
ループはwhile、until、for、foreachです。
例: while ($k<10) { }
   for ($k=0; $k<10; $k++) { }
   foreach $data (@data) {print $data;}
   foreach (@data) {print $_;}   $dataを省略すると$_が使われます。
   foreach (0 .. 9) {print $_;}
ループを途中で抜けたい場合はlast、ループ処理を次へスキップしたい場合はnextを使用します。
■プログラム (sample14.cgi)
$k = 0; while ($k<10) {print $k; $k++;} print "<br>";
for ($k=0; $k<10; $k++) {print $k;} print "<br>";
@data = ('A','B','C');
foreach $data (@data) {print $data;} print "<br>";
foreach (@data) {print $_;} print "<br>";
foreach (0 .. 9) {print $_;} print "<br>";
foreach (0 .. 9) {
if ($_ == 5) {last;}
print $_;
}
print "<br>";
foreach (0 .. 9) {
if ($_ == 5) {next;}
print $_;
}
■実行結果
0123456789
0123456789
ABC
ABC
0123456789
01234
012346789

正規表現
正規表現は文字列パターンの記述方法でパターンマッチングに使われます。
正規表現は//で挟み、下記の記号が使われます。
  | いずれかの文字列にマッチする。例:/太郎|次郎/
  ^ 文字列の先頭にマッチする。  例:/^太郎/
  $ 文字列の末尾にマッチする。  例:/太郎$/
  . ドットは改行以外の任意の1文字にマッチする。

  [ ] いずれか1文字にマッチする(文字クラス)。「-」は範囲を示す。
      [a-zA-Z0-9_] → \wに略記
      [ \r\t\n\f] → \sに略記
      [0-9]    → \dに略記(数字にマッチ)
      [^0-9]   → \Dに略記(数字以外にマッチ)

  直前の文字の頻出回数でマッチする。例:/.*/ /\d+/
    * 0回以上
    + 1回以上
    ? 0回又は1回

  下記の文字にマッチさせる場合はその直前に\を付けます。
    ^ \ [ $ * + ? . { ( ) |

正規表現の使用例
 if ($data =~ /太郎/) { }  $dataに対して「太郎」とマッチするか判定する。
 if (/太郎/) { }       $dataを指定しない場合は$_が対象になる。
 if (/ab/i) { }       i修飾子は大文字と小文字を区別しない。
 if (/(\d+)AB(\w+)/) {print $1,$2;}  (\d+)が$1、(\w+)が$2に対応する。( )の順に$1,$2,・・・

s///ige 正規表現にマッチした部分を他の文字列に置換します。下記の修飾子があります。
       i 大文字と小文字を区別しない。
       g 全てのマッチを置換する。
       e 置換文字列を式として実行する。
      例 $data =~ s/a/0/; $dataにある最初のaを0に置換する。
         s/a/0/ig;     $_にある全てのa又はAを0に置換する。
         s/(\d+):(\d+)/A=$1 B=$2/; 最初の(\d+)が$1、後の(\d+)が$2に対応する。

split  正規表現にマッチした部分で分割してリストにします。
      例 ($a,$b) = split(/&/,$data);  $dataを&で分割する。
         @a = split(/&/);       $_を&で分割して@aの配列に格納する。
         @a = split(//);        $_を1文字単位に分割して@aに格納する。
■プログラム (sample15.cgi)
$data = '名前は太郎です。';
if ($data =~ /太郎/) {print "太郎にマッチしました。<br>";} else {print "太郎にマッチしません。<br>";}
$_ = '名前は太郎です。';
if (/太郎/) {print "太郎にマッチしました。<br>";} else {print "太郎にマッチしません。<br>";}
if (/^太郎/) {print "太郎にマッチしました。<br>";} else {print "太郎にマッチしません。<br>";}

$_ = '01ABCD';
if (/ab/i) {print "マッチしました。<br>";} else {print "マッチしません。<br>";}
if (/(\d+)AB(\w+)/) {print "$1,$2<br><br>";} else {print "マッチしません。<br><br>";}

$data = 'abcabc'; $data =~ s/a/A/; print "$data<br>";
$data = 'abcabc'; $data =~ s/a/A/g; print "$data<br>";
$_ = 'abcABC'; s/a/0/ig; print "$_<br>";
$_ = '5:67'; s/(\d+):(\d+)/A=$1 B=$2/; print "$_<br>";

$data = '012&345'; ($a,$b) = split(/&/,$data); print "$a,$b<br>";
$_ = '012&345'; @a = split(/&/); print "$a[0],$a[1]<br>";
$_ = '345'; @a = split(//); print "$a[0],$a[1],$a[2]<br>";
■実行結果
太郎にマッチしました。
太郎にマッチしました。
太郎にマッチしません。
マッチしました。
01,CD

Abcabc
AbcAbc
0bc0BC
A=5 B=67
012,345
012,345
3,4,5

文字列の操作
chop  文字列の最後の文字を削除します。引数を省略すると$_が対象になります。
      例 chop($data); chop;

length  文字の長さを示します。
      例 $a = length($data);

tr///  文字を変換する。文字をリストで記述します。
      例 $data =~ tr/A,C,E/a,c,e/;  A,C,Eをa,c,eに変換する。

join   配列要素の間に文字列を挿入します。
      例 $data = join('&',@a);  @aの配列要素の間に&を挿入する。

index  文字列を左側から検索して最初に見つけた検索文字のバイト位置を示します。
     バイト位置は先頭から0,1,2・・・で、見つからない場合は-1になります。
     日本語は1文字当たり2バイトです。
      例 $index = index($data,'C');  $dataから文字Cの位置を示す。

substr 指定したバイト位置から、指定したバイト長の文字を取り出します。
     バイト位置は先頭から0,1,2・・・で、末尾からは-1,-2,-3・・・となります。
     バイト長を省略すると最後まで取り出します。日本語は1文字当たり2バイトです。
     substrを式の左辺に置くと取り出した文字の置換又は削除・追加ができます。
      例 $word = substr($data,2,3);  $dataのバイト位置2から3バイト分の文字を取り出す。
        $word = substr($data,2);   $dataのバイト位置2から最後までの文字を取り出す。
        $word = substr($data,-5,3); $dataの末尾からのバイト位置5から3バイト分の文字を取り出す。
        substr($data,2,3) = 'XY';   $dataのバイト位置2から3バイト分の文字をXYに置換する。
        substr($data,2,3) = '';     $dataのバイト位置2から3バイト分の文字を削除する。
        substr($data,2,0) = 'XY';   $dataのバイト位置2にXYを追加する。

sprintf 文字列や数値を指定の書式に変換します。主な書式変換記号を下記に示します。
        %d 10進数、 %f 浮動小数点
      例 $a = sprintf("%02d",$data);        $dataを0詰め2文字にする。
        $a = sprintf("%02d:%02d",$hour,$min); 例えば07:08のようになる。
        $a = sprintf("%4.1f",$data);        $dataを右詰め4文字幅、小数点以下1桁にする。

printf 文字列や数値を指定の書式に変換して出力します。書式変換はsprintfと同じです。
      例 printf("%02d",$data);  $dataを0詰め2文字で表示する。
■プログラム (sample16.cgi)
$data = 'ABCDEF'; chop($data); print "$data<br>";
$a = length($data); print "$a<br>";
$data = 'ABCDEF'; $data =~ tr/A,C,E/a,c,e/; print "$data<br>";
@a = (0,1,2,3,4,5); $data = join('&',@a); print "$data<br>";
$data = 'ABCABC'; $index = index($data,'C'); print "$index<br>";
$index = index($data,'D'); print "$index<br>";
$data = '名前は太郎です。'; $index = index($data,'太郎'); print "$index<br><br>";

$data = 'ABCDEFG';
$word = substr($data,2,3); print "$word<br>";
$word = substr($data,2); print "$word<br>";
$word = substr($data,-5,3); print "$word<br>";
substr($data,2,3) = 'XY'; print "$data<br>";
substr($data,2,3) = ''; print "$data<br>";
substr($data,2,0) = 'XY'; print "$data<br>";
$data = '名前は太郎です。'; $word = substr($data,6,4); print "$word<br><br>";

$data = 5; $a = sprintf("%02d",$data); print "$a<br>";
$hour = 7; $min = 8; $a = sprintf("%02d:%02d",$hour,$min); print "$a<br>";
$data = 5.62; $a = sprintf("%4.1f",$data); print "$a<br>";
$data = 5; printf("%02d",$data);
■実行結果
ABCDE
5
aBcDeF
0&1&2&3&4&5
2
-1
6

CDE
CDEFG
CDE
ABXYFG
ABG
ABXYG
太郎

05
07:08
5.6
05

日本語の問題
 一般的にWindowsやMacのパソコンでは日本語の文字コードにシフトJISが使われています。しかし、CGIプログラムをシフトJISで記述すると文字化けやエラーを起こす場合や正規表現が正常に実行されない場合があります。原因は、日本語が1文字2バイトのコードで表されますが、その2バイト目がPerlの特殊文字に重複したり正規表現にマッチしたりする為です。以下に問題点の内容と対策を示します。

文字化けの問題
日本語のシフトJISで2バイト目がPerlの特殊文字に重複すると文字化けが起きる場合があります。文字コードにEUCを使えば重複しないので文字化けは起こりません。

◆ 2バイト目が\の文字
 2バイト目がシフトJISで「5C」になる文字は「\」を表し、「\」はメタ文字に解釈される為、2バイト目は次の文字コードになります。従って、その該当文字及び次の文字が化けてしまいます。その為、特に文字列の最後に上記の文字を記述すると文法エラーを引き起こします。
    例 "ソフト"→ャtト  "表示"→侮ヲ   (「ソ」「表」の2バイト目が\)
2バイト目が「\」になる主な文字を下記に示します。
   ― ソ \ 表 予 能 申 十 構 貼 暴 欺 圭 噂 蚕 饅 箪 禄 兔 彌

対策を下記に示します。
 ・上記の文字の直後に「\」を付けます。これによってメタ文字に解釈される「\」を補います。
    例 "ソ\フト" "表\示" "予\定"
 ・シングルクォート文字列を使います。
    例 'ソフト' '表示' '予定'
  但し、文字列の最後に上記の文字を記述すると「\'」になる為、「'」が文字列に含まれてしまい文法エラーになります。
  その場合は「\」を付けます。
    例 '予定表\'

◆ 2バイト目が@の文字
 2バイト目が「@」になる文字は、その次の文字に配列変数で使われる文字又は数字があると配列に解釈されて文字化けが起きます。
    例 "方法A案"→方毎ト  (「法」の2バイト目が@)
2バイト目が「@」になる主な文字を下記に示します。
   ・全角スペース
   ・ァ 法 機 鼻 院 諭 繊 掘 察 宗 邸 如 后 魁 拭 叩 蓮 廖

対策はシングルクォート文字列を使います。
    例 '方法A案'  '方法',"$a案"


正規表現での問題
 正規表現に日本語を使う場合は下記のような問題があります。

◆ 2バイト目に正規表現で使う文字がある場合
 日本語の2バイト目に正規表現で使う文字があると正しく実行されなかったり、文法エラーが起きたりします。特にフォーム入力のデータを正規表現に使う場合は、入力データによってエラーが起きたり起きなかったりするので注意が必要です。正規表現で使う文字 ^ \ $ * + ? . | [ ] { } ( )
    例 if ($data =~ /充分/) { }     文法エラーになります。「充」の2バイト目が [ であり ] がない為です。
       $a='充'; if ($data =~ /$a/) { }  この文を実行した時にエラーになります。

対策はメタ文字\Q\Eを使います。これは\Qから\Eまでの非英数文字の前に\を付けます。
    例 if ($data =~ /\Q充分\E/) { }
       if ($data =~ /\Q$a\E/) { }

◆ 1バイトずれで誤ってマッチしてしまう場合
 2バイト目又はそれ以降のバイトずれした文字は誤ってマッチしてしまう場合があります。
    例 $data = '充分';
       if ($data =~ /\Q[\E/) {print '一致';}  「充分」は [ にマッチしてしまいます

 文字コードがEUCでもバイトずれによってマッチしてしまう場合があります。
 対策は1文字毎のバイト長を認識させればいいですが複雑になるので割愛します。
 正規表現で記述する文字長が大きければ誤ってマッチする可能性は低くなります。
■プログラム (sample29.cgi)
print "ソフト、Z[\]、表示、予定、能力、申し込み、十分、構造<br>";
print "ソ\フト、Z[\\]、表\示、予\定、能\力、申\し込み、十\分、構\造<br>";
print 'ソフト、Z[\]、表示、予定、能力、申し込み、十分、構造<br>';
print '予定表\';
print "<br>―\ソ\\\表\予\能\申\十\構\貼\暴\欺\圭\噂\蚕\饅\箪\禄\兔\彌\<br><br>";

print "方法案  方法A案";
print '  方法A案<br>';
$a = 'A';
print "方法$a案";
print '  方法',"$a案<br><br>";

$data = '充分';
if ($data =~ /\Q充分\E/) {print '一致 ';} else {print '不一致 ';}
$a = '充';
if ($data =~ /\Q$a\E/) {print '一致 ';} else {print '不一致 ';}
if ($data =~ /\Q[\E/) {print '一致 ';} else {print '不一致 ';}
■実行結果
ャtト、Z[]、侮ヲ、嵐閨A迫ヘ、垂オ込み、助ェ、国「
ソフト、Z[\]、表示、予定、能力、申し込み、十分、構造
ソフト、Z[\]、表示、予定、能力、申し込み、十分、構造
予定表
―ソ\表予能申十構貼暴欺圭噂蚕饅箪禄兔彌

方法案  方毎ト  方法A案
方毎ト  方法A案

一致 一致 一致

サブルーチン
サブルーチンはsubで定義します。呼び出しは&を付けます。引数は配列@_に自動的に格納されます。
myは変数名をサブルーチン内だけで有効にします。
 例 &date(3,31);
   sub date {
     my($mon,$day) = @_;
     print "今日は$mon月$day日です。";
   }

サブルーチンの結果をreturn文で返すことができます。サブルーチンの実行はreturn文で終了します。
return文がない場合はサブルーチンの最後の式の値を返します。
 例 $data = &add;
   sub add {
     $a = 1 + 2;
     return $a;
   }
■プログラム (sample4.cgi)
&date1;
&date2(3,31);
$mon = 4; $day = 1; &date3(3,31); print "明日は$mon月$day日です。<br>";
$mon = 4; $day = 1; &date4(3,31); print "明日は$mon月$day日です。<br>";
$data = &add1; print "$data<br>";
$data = &add2; print "$data<br>";
###
sub date1 {print "今日は3月31日です。<br>";}
sub date2 {print "今日は$_[0]月$_[1]日です。<br>";}
sub date3 {($mon,$day) = @_; print "今日は$mon月$day日です。";}
sub date4 {my($mon,$day) = @_; print "今日は$mon月$day日です。";}
sub add1 {$a = 1 + 2; $b = 2 + 3; return $a;}
sub add2 {$a = 1 + 2; $b = 2 + 3;}
■実行結果
今日は3月31日です。
今日は3月31日です。
今日は3月31日です。明日は3月31日です。
今日は3月31日です。明日は4月1日です。
3
5

ファイル入出力
ファイルの入出力にはファイルハンドルを使います。
ファイルハンドルは入出力の対象となるファイルに付けた任意の名前で、Perl予約語と区別する為、英大文字にします。特別なファイルハンドルとして標準入力STDIN、標準出力STDOUTがあります。標準出力はブラウザになります。

open  ファイルハンドルを作成し、指定したファイルに関連付けます。
     出力の場合は > を付けます。追加書込みの場合は >> にします。
     ファイルを新規に作成する場合はファイルハンドルを出力用にオープンします。
      例 open IN,"data.txt";
        open OUT,">data.txt";
        open OUT,">>data.txt";
        open(IN,"data.txt") or die;
         → オープンに失敗すれば、その時点でプログラムの実行を強制終了します。
        open(IN,"data.txt") || &error("オープンできません");
         → オープンに失敗すれば &errorサブルーチンを実行します。

close  ファイルハンドルをクローズします。
      例 close IN; close OUT;

<xx> ファイルハンドルxxから行を読み込みます。
     whileの条件式に使うと読み込んだ行が自動的に$_に格納され、ファイルの終わりまで繰り返します。
      例 $data = <IN>;
        while (<IN>) {print $_;}

read  ファイルハンドルから、指定されたバイト長のデータを読み込みます。
      例 read(STDIN,$in,$ENV{'CONTENT_LENGTH'});

print  ファイルハンドルを指定してファイルに書き込みます。
     ファイルハンドルを省略すると標準出力STDOUTになります。引数を省略すると$_になります。
      例 print OUT $data;  print $data;  print;

unlink  ファイルを削除します。 例 unlink "data.txt";
rename ファイル名を変更します。 例 rename("data.txt","new.txt");
chmod  パーミッションを変更します。 例 chmod(0666,"data.txt");
-e    ファイル又はディレクトリが存在すれば真、存在しなければ偽になります。 例 if (-e "data.txt") { }
■プログラム (sample3.cgi)
open OUT,">data.txt"; print OUT "1234\n"; close OUT;
open IN,"data.txt"; $data = <IN>; close IN;
print "$data<br>";

open OUT,">>data.txt"; print OUT "ABCD\n"; close OUT;
open IN,"data.txt";
while (<IN>) {
chop;
print "$_<br>";
}
close IN;

rename("data.txt","new.txt");
if (-e "new.txt") {print "new.txtが存在します。<br>";} else {print "new.txtが存在しません。<br>";}
unlink "new.txt";
if (-e "new.txt") {print "new.txtが存在します。<br>";} else {print "new.txtが存在しません。<br>";}
open(IN,"new.txt") || &error("new.txtをオープンできません。"); close IN;
###
sub error {print "$_[0]</body></html>\n"; exit;}
■実行結果
1234
1234
ABCD
new.txtが存在します。
new.txtが存在しません。
new.txtをオープンできません。

ディレクトリの操作
ディレクトリの中にあるファイル名の読み出しにはディレクトリハンドルを使います。
ディレクトリハンドルは任意の名前で英大文字にします。

opendir ディレクトリハンドルを作成し、指定したディレクトリに関連付けます。
      例 opendir DATA,"data";
        opendir(DATA,"data") || &error("オープンできません");
         → オープンに失敗すれば &errorサブルーチンを実行します。

closedir ディレクトリハンドルをクローズします。
      例 closedir DATA;

readdir ディレクトリの中にあるファイル名を読み出します。但し、カレントディレクトリ「.」と上位ディレクトリ「..」を含みます。
      例 $file = readdir DATA; ファイル名を格納順に読み出します。
        @file = readdir DATA; 全ファイル名を@fileに読み込みます。

mkdir  ディレクトリを作成します。ディレクトリ名とパーミッションを指定します。
      例 mkdir("data",0666);
        mkdir("data",0666) || &error("ディレクトリを作成できません");

rmdir  ディレクトリを削除します。
      例 rmdir("data");
        rmdir("data") || &error("ディレクトリを削除できません");
■プログラム (sample17.cgi)
mkdir("data",0666) || &error("ディレクトリを作成できません");
if (-e "data") {print "dataディレクトリが存在します。<br>";} else {print "dataディレクトリが存在しません。<br>";}
open OUT,">data/data1.txt"; close OUT;
open OUT,">data/data2.txt"; close OUT;

opendir DATA,"data";
while ($file = readdir DATA) {print "$file ";}
closedir DATA;
print "<br>";

opendir(DATA,"data");
@file = readdir DATA;
foreach (@file) {print "$_ ";}
closedir DATA;
print "<br>";

unlink "data/data1.txt","data/data2.txt";
rmdir("data") || &error("ディレクトリを削除できません");
if (-e "data") {print "dataディレクトリが存在します。";} else {print "dataディレクトリが存在しません。";}
###
sub error {print "$_[0]</body></html>\n"; exit;}
■実行結果
dataディレクトリが存在します。
. .. data1.txt data2.txt 
. .. data1.txt data2.txt 
dataディレクトリが存在しません。

ファイルロック
 複数の人が同時に同一のファイルに対して読み書きを行なうと正常に書き込まれない場合があります。そこで、ファイルロックにより1人がファイルにアクセスしている間は他の人がそのファイルにアクセスできないようにします。ファイルロックの方法として、ファイルロック関数flock、シンボリックリンク関数symlink、ディレクトリ作成関数mkdirを使用する方法があります。flock、symlinkはサーバによっては使用できない場合があるので、ここではmkdirによる方法を記述します。
 この方法はディレクトリの有無がファイルアクセスの有無を表します。mkdirがディレクトリの存在チェックと生成を同時に行えることを利用しています。処理の流れを下記に示します。

 1.ファイルアクセスの前にmkdirを実行します。
 2.mkdirはディレクトリが存在しなければディレクトリを生成し「真」を返します。
   既にディレクトリが存在すると「偽」を返します。
 3.「真」の場合はファイルアクセスを行います。
 4.「偽」の場合はウェイト後リトライします。
   指定回数リトライしても「偽」の場合はタイムアウトで終了します。
 5.ファイルアクセスが終了したらディレクトリを削除します。


sleep 指定した秒数スリープする。
     例 sleep(2);
■プログラム (sample26.cgi)
$lockfile = 'lock';
$cntfile = 'sample26.txt';
&lock;
open IN,"$cntfile"; $count = <IN>; close IN;
$count++;
open OUT,">$cntfile"; print OUT $count; close OUT;
&unlock;
open IN,"$cntfile"; $count = <IN>; close IN;
print $count;
###
sub lock {
$retry = 5;
while (!mkdir($lockfile,0755)) {
if (--$retry < 0) {&error("タイムアウト");}
sleep(1);
}
}
sub unlock {rmdir($lockfile);}

sub error {
print "$_[0]</body></html>\n";
exit;
}
■実行結果
28

環境変数
環境変数はサーバからCGIプログラムへのデータ受け渡しに使われます。
これはサーバによって自動的にハッシュ%ENVに格納され、読み出しは$ENV{'CONTENT_LENGTH'}のように行います。フォームからのデータ入力やクッキーの受け渡しなどができます。主な内容を下表に示します。

環境変数内 容
CONTENT_LENGTHフォーム入力がPOSTの場合の入力データバイト数
CONTENT_TYPEデータの種類
GATEWAY_INTERFACEサーバのCGIバージョン
HTTP_COOKIEクッキーにセットされたデータ
HTTP_HOSTサーバ名
HTTP_REFERERCGIが呼び出されたページのURL
HTTP_USER_AGENTブラウザの情報
QUERY_STRINGフォーム入力がGETの場合の入力データ
REMOTE_ADDRクライアントのIPアドレス
REMOTE_HOSTクライアントのホスト名
REQUEST_METHOD入力方法の種類
SCRIPT_NAMECGIスクリプト名
SERVER_NAMEサーバ名
SERVER_SOFTWAREサーバソフトウエア名

下記のプログラムは環境変数の一覧を表示します。
■プログラム (sample20.cgi)
print "<center><b>環境変数</b><table border=1 cellspacing=0 cellpadding=1>\n";
foreach (sort keys %ENV) {
print "<tr><td nowrap>  $_</td><td>  $ENV{$_}</td></tr>\n";
}
print "</table></center>\n";
■実行結果
環境変数
  DOCUMENT_ROOT  /home/merlion/public_html
  GATEWAY_INTERFACE  CGI/1.1
  HTTP_ACCEPT  image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*
  HTTP_ACCEPT_ENCODING  gzip, deflate
  HTTP_ACCEPT_LANGUAGE  ja
  HTTP_CONNECTION  Keep-Alive
  HTTP_COOKIE  sample=太郎,東京; bbs=管理者,#800000
  HTTP_HOST  merlion.cool.ne.jp
  HTTP_USER_AGENT  Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)
  PATH  /usr/local/bin:/usr/bin:/bin
  QUERY_STRING 
  REMOTE_ADDR  210.249.200.249
  REMOTE_PORT  1799
  REQUEST_METHOD  GET
  REQUEST_URI  /cgi/_study/sample20.cgi
  SCRIPT_FILENAME  /home/merlion/public_html/cgi/_study/sample20.cgi
  SCRIPT_NAME  /cgi/_study/sample20.cgi
  SERVER_ADDR  211.13.208.196
  SERVER_NAME  merlion.cool.ne.jp
  SERVER_PORT  80
  SERVER_PROTOCOL  HTTP/1.1
  SERVER_SOFTWARE  Apache/1.3.26 (Unix)

ホスト名の取得
IPアドレスは環境変数$ENV{'REMOTE_ADDR'}で取得できます。しかし、ホスト名はDNSサーバ問合せの負荷がかかる為、環境変数$ENV{'REMOTE_HOST'}では取得できない場合が多いようです。
そこで、IPアドレスからホスト名を取得するにはgethostbyaddrを使います。

gethostbyaddr IPアドレスに対応するホスト名を取得します。
         例 $host = gethostbyaddr(pack('C4',split(/\./,$addr)),2);
             pack'C4':char値4個の引数によるバイナリデータ
             $addr: IPアドレス
              2 : インタ−ネットIPプロトコル(IPv4)の指定
■プログラム (sample27.cgi)
$addr = $ENV{'REMOTE_ADDR'};
$host = gethostbyaddr(pack('C4',split(/\./,$addr)),2);
print "$addr<br>$host";
■実行結果
210.249.201.242
a02-242.ip-tokyo.highway.ne.jp

ヘッダー
■HTTPヘッダー
 HPを表示する際、サーバからブラウザへHTTPヘッダーが送信されます。
 CGIが出力する主なヘッダーを下記に示します。

 Content-type: text/html  HTML文書(参照「基本」)
 Content-type: image/gif  GIF画像(参照「画像出力」)
 Content-type: image/jpeg JPEG画像
 Set-Cookie: name=data; expires=wdy, DD-Mon-YYYY HH:MM:SS GMT  クッキー保存(参照「クッキーの使い方」)
 Location: url        urlページのリロード


■METAタグ
 HTMLのMETAタグでHTTPヘッダーを補完することができます。
 METAタグは<head>と</head>の間に記述します。(注)<>は半角で記述します。

 <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=Shift_JIS"> シフトJIS文字コードを指定
 <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=EUC-JP"> EUC文字コードを指定
 <META HTTP-EQUIV="Set-Cookie" CONTENT="name=data; expires=wdy, DD-Mon-YYYY HH:MM:SS GMT">
 <META HTTP-EQUIV="Refresh" CONTENT="t; URL=url">  t秒後にurlページをリロード

データの入力
フォームからデータを入力して表示します。受け渡しの情報は環境変数%ENVに自動的に格納されます。
フォームからの入力方法にはGETとPOSTがあり下記の特徴があります。
GETかPOSTかは入力のformタグのmethodで指定し、環境変数REQUEST_METHODに格納されます。
methodを指定しない場合はGETになります。
 GET
  ・フォーム入力データは送り先のURLの後に?を付けて渡される。 xxx.cgi?xx=xx&xx=xx・・・
  ・フォームだけではなくリンクタグでデータを簡単に渡すことができる。
  ・入力データは環境変数QUERY_STRINGに格納される。
  ・環境変数に格納できるデータ長が限定される。
  ・入力データがURLで表示されるので内容が分かってしまう。
 POST
  ・入力データは標準入力STDINに格納される。
  ・データ長が環境変数CONTENT_LENGTHに格納される。
  ・大量のデータを送ることができる。
  ・入力データはURLに表示されない。

フォームから入力されたデータは下記のようにURLエンコードされます。
その為、入力データを表示するにはデコードして元に戻す必要があります。
 ・「名前=値」で一対にします。
 ・複数の対は&で区切ります。(名前=値&名前=値)
 ・空白は「+」に変換します。
 ・日本語文字コードは%に続いて16進数2桁で表します。(英数字はそのまま表します)

read(STDIN,$in,$ENV{'CONTENT_LENGTH'});  標準入力STDINからデータを読み取る。
($name,$data) = split(/=/,$in);          入力されたデータ「word=データ」をsplitで分離する。
$data =~ tr/+/ /;                  trで「+」を空白に変換する。
$data =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;  文字コードを日本語に変換する。
■プログラム (sample2.cgi)
if ($ENV{'REQUEST_METHOD'} eq "POST") {read(STDIN,$in,$ENV{'CONTENT_LENGTH'});}
else {$in = $ENV{'QUERY_STRING'};}
($name,$data) = split(/=/,$in);
$data =~ tr/+/ /;
$data =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

print "<form action=\"sample2.cgi\" method=POST>\n";
print "<input type=text size=30 name=word> <input type=submit value=\"POST入力\"></form>\n";
print "<form action=\"sample2.cgi\">\n";
print "<input type=text size=30 name=word> <input type=submit value=\"GET入力\"></form>\n";
print "<a href=\"sample2.cgi?word=太郎\">アンカータグによる入力</a><br><br>\n";
print "データ: $data";
■実行結果


アンカータグによる入力

データ: 太郎

複数データの入力
いろいろなフォーム形式から複数のデータを入力します。
@pair = split(/&/,$in);  複数のデータ対を&で分離して@pairに格納します。
$in{$n} = $val;       データの名前$nをキーにしてデータ値$valをハッシュ%inに格納します。
■プログラム (sample18.cgi)
if ($ENV{'REQUEST_METHOD'} eq "POST") {read(STDIN,$in,$ENV{'CONTENT_LENGTH'});}
else {$in = $ENV{'QUERY_STRING'};}
@pair = split(/&/,$in);
foreach (@pair) {
($n,$val) = split(/=/);
$val =~ tr/+/ /;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$in{$n} = $val;
}
$alf = $in{'alf'};
$num = $in{'num'};
$sub = $in{'sub'};
$pwd = $in{'pwd'};

print "<form action=\"sample18.cgi\" method=POST>\n";
print "<select name=alf>";
foreach (A .. G) {
if ($alf eq $_) {$sel = ' selected';} else {$sel = '';}
print "<option value=\"$_\"$sel>$_";
}
print "</select>\n";
foreach (1 .. 5) {
if ($num eq $_) {$chk = ' checked';} else {$chk = '';}
print "<input type=radio name=num value=\"$_\"$chk>$_ \n";
}
print "<br><input type=text name=sub size=30 value=\"$sub\"><br>\n";
print "<input type=password name=pwd size=10 maxlength=8 value=\"$pwd\"><br>\n";
print "<input type=submit value=\"入力\"></form>\n";
print "$in<br>$alf $num<br>$sub<br>$pwd\n";
■実行結果
1 2 3 4 5 




alf=B&num=2&sub=%91%BE%98Y&pwd=taro
B 2
太郎
taro

cgi-lib.pl による入力
cgi-lib.pl はフォーム入力データのデコードなどを処理するライブラリです。
 &ReadParse; cgi-lib.plでデコード処理を行うサブルーチンです。
         フォーム入力データの名前をnameとするとデータは$in{'name'}に格納されます。
         複数選択できる「チェックボックス」の場合は各値が「\0」で区切られて格納されます。

require ライブラリを読み込みます。
      例 require './cgi-lib.pl';
■プログラム (sample23.cgi)
require './cgi-lib.pl';
&ReadParse;
$alf = $in{'alf'};
$sub = $in{'sub'};
@num = split(/\0/,$in{'num'});
foreach (@num) {$num{$_} = 1;}

print "<form action=\"sample23.cgi\" method=POST>\n";
print "<select name=alf>";
foreach (A .. G) {
if ($alf eq $_) {$sel = ' selected';} else {$sel = '';}
print "<option value=\"$_\"$sel>$_";
}
print "</select>\n";
foreach (0 .. 4) {
if ($num{$_}) {$chk = ' checked';} else {$chk = '';}
print "<input type=checkbox name=num value=\"$_\"$chk>$_ \n";
}
print "<br><input type=text name=sub size=30 value=\"$sub\"><br>\n";
print "<input type=submit value=\"入力\"></form>\n";
print "$in<br>$alf @num<br>$sub\n";
■実行結果
0 1 2 3 4 



alf=C&num=0&num=1&num=3&sub=%91%BE%98Y
C 0 1 3
太郎

乱数発生
乱数を発生させるにはrandを使います。

rand 0から引数の範囲で乱数を発生します。乱数は小数点以下を含みます。
   引数を省略すると0〜1の範囲になります。
    例 $data = rand(10);
      $data = int(rand(5));

srand randで生成する乱数の種をセットします。但し、最近のPerlでは不要のようです。
    例 srand;
■プログラム (sample22.cgi)
srand;
foreach (0 .. 4) {
$data = rand(10);
print "$data<br>";
}
■実行結果
9.02130126953125
1.7193603515625
5.047607421875
2.56744384765625
7.177734375

暗号化
パスワードなどの文字列を暗号化するにはcryptを使います。

crypt 暗号化の種を使って文字列を暗号化します。種は任意の英数字2文字を指定します。
    暗号化された文字列の先頭2文字は種になります。尚、復号化はできません。

    例 $pass = crypt('1234','ab'); ←パスワード1234を種abで暗号化する。

      パスワードの照合は、入力されたパスワードを同じ種で暗号化して照合します。
      下記で、cryptは$passの先頭2文字を自動的に読み取ります。
       if (crypt($inpass,$pass) eq $pass) { }
■プログラム (sample21.cgi)
$pass = crypt('1234','ab');
print "$pass<br>";

if (crypt('1234',$pass) eq $pass) {print "一致しました。<br>";} else {print "一致しません。<br>";}
if (crypt('0123',$pass) eq $pass) {print "一致しました。<br>";} else {print "一致しません。<br>";}
■実行結果
abWMpd9uBwR.g
一致しました。
一致しません。

グラフ表示
グラフを表示します。グラフの長さは画像の表示幅で指定します。

@data = (98,78,52); データを配列に用意します。
$w = int($_ * 3);  グラフの長さを調整します。
■プログラム (sample5.cgi)
@data = (98,78,52);
print "<table>";
foreach (@data) {
$w = int($_ * 3);
print "<tr><td>$_</td><td><img src=\"red.gif\" width=$w height=10></td></tr>\n";
}
print "</table>";
■実行結果
98
78
52

日時の表示
日時を表示します。

time  1970年1月1日から現在までの秒数を表します。
     例 $nowtime = time;

localtime time形式の時間をローカル時間に変換します。
     例 ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);
         $time:time形式の時間。省略した場合はtimeになります。
         $sec:秒
         $min:分
         $hour:時
         $mday:日
         $mon:月(0〜11で1〜12月を表す)
         $year:年(1900年を基準にして経過した年を表す)
         $wday:曜日(0〜6で日〜土を表す)

      ローカル時間は下記にて設定できます。localtimeを使用する前に設定します。
         $ENV{'TZ'} = "JST-9"; ←日本の場合、時差9時間

gmtime  time形式の時間をグリニッジ標準時間に変換します。変換形式はlocaltimeと同様です。
■プログラム (sample6.cgi)
@week = ('日','月','火','水','木','金','土');
$ENV{'TZ'} = "JST-9";
$nowtime = time;
($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime;
$year += 1900;
$mon++;
print "$nowtime<br>";
printf("$year年$mon月$mday日($week[$wday]) %2d:%02d 現在",$hour,$min);

($mday,$mon) = (localtime(time + 24*60*60))[3,4];
$mon++;
print "<br>明日は$mon月$mday日です。";
■実行結果
1049281850
2003年4月2日(水) 20:10 現在
明日は4月3日です。

クッキーの使い方
クッキーはデータをブラウザ側に保存して読み出す機能です。
例えば、掲示板で一度入力したデータを自動的に表示する場合などに使われます。

<クッキーの保存>
 クッキーはデータ書き込み時に保存します。
 クッキーをブラウザ側へ保存するには、下記のSet-Cookieというヘッダー情報を記述します。
 この情報はヘッダーの区切りを示す空行の前に出力しなければなりません。
  Set-Cookie: name=data; expires=date;
     name データを区別する為に任意の名前を付けます。
     data 保存するデータ
     date クッキーの有効期限を下記のように記述します。
       wday, mday-mon-year hour:min:sec GMT  (例) Sun, 02-Apr-2003 12:00:00 GMT
        wday:曜日 Sun,Mon,Tue,Wed,Thu,Fri,Sat
        mday:日 01〜31
        mon :月 Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec
        year :西暦年
        hour:時 00〜23
        min :分 00〜59
        sec :秒 00〜59
       GMTはグリニッジ標準時間を表します。

<クッキーの読み出し>
 クッキーは複数のCGIからのデータが環境変数HTTP_COOKIEに自動的にセットされます。
 複数のクッキーはHTTP_COOKIEに下記のように「; 」で区切られてセットされます。
   name=data; name=data; ・・・
 CGIでその環境変数を読み出し、クッキーを保存した時の名前のデータを取り出します。
 但し、データ書き込み時はその書き込みデータをクッキーとする必要があります。
 これは、環境変数はCGIを実行する前にセットされている為です。
■プログラム (sample19.cgi)
#!/usr/bin/perl
@pair = split(/&/,$ENV{'QUERY_STRING'});
foreach (@pair) {
($n,$val) = split(/=/);
$val =~ tr/+/ /;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$in{$n} = $val;
}
$mode = $in{'mode'};
if ($mode eq 'reg') {&setcook;}
print "Content-type: text/html\n\n";
print "<html><body>\n";
&getcook;
print "<form action=\"sample19.cgi\">\n";
print "<input type=hidden name=mode value=\"reg\">\n";
print "<input type=text size=30 name=data1 value=\"$data1\"><br>\n";
print "<input type=text size=30 name=data2 value=\"$data2\"><br>\n";
print "<input type=submit value=\"入力\"></form>\n";
print "$data1<br>$data2";
print "</body></html>\n";
exit;
###
sub setcook {
my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+30*24*60*60);
$wday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday];
$mon = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
$expire = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$wday,$mday,$mon,$year+1900,$hour,$min,$sec);
$cook = "$in{'data1'},$in{'data2'}";
print "Set-Cookie: sample=$cook; expires=$expire;\n";
}
sub getcook {
my($n,$val,@pair);
@pair = split(/;\s*/,$ENV{'HTTP_COOKIE'});
foreach (@pair) {($n,$val) = split(/=/); $cook{$n} = $val;}
($data1,$data2) = split(/,/,$cook{'sample'});
if ($mode eq 'reg') {$data1 = $in{'data1'}; $data2 = $in{'data2'};}
}
■実行結果



太郎
東京

曜日の求め方
年月日を指定して曜日を求めるプログラムです。
ツェラーの公式を使って西暦年月日から曜日を算出します。
この公式は、1月と2月を前年の13月、14月として計算します。算出結果は 0〜6で、日〜土を表します。
■プログラム (sample7.cgi)
@week = ('日','月','火','水','木','金','土');
$wday = &date(2003,3,22);
print "2003年3月22日は$week[$wday]曜日です。";

###
sub date {
my($y,$m,$d,$w);
($y,$m,$d) = @_;
if ($m < 3) {$y--; $m += 12;}
$w = ($y+int($y/4)-int($y/100)+int($y/400)+int((13*$m+8)/5)+$d)%7;
}
■実行結果
2003年3月22日は土曜日です。

カレンダーの作成
年月を指定してカレンダーを作成します。

&calendar(2003,3); サブルーチンを呼び出します。引数は年月です。
@mdays は1〜12月の各日数です。
if ($mon == 2 && $year % 4 == 0) {$mdays = 29;} うるう年を判定します。
&date($year,$mon,1);  指定された年月の1日の曜日を算出します。
$wは曜日、$kは日付を表します。
■プログラム (sample8.cgi)
print "<center>";
&calendar(2003,3);
print "</center>";
###
sub calendar {
($year,$mon) = @_;
@week = ('日','月','火','水','木','金','土');
@mdays = (31,28,31,30,31,30,31,31,30,31,30,31);
$mdays = $mdays[$mon - 1];
if ($mon == 2 && $year % 4 == 0) {$mdays = 29;}
print "$year年$mon月\n";
print "<table border=1 cellspacing=0 cellpadding=3><tr>";
foreach (0 .. 6) {print "<td>$week[$_]</td>";}
print "</tr>\n";

&date($year,$mon,1);
$w = 0;
$k = 1;
for ($i=0; $i<42; $i++) {
if (!$w) {print "<tr align=center>";}
if ($wday <= $i && $k <= $mdays) {print "<td>$k</td>"; $k++;} else {print "<td> </td>";}
$w++;
if ($w == 7) {print "</tr>"; if ($mdays < $k) {last;} $w = 0;}
}
print "</table>\n";
}
###
sub date {
($y,$m,$d) = @_;
if ($m < 3) {$y--; $m += 12;}
$wday = ($y+int($y/4)-int($y/100)+int($y/400)+int((13*$m+8)/5)+$d)%7;
}
■実行結果
2003年3月
      1
2345678
9101112131415
16171819202122
23242526272829
3031     

画像出力
CGIがGIF画像を直接出力して表示します。
HPからは下記のようにIMGタグでCGIを起動できます。
 <IMG SRC="sample24.cgi">

HTTPヘッダーは下記のようにGIFを指定します。
 print "Content-type: image/gif\n\n";

binmode ファイルハンドルに対してバイナリモードを指定します。
      例 binmode IMG;
        binmode STDOUT; 標準出力をバイナリモードにします。標準出力はブラウザになります。
■プログラム (sample24.cgi)
#!/usr/bin/perl
print "Content-type: image/gif\n\n";
open IMG,"banner.gif";
binmode IMG;
binmode STDOUT;
print <IMG>;
close IMG;
exit;
■実行結果

GIF画像の連結
GIF画像を連結するにはgifcat.pl を使います。これは、杜甫々氏によるフリーソフトライブラリです。
同じ大きさの複数の画像を横方向に並べます。カウンタの表示に利用すると便利です。

 例 require 'gifcat.pl';
   binmode(STDOUT);
   print &gifcat'gifcat("1.gif","2.gif","3.gif");
■プログラム (sample28.cgi)
#!/usr/bin/perl
require 'gifcat.pl';
print "Content-type: image/gif\n\n";
$count = 1234567890;
foreach (0 .. 9) {
$img = substr($count,$_,1);
push (@img,"$img.gif");
}
binmode(STDOUT);
print &gifcat'gifcat(@img);
exit;
■実行結果

画像アップロード
JPG画像をアップロードします。画像入力にcgi-lib.plライブラリを利用します。
formタグで enctype="multipart/form-data"を指定します。
画像入力のinputタグで type=file を指定します。
$in{'img'}    画像の入力データです。&ReadParseによってデータがセットされます。
&img("pic");  画像ファイル名をpicとしてimgサブルーチンを呼び出します。
if ($in[0] =~ /Content-Type: image\/.*jpeg/i) {
 JPG画像の判定です。&ReadParseによって@inにフォーム入力の情報がセットされます。
■プログラム (sample9.cgi)
require './cgi-lib.pl';
&ReadParse;
print "<form action=\"sample9.cgi\" method=POST enctype=\"multipart/form-data\">\n";
print "<input type=file name=img size=60> <input type=submit value=\"アップロード\"></form>\n";
if ($in{'img'}) {
&img("pic");
print "<img src=\"pic.jpg\">";
}
###
sub img {
if ($in[0] =~ /Content-Type: image\/.*jpeg/i) {
open OUT,">$_[0].jpg";
binmode OUT;
print OUT $in{'img'};
close OUT;
}
}
■実行結果
 

HOME Copyright (C) CGI-design All Rights Reserved.