if (EXPR) BLOCK
if (EXPR) BLOCK else BLOCK
if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
unless (EXPR) BLOCK
unless (EXPR) BLOCK else BLOCK
unless (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
LABEL while (EXPR) BLOCK
LABEL while (EXPR) BLOCK continue BLOCK
LABEL until (EXPR) BLOCK
LABEL until (EXPR) BLOCK continue BLOCK
LABEL for (EXPR; EXPR; EXPR) BLOCK
LABEL foreach VAR (LIST) BLOCK
LABEL foreach VAR (LIST) BLOCK continue BLOCK
LABEL BLOCK continue BLOCK
EXPR は「条件」として参照されます。 その真偽値が修飾子の振る舞いを決定します。
下記は、UTF8以外の文字で書かれたスクリプトの場合で
フラグ付きUTF8を使用する場合、
use Encode qw/ from_to decode encode /;#// utf8用(decodeファイル読みencode書込)
open (IN,$outlog) || die "open error $outlog $!";
@datax=<IN>; #//euc-jpで書かれたファイル
close IN;
foreach ( @datax ) {
next if($_ =~ m/^\x23/); #//comment delete
$jj=decode("euc-jp", $_); #//euc-jpからutf8に変換(F付)
$jj=encode("shiftjis", $jj); #//utf8からshiftjisへ変換
print ("$jj\n");
} |
フラグ付きUTF8を使用しない場合、
use Encode qw/ from_to decode encode /;#// utf8用(decodeファイル読みencode書込)
open (IN,$outlog) || die "open error $outlog $!";
@datax=<IN>; #//euc-jpで書かれたファイル
close IN;
foreach ( @datax ) {
next if($_ =~ m/^\x23/); #//comment delete
from_to($_,'euc-jp','shiftjis'); #//UTF8フラグなし文字変換(euc-jpからshiftjisへ変換)
print ("$_\n");
} |
ファイルへの出力、次のように一度UTF8に変換してから希望のコードで書き出す。
ただし、UTF8からUTF8へは多重になるので変換しない。その代わりUTF8フラグなしにする。
$jj=decode("euc-jp", $_); #//フラグ付きUTF8
#open(OUT, ">:encoding(shiftjis)", "$filename"); #//sjisに変換
#open(OUT, ">:encoding(euc-jp)", "$filename"); #//eucに変換
#open(OUT, ">:encoding(jis)", "$filename"); #//jisに変換
open(OUT, ">:utf8", "$filename"); #utf8で出力(utf8フラグなし)
print OUT $jj;
close OUT;
または
open(OUT,">$filename");
binmode OUT,":encoding(jis)";
print OUT,$jj;
close OUT; |
注意:utf8 フラグ付きのマルチバイト文字列をそのまま出力(print)しようとすると警告がでます。(Wide charactor error..)
注意:utf8 フラグ付きでは、length($str_utf8) は、正常にカウントされる。フラグなしでは、バイト数としてカウントされる。正規表現も正常に機能する。
use utf8; を使う場合、つぎの様に入出力およびエラー出力コードを指定する。
特に、これを指示しないとprint の場合、Wide charactor error.. になります。
use utf8; #//このスクリプトはutf8で書いていますという意味
my $charset = 'utf8'; #//このスクリプトはutf8の指示
my $outchar = 'utf8';
my $inpchar = 'utf8';
binmode STDOUT, ":utf8" if($outchar eq 'utf8'); #//フラグを外してから出力
binmode STDERR, ":utf8" if($outchar eq 'utf8'); #//フラグを外してから出力
binmode STDIN, ":utf8" if($inpchar eq 'utf8'); #//フラグを外したまま入力
$str = "こんいちは"; #//フラグ付き文字列
$encode =$outchar;
$fromcode=$charset;
if($encode && lc($encode) ne lc($fromcode)){#//同じコードでない場合
Jcode::convert(\$str, lc($encode),lc($fromcode)); #//指定の日本語コードに変換
}
print $str; #//stdoutでフラグ外して出力 |
ファイルへの入出力は、UTF8の文字変換を参照してください。
#//WEBからの取り込み(STDINからUTF8フラグなしで)
if ($ENV{'REQUEST_METHOD'} eq "POST"){read(STDIN, $buf,$ENV{'CONTENT_LENGTH'});}
else { $buf = $ENV{'QUERY_STRING'}; }
foreach ( split(/&/, $buf) ) {
($key, $val) = split(/=/);
$val =~ tr/+/ /;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2', $1)/eg;
utf8::decode($val); #//UTF8フラグををつける
$in{$key} = $val;
} |
SHIFTJISのクッキーまたはファイルを取得した場合は内部コード(UTF8フラグ付き)に変換する
UTF8のINPUTデーター、クッキーまたはファイルを取得した場合は内部コード(UTF8フラグ付き)に変換する
use utf8; #//スクリプトはUTF8で書いてます
use CGI::Carp qw(fatalsToBrowser);
use Encode qw(from_to encode decode);
binmode STDOUT, ':utf8'; #//内部コードをUTF8に変換
binmode STDERR, ':utf8'; #//内部コードをUTF8に変換
binmode STDIN, ':utf8'; #//UTF8コードを内部コードに変換
use strict;
use warnings;
use Data::Dumper; #for use utf-8用
{
package Data::Dumper;
sub qquote {return shift;}
}
$Data::Dumper::Useperl = 1;
------------------------------------------------------------
#//各内部コードへの変換
@array_item = map{decode('shiftjis', $_) } @array_item; #//Shiftjisを内部コードに変換
@array_item = map{encode('shiftjis', $_) } @array_item; #//内部コードをShiftjisに変換
utf8::decode($msg1); #//UTF8を内部コードに変換
utf8::encode($msg1); #//内部コードをUTF8に変換
#//POSTとGETメソッドの両方からの入力 %keyss
my %keyss = map{$_,decode('utf-8',$keyss{$_})} keys %keyss;#//UTF8フラグなしを内部コードに変換
my $msg3=&get_gengou2('2015');#// 返値:"平成27年"この関数のスクリプトコードはEUCです。
$msg3=decode('euc-jp',$msg3);#// EUC-JPを内部コードに変換
#//ファイルへの入出力はSHIFJISのみなら
use open ":encoding(shiftjis)"; #//すべての入出力ファイルはSJIS指定
#//そのあとの個別指定
open(my $fh, ">:encoding(UTF-8)", "filename");
close($fh);
#//内部コードでなかったら内部コードに変換
my $utf8 = Encode::is_utf8($bytes) ? $bytes : decode_utf8($bytes);
|
BOM付とBOM付き出ないでない文字コード(UTF8)他にもあるが。
−(全角ハイフン)のコードは、
jis(215D),EUC(A1DD),SJIS(817C)-->BOM付き(EFBC8D) BOMなし(E28892)
〜(全角チルダ)(波ダッシュ)のコードは、
jis(2141),EUC(A1C1),SJIS(8160)-->BOM付き(EFBD9E:全角チルダ) BOMなし(E3809C:波ダッシュ)
Windowsでは、(全角チルダ:EFBD9E)が採用されている。
BOMは、文字の最初に、またはUTF8ファイルの最初に、(EFBBBF)が記入されている。
スクリプトはBOMなしでの保存が望ましい。
データは、入力の時はBOMなしを想定して、出力時は、BOMなしで書き出される。
PERLでの変換
$line = jcode($line, $read_code)->h2z->utf8;
$line =~ s/\xE2\x88\x92/\xEF\xBC\x8D/g; #// ハイフン
$line =~ s/\xE3\x80\x9C/\xEF\xBD\x9E/g; #// チルダ |
UTF-8で符号されたテキストデータはエンディアン(メモリーに記憶するときの羅列方法)に関わらず同じ内容になるので、UTF-8で符号化されていることが確定しているのならバイトオーダーマーク (英: Byte Order Mark。以下BOM) を付加する必要はない。しかし、一部のテキスト処理アプリケーション (エディタなど) では、作成したテキストデータの先頭にBOMを付加する (付加するかどうかを選択できるものもある)。付加する場合は、EF BB BF (16進。U+FEFFのUTF-8での表現) をデータの先頭に付加する。なお、BOMありの方をUTF-8、なしの方をUTF-8Nと呼ぶこともあるが、このような呼び分けは日本以外ではほとんど知られておらず、また公的規格などによる裏付けもない。このため、UTF-8という呼び名を使っていれば情報交換の相手が文書先頭にBOMがあると見なすと期待すべきではないし、いっぽう、UTF-8Nという呼び名は情報交換の際に用いるべきではない。
$url = "http://abc/foo.com?m=84&po=567";
$url =~ s/&/\^&/g;
system("start $url"); |
use LWP::Simple;
$url="http://abc/foo.com?m=84&po=567"
$str1 = LWP::Simple::get("$url") or die "cannot get content from $url"; |
#// LOCALHOST の場合、'localhost'を返す
my $httphost = $ENV{'HTTP_HOST'};
$httphost ="" unless($httphost); |
次のCGIスクリプトを
print "Content-type: text/plain\n\n";
print "ARGV--------------------------\n";
my $ii=0;
foreach (@ARGV) {
print "($ii)$_\n";
$ii++;
} |
DOS画面で実行した結果
C:\>perl testargcv.cgi key1=value1^&key2=value2^&key2=value3 w tt^&hhd^&ttt
Content-type: text/plain
ARGV--------------------------
(0)key1=value1&key2=value2&key2=value3
(1)w
(2)tt&&hhd&ttt
|
ブラウザーで実行した結果
http://hoge.com/testargcv.cgi?key1=value1&key2=value2&key2=value3+w tt&hhd&ttt
ARGV--------------------------
(0)key1=value1&key2=value2&key2=value3
(1)w
(2)tt&hhd&ttt
|
ARGVからハッシュに変換(ブラウザー&DOS両方から引数を得ることができます)
my (@tt,@tt1,%tt);
foreach (@ARGV) {
@tt1 = map{if(m/([^=]+)=+(.+)/){($1,$2)}else{s/=+//g;($_,undef);}}split(/&/,$_);
@tt = (@tt,@tt1);
}
%tt = @tt;
print Data::Dumper->Dump( [\%tt],[qw(*tt)]),"\n"; |
ブラウザー、DOSで実行した結果
http://hoge.com/testargcv.cgi?key1=value1&key2=value2&key2=value3+w tt&hhd&ttt
C:\>perl testargcv.cgi key1=value1^&key2=value2^&key2=value3 w tt^&hhd^&ttt
%tt = (
'w' => undef,
'key2' => 'value3',
'ttt' => undef,
'key1' => 'value1',
'hhd' => undef,
'tt' => undef
);
|
次のCGIスクリプトを
use CGI;
my $query = new CGI; #//この時点でPOST/GET,Cookie取得を行う
print "KEY---hash-------------------\n";
my %keys;
%keys= $query->Vars; # 全てのパラメータ名取得(perl5以上)
$ii=0;
foreach (keys %keys){
$keys{$_}=~ s/\0/|/g;
print "($ii)$_ -> $keys{$_}\n";
$ii++;
}
print "KEY2-------------------------\n";
$ii=0;
my @jj=$query->param('key2');
foreach (@jj){
$_=~ s/\0/|/g;
print "($ii)$_\n";
$ii++;
}
print "KEY---param-------------------\n";
$ii=0;
foreach ($query->param()){
my $a=$query->param($_); # パラメータ値取得
$a=~ s/\0/|/g;
$keys{$_}=$a; #//Varsに習って%keysに格納する
print "($ii)$_ [$a]\n";
$ii++;
} |
DOS画面で実行した結果(空白で区切、その後&で区切られている)
C:\>perl testargcv.cgi key1=value1^&key2=value2^&key2=value3 w tt^&hhd^&ttt
Content-type: text/plain
KEY----Hash-------------------
(0)w ->
(1)key2 -> value2|value3
(2)ttt ->
(3)key1 -> value1
(4)hhd ->
(5)tt ->
KEY2--------------------------
(0)value2
(1)value3
KEY--param--------------------
(0)key1 [value1]
(1)key2 [value2]
(2)w []
(3)tt []
(4)hhd []
(5)ttt []
KEY---array-------------------
(0)key1
(1)value1
(2)key2
(3)value2|value3
(4)w
(5)
(6)tt
(7)
(8)hhd
(9)
(10)ttt
(11)
|
ブラウザーで実行した結果(&で区切られている)
http://hoge.com/testargcv.cgi?key1=value1&key2=value2&key2=value3+w tt&hhd&ttt
KEY---- Hash-----------------
(0)key2 -> value2|value3 w tt
(1)ttt ->
(2)key1 -> value1
(3)hhd ->
KEY2-------------------------
(0)value2
(1)value3 w tt
KEY--param--------------------
(0)key1 [value1]
(1)key2 [value2]
(2)hhd []
(3)ttt []
KEY---array-------------------
(0)key1
(1)value1
(2)key2
(3)value2|value3 w tt
(4)hhd
(5)
(6)ttt
(7)
|
補足 実用スクリプト
#//C:\>perl testargcv.cgi key1 key2 key3 のようにキーのみで値がひとつもない場合
#//次の様に'keyword'のhashキーに格納されます。
#//それを %keyss に改めて分けて格納しています。
my $q = new CGI; #//この時点でPOST/GET,Cookie取得を行う
my %keyss= $q->Vars;
if (exists $keyss{'keywords'}){
foreach (split(/\0/,$keyss{'keywords'})){
$keyss{$_}="";
}
}
#//
#// param() の場合処理
#//
my %keyss;
foreach ($q->param()){
if ($_ eq 'keywords'){
foreach ($q->param($_)){
$keyss{$_}="";
}
}else{
my $a=$q->param($_); # パラメータ値取得
$a=~ s/\0/|/g;
$keyss{$_}=$a; #//Varsに習って%keyssに格納する
}
} |
次のCGIスクリプトを(モジュールも使わない場合)環境変数$ENV{'QUERY_STRING'}使う
print "KEY3-------------------------\n";
# query の取得
if (exists $ENV{'REQUEST_METHOD'} and $ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
else {
$buffer = exists $ENV{'QUERY_STRING'} ? $ENV{'QUERY_STRING'}:"";
}
# query の分解
my ($name, $value);
my %in;
foreach my $pair (split(/&/,$buffer)) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
if(exists $in{$name}){ $in{$name} .= "\t".$value; }
else{ $in{$name} = $value;}
}
$ii=0;
foreach (keys %in){
print "($ii)$_ [$in{$_}]\n";
$ii++;
} |
ブラウザーで実行した結果
http://hoge.com/testargcv.cgi?key1=value1&key2=value2&key2=value3+w tt&hhd&ttt
KEY3-------------------------
(0)key2 [value2\tvalue3 w tt]
(1)ttt []
(2)key1 [value1]
(3)hhd []
|
DOS画面で実行した結果では何も出ない
@ARGV を使って取り込む必要有り
次のスクリプトです。
use Term::ReadKey;
while(1){
print("処理中止は3秒以内にいずれかのキーを押します。");
my $char = ReadKey(3);
last if defined $char;
....
} |
Readkeyの引数は、
0:改行キー待ち
-1:キー待ちなし
>0:指定時間
配列にリスト値を代入、参照、配列の箱中身を要素(Element)といいます。配列の箱番号を要素番号(Index)といいます。
展開とは、変数名($dat1)の内容を代入することです。展開できないことは、$dat1がそのまま代入されます。
リファレンスとは、配列箱の住所です。配列箱は長屋(家)全体です。配列箱番号は、長屋の各部屋番号(0からはじまる)です。
配列名(配列箱)は、長屋の家の名前(はなまる荘)
#//いくつかの文字列を()で括るとリストになり、それに名前をつけると配列名、
#//リストの始まりから番号を暗黙的に0から付けるとその呼び名は要素[部屋]番号、その内容は要素です
#//リストの集まりは配列だから、(split(',',"1,2,3,asdcf"))[3] という使い方もできます。 結果'asdcf'
#// 同様に qw(1, 2, 3, asdcf)[3] 結果 'asdcf'
#// 同様に配列にはできない、リストでは (@{ [1,2,3,"asdcf"] })[1,3]ができます。結果 '2','asdcf'
@array = (); #//空リストは配列の中身を空にします。
@array = (1, 2, 3, "asdcf",$dat1, $dat2); #//カンマで区切らてた内容の羅列をそれぞれの配列の箱に代入します。
@array = qw(1 2 3 asdcf); #//qw 演算子は空白で区切ってリストを返す。展開できない
$fog0 = $array[0]; #//部屋番号0の値(中身)を代入します。
$fog1 = $array[1];
$refarray = \@array; #//リファレンス
$fog2 = $refarray->[2]; #//住所->部屋番号2の中身を代入します。
@array2 = @array; #//配列全体のコピー複写
push(@array2,@array1); #//配列全体の追加
push(@{$array2[0]},"hatu") #//2次元配列への指定要素番号への追加
@array2 = map{$_}@array; #//条件付き配列複写{}の中を条件付きに変更
@array2 = @array[0..2]; #//配列のスライス 0,1,2の要素をarray2へ複写
foreach(@{$refarray}){.....;} #//配列全体をリスト展開して、ひとつずつ取り出す
foreach(@array){.....;} #//配列全体をリスト展開して、ひとつずつ取り出す
foreach my $member (1, 2, 3, "asdcf",$dat1, $dat2){...:} #//リストひとつずつ取り出す
foreach my $member (@{ [1, 2, 3, "asdcf"] }){...;} #//@{中身}は中身のリファレンス、無名配列をリスト展開します。
&subxx(\@array); #//サブルーチンに渡す。住所を渡す。
$count = scalar(@array); #//要素の数、部屋の数
$count = scalar(@{$refarray});#//要素の数
#//ほかの呼び出し、代入例
my @a = ('foo','bar','zot','qui');
my @x = @a[0,2];
my @y = ($a[0],$a[2]);
my @xy = (0,3); #//配列の番号
my @z = @a[@xy];
print "@x , @y , @z , @a\n";
@a[1,2]=('aaa','bbb'); #//入れ替え
print "@x , @y , @z . @a\n";
#//結果
foo zot , foo zot , foo qui , foo bar zot qui
foo zot , foo zot , foo qui . foo aaa bbb qui |
ハッシュにキー値を代入、参照
undef %hash; #//ハッシュすべてのKEYと値を削除します。
%hash = ( "a"=>1, "b"=>2, "c"=>3, "data1"=>"saa");
%hash = ( "a",1, "b",2, "c",3, "data1","saa");
%hash = qw(a 1 b 2 c 3 dat1 saa);
$fog0 = $hash{'a'}; #//KEY{a}の値を取得
$fog1 = $hash{'b'}; #//KEY{b}の値を取得
$refhash = \%hash; #//リファレンス(参照値)
$fog2 = $refhash->{'c'}; #//KEY{c}の値を取得
%hash1 = %hash; #//ハッシュ全体のコピー複写
foreach(keys %{$refhash}){......;} #//ハッシュ全体を表す
foreach(keys %hash){.....;} #//ハッシュ全体を表す
&subyy(\%hash); #//サブルーチンに渡す。
$count = scalar( keys %hash ); #//要素の数
$count = scalar( keys %{$refhash} ); #//要素の数
$count = keys %hash; #//要素の数、受け側がスカラーの場合
$count = keys %{$refhash}; #//要素の数、受け側がスカラーの場合
undef $hash{'b'}; #//KEY B の値 2 をundefにする。
delete $hash{'b'};#//KEY B とその値 2 を削除する。
undef %{$refxxx_hash} unless $refxxx_hash; #//HASHの初期化
%marge = ( %hash1, %hash2 ); #//ハッシュの併合
$refmarge = { $refhash1, $refhash2 }; #//ハッシュの併合
$refhash = {}: #//リファレンスで空ブレースで初期化
$chk1 = grep /$kensaku/,@hash{keys %hash}; #//ハッシュスライス(ハッシュの内容検索) |
サブルーチンの受け取り側(配列、ハッシュ)参照
値渡しは、呼び出し元の変数の内容はサブルーチン内では変化しない。
参照渡しは、呼び出し元の変数の内容はサブルーチン内で処理により変化します。
&subxxyy(\@array,\%hash); #//呼び出し(引数の参照渡し)
sub subxxyy{ #//サブルーチン側
my ($arrayref,$hashref) = @_; #//引数の受取り
my $dat0=@$arrayref[0];
my $dat1=$$arrayref[2];
my $dat2=$arrayref->[3];
my $dat3=$hashref->{'a'};
my $dat4=$$hashref{'c'};
foreach(@$arrayref){.....;} #//全体
foreach(keys %{$hashref}){.....;} #//全体
$arrayref->[4]="ssss"; #//配列要素の書き換え
$hashref->{'data1'}="ddddd"; #//ハッシュ要素の書き換え
return;
}
&subzz('asa'=>'teru','yoru'=>'tuki'); #//ハッシュを引数として(引数の値渡し)
sub subzz{
my %has = @_;
my $a = %has{'asa'};
my $b = %has{'yoru'};
}
@kotae = &subyy(@arrayc); #//配列の値渡し、この場合は必ず引数はひとつにすべきです
sub subyy{
my @hairetu = @_;
処理
return(@hairetu);
}
%kotae = &subyy(%hashc); #//ハッシュの値渡し、この場合は必ず引数はひとつにすべきです
sub subyy{
my %san = @_;
処理
return(%san);
} |
無名配列[]、ブラケットで囲めば無名配列を生成
$refarray = [1, 2, 3, "asdcf",$dat1, $dat2];
#//参照:配列全体 @{$refarray} なので @{[1, 2, 3, "asdcf",$dat1, $dat2]};も可能 |
無名ハッシュ{}、ブレースで囲めば無名ハッシュを生成
$refhash = {"a"=>1, "b"=>2, "c"=>3, "data1"=>"saa"}; |
無名配列、無名ハッシュのサブルーチン側の引数受け取り
sub tref{
my ($a)=@_;
return unless (defined $a);
if(ref $a eq 'ARRAY'){
foreach (@$a){
print "$_"."-ARRAY ";
}
}elsif(ref $a eq 'HASH'){
foreach (keys %$a){
print "$_:$a->{$_}"."-HASH ";
}
}elsif(ref $a eq 'SCALAR'){
print "$$a"."-Scalar ";
}else{
print "$a";
}
print "(".ref($a) ."---REF)\n";
} |
無名配列、無名ハッシュのサブルーチン呼び出し側
my $trpew="S1";
my @ar = ("A3","A4");
my %ha = ("H3"=>"789", "H4"=>"000");
&tref(["A1","A2"]);
&tref({"H1"=>"123","H2"=>"456"});
&tref(\$typew);
&tref(\@ar);
&tref(\%ha);
&tref("MOJI");
結果
A1-ARRAY A2-ARRAY (ARRAY---REF)
H1:123-HASH H2:456-HASH (HASH---REF)
S1-Scalar (SCALAR---REF)
A3-ARRAY A4-ARRAY (ARRAY---REF)
H4:000-HASH H3:789-HASH (HASH---REF)
MOJI(---REF) |
my %hb = ("H3"=>{'title'=>"789", 'link'=>"000"},
'H4'=>['A123','A456']
);
my $refa = \%hb;
print "$refa->{'H3'}->{'title'},";
print "$refa->{'H4'}->[0],";
print scalar @{$refa->{H4}},"\n";
結果 789,A123,2 |
2次元配列を行(横行)と列(縦列)に考えた場合
#//初期設定 (行[列,列,列],行[列,列])
@list = (['a','b','c'],['000','111','222','333']); #//配列へ代入
$refarray = \@list;
$refarray = [['a','b','c'],['000','111','222','333']]; #//直接リファレンスへ
#//代入 行の追加
push (@list,['x','y','z']);
push (@list,['666','777','888','999']);
#
print $list[1][2]; #//結果 222
print $refarray->[1][2]; #// 結果 222
push (@{$list[0]},'d'); #//配列(カラム列)へ追加
push (@{$refarray->[0]},'d'); #//リファレンス配列(カラム列)への追加
#その配列の要素の数
my $cnt1 = scalar(@{$refarray->[1]});
#その配列の取りだし
foreach my $dat (map{@$_}$refarray->[1]){
print Dumper $dat;
}
print Dumper $refarray,$cnt1;
結果$VAR1 = '000'; $VAR1 = '111'; $VAR1 = '222'; $VAR1 = '333';
$VAR1 = [ [ 'a', 'b', 'c' ], [ '000', '111', '222', '333' ] ];
$VAR2 = 4; |
文字列から2次元配列に代入する
\nで区切って $team2[0]->[0] がAAA、$team2[0]->[1] が010、代入される
my $content="AAA,010\nBBB,023\nCCC,333\n";
push (@team2,map{[split (/,/,$_)]}split(/\n/,$content)); |
2次元配列全体の表示
ここで使用されているMYは、各々のforeachの内側のみで有効です。これを局所変数といいます。
foreach my $ref (@{$refarray}){ #//横行の読出し
foreach my $ref2 (@{$ref}){ #//その行内の縦列の読出し
print $ref2,;
}
} |
my @array1=@{ $array2[0] }; #// @{ 2次元配列[要素番号]=>1次元配列リスト }取り出し |
my @pmt = map{[ map{split(/,/,$_) } @{$_} ]}(["a,e,r","f,d,s","g"],["w","t,s,a","y"]);
同様に、push (@pmt,map{[map{split(',',$_)}@{$_}]}(["a,e,r","f,d,s","g"],["w","t,s,a","y"]));
print Dumper \@pmt;
$VAR1 = [['a','e','r','f','d','s','g'],['w','t','s','a','y']];
#他に
push (@pmt,map{ map{ [split(',',$_)] }@{$_} }(["a,e,r","f,d,s","g"],["w","t,s,a","y"])
$VAR1 = [['a','e','r'],['f','d','s'],['g'],['w'],['t','s','a'],['y']]; |
$#array は、配列最大要素を返す。次の場合7を返す、scalar(@array)は8を返す
次の場合、GREPはマッチした要素を返す。
下の場合は、検索文字'tokyo'で該当箇所を抽出しています
my @array = ({'name'=>"asahi",'address'=>"nigata",'color'=>"red"},{'name'=>"hirumae",'address'=>"tokyo",'color'=>"blue"});
my $refarray = \@array;
my @ans = grep({ $_->{'address'} eq 'tokyo' }@{$refarray});
print Dumper \@ans;
結果 $VAR1 = [ { 'color' => 'blue', 'name' => 'hirumae', 'address' => 'tokyo' } ]; |
my %kkaz3 = ('c'=>'3','a'=>'1','b'=>'2','e','5');
my @ddd = map { [$_,$kkaz3{$_}]}(sort{$kkaz3{$b}<=> $kkaz3{$a}}keys %kkaz3);
結果 = [ [ 'e', 5 ], [ 'c', 3 ], [ 'b', 2 ], [ 'a', 1 ] ]; |
my @array = [map{qq("$_","$ref_hdata->{$_}")}sort keys %{$ref_hdata}] |
sub get_colorcodelist{
my $col =qq(
aliceblue,#f0f8ff,antiquewhite,#faebd7,
aqua,#00ffff,
green,#008000,
);
my ($key,%colorcode);
foreach(split(",",$col)){
$_=~s/\s*//g;
next unless $_;
($ix++%2 == 0)?$key=$_:$colorcode{$key}=$_;
}
return (%colorcode);
} |
my %ans2;
push(@{$ans2{'red'}},@array) |
my @ar1 = ('qwe','wr','ee');
my %hash = ( 'A1' => {"a"=>1, "b"=>2, "data1"=>"saa"} );#作成
$hash{'A2'} = {"q"=>1, "w"=>2, "data2"=>"aha"};#//追加
$hash{'A1'}->{'b'} = 32; #// 変更
#$hash{'C1'} = [@ar1]; #//配列追加方法1
@{$hash{'C1'}} = @ar1; #//配列追加方法2
push(@{$hash{'C1'}},'total'); #//配列へ要素追加
print Data::Dumper->Dump([\%hash],[qw(*hash)]);
結果 %hash = ('A1' => {'a' => 1,'b' => 32,'data1' => 'saa'},
'A2' => {'data2' => 'aha','q' => 1,'w' => 2},
'C1' => ['qwe','wr','ee','total']);
|
@adatの各要素の頭4桁を抽出して昇順ソートした結果を返す
my @adat = [ [0,'0','9','2','2','3','9','2'], [0,'9','9','3','3','5','3','7'], [0,'9','3','1','7','9','0','0']];
my @aaf = sort{$a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2]}map{@{$_}}@adat;
print Data::Dumper->Dump([\@aaf],[qw(*aaf)]);
結果:@aaf = ([0,0,9,2,2,3,9,2],[0,9,1,3,3,5,3,7],[0,9,3,1,7,9,0,0]); |
my (@waku4,@waku3,@waku2,@waku1);
my (@in4,@in3,@in2,@in1);
my @wakux =(\@waku4,\@waku3,\@waku2,\@waku1);
my @inx =(\@in4,\@in3,\@in2,\@in1);
...
map{ @{$wakux[$_]}=&keisan($inx[$_]) }(0 .. scalar(@inx)-1); |
#//呼び出し例
&yobi(['sai']);
&yobi('sai');
&yobi(\@array);
#//サブルーチン側
sub yobi{
my ($cdata,$cdata2)=@_;
my $refdata = (ref ($cdata) eq 'ARRAY' )?$cdata:($cdata)?[split(/,/,$cdata)]:[]; #//[配列]か"文字列,文字列,,,"
my $reflabel = (ref ($cdata2) eq 'HASH' )?$cdata2:($cdata2)?{split(/,/,$cdata2)}:{};#//{ハッシュ}か"キー文字列"
処理
return;
} |
for(my $i=0;$i<scalar(@array);$i++){
if( ... ){splice(@array,$i--,1);next;}
....
} |
sub readdata{
my ($cdata)=@_;
my $refdata = (ref ($cdata) eq 'ARRAY' )?$cdata:($cdata)?[split(/,/,$cdata)]:[]; #//[配列]か"文字列,文字列,,,"
my @ans;
foreach my $dat (@$refdata){
next if($dat =~ /^\x23/);#//コメント削除
$dat =~ s/,/\t/g;
push (@ans,$dat);
}
return(@ans):
} |
- 配列 \@refarray
- 参照 @$refarray,@{$refarray}
- 配列要素 \$refarray[index]
- 参照 $$refarray[index],$refarray->[index]
- ハッシュ \%refhash
- ハッシュ要素 \%refhash{index}
- 参照 $$refhash{index},$refhash->{index}
- スカラー \$refscalar
- 参照 $$refscalaer,${$refscalaer}
- サブルーチン \&refsub
my $datafiledir="./"; my @filelist;
opendir(DIR,"$datafiledir") && (@filelist = readdir(DIR), closedir(DIR));
if(scalar (@filelist) >= 0){ }
|
一般的に 0 と "" と '' と "0" は偽、それ以外は真、undef(未定義)で偽
if,while,untilでは、undef,0,"",'',"0" は偽、それ以外は真。
defined では、undef(未定義)は偽、それ以外は真。
for では、undefは真。
my $test;
#//$TESTの値が定義されていないならばundefをPrintする。
print "undef" unless defined $test;
#//$TESTの値の評価が偽ならば偽をPrintする。
print $test ? "真":"偽";
結果 undef偽
my @test;
print "undef" unless defined $test[0];
print $test[0] ? "真":"偽";
結果 undef偽
my %test;
print "undef" unless defined $test{0};
print $test{0} ? "真":"偽";
結果 undef偽
my $test="0";
print "undef" unless defined $test;
print $test ? "真":"偽";
結果 偽 |
PERLでは論理演算の結果、偽(false)とは論理値""で、真(true)とは論理値1である。(boolean)
my $test;
$test=("" eq "");
print "undef" unless defined $test;
print $test ? "真":"偽","($test)";
結果 真(1)
my $test;
$test=("" eq "ABC"); または $test=(0 == 1);
print "undef" unless defined $test;
print $test ? "真":"偽","($test)";
結果 偽() |
undefの値を持った変数を参照(print,m//)するとエラーとなります。注意
Use of uninitialized value in string at test.cgi line 128.
Use of uninitialized value in pattern match (m//) at test.cgi line 132.
$Aと$Bは、"ABC" か "" とする。この場合"ABC"は論理値1、""は論理値0と評価される
$aと$bは、1 か 0 とする。この場合1は論理値1、0は論理値0と評価される
- 否定
- 真のものを否定すれば偽。偽を否定すれば真。
!($A and $B) または Not($a || $b) など
- 論理積 and
- 2つの論理値が同時に真である時のみ真。それ以外は全て偽。
($A and $B) または ($a && $b) または ($a * $b)
- 論理和 or
- 2つの論理値が同時に偽である時のみ偽。それ以外は全て真。
($A or $B) または ($a || $b) または ($a + $b)
- 排他的論理和 xor
- 2つの論理値が同一の時のみ偽、それ以外はすべて真。
($A xor $B) または ($a xor $b)
- 優先順位
- !>&&>||>not>and>or.xor
次の関数の呼び出しは、
&subname(undef,1,,3);
次と同様にです。(,,は,とみなされるので引数の途中の省略は誤りです)
&subname(undef,1,3);
関数内で引数が定義されていなければ、undef が変数に付与されます。またこのような変数は、初期設定値が必要です。
&subname(undef,1,3);
subname{
($a,$b,$c,$d)=@_; #//最後尾の引数は省略できます。
$a="" unless defined $a;
$b=0 unless defined $b;
$c=0 unless defined $c;
$d="" unless defined $d;
} |
偽すべてについて初期設定する場合、
&subname(undef,1,"");
subname{
($a,$b,$c,$d)=@_; #//最後尾の引数は省略できます。
$a="" unless $a;
$b=0 unless $b;
$c=0 unless $c;
$d="" unless $d;
} |
1月および2月は前年の13月および14月として計算する。月は3月から14月まであると考える。元年3月1日は、31+28+1日。
基本 うるう年分加算 int($year/4) - int($year/100) + int($year/400)
基本計算式1my $dday = (int(21*$yc/4) + int(5*$yy/4) + int(26*($mon+1)/10) + ($day-1))%7;
ただし、$yy=$year%100;
基本計算式2my $dday = ($year + int($year/4) - int($year/100) + int($year/400) + int((13*$mon+8)/5) + $day)%7;
基本計算式 my $tday = 365*($year-1)+int($year/4)-int($year/100)+int($year/400)+31+28+1+int(306*($mon+1)/10)-122+($day-1);
Fairfield公式とツェラーの公式を参考に!
sub get_days{
my ($year,$mon,$day)=@_;
if ($mon<3){$year--; $mon += 12;}
my $yc=int($year/100);
my $leapd = int($year >> 2) - $yc + int($yc >> 2); #//うるう年分加算する値
my $tday = 365 * $year + $leapd + int(306 * ($mon+1) / 10) + $day - 428;
my $dday = ($year + $leapd + int((13*$mon+8)/5) + $day)%7;
return($tday,$dday);
}
my ($day,$mon,$year)=(30,11,2007); #//金曜日
my ($tday,$dday)=&get_days($year,$mon,$day);
print "日数: $tday \n"; #//結果 733010
print "曜日: $dday \n"; #//結果 5 (0:日曜日 1:月曜日 .. 6:土曜日)
my $time = ($tday - 719163)*24*3600; #//1970_1_1=>719163 TIME関数の返値と同じ |
指定日の月が
- 1月から2月の場合、それぞれの年+月+日=日数となります
- 年=前々年までの日数+前年までの閏年の加算分+前年の1月と2月の日数
- 月=前年の3月から指定日の月が1月若しくは2月未満までの日数
- 日=指定日の日
- 3月から12月の場合、それぞれの年+月+日=日数となります
- 年=前年までの日数+指定日の年までの閏年の加算分+指定日の年の1月と2月の日数
- 月=指定日の月未満までの日数
- 日=指定日の日
注意:1月は31日と2月は28日で計算します。
符号に関係なく【小数部を切り捨てた整数部】を返します。
$_に対して変更を加えると元の値が書き換えられます。
foreach (@array){
$_ =~ tr/0-9//cd; #//配列の中身は全て数字のみに置き換えられます
} |
これを避けるには、
foreach my $dat (@array){
$dat =~ tr/0-9//cd;
} |
次の スクリプトを埋め込む、もちろんこのスクリプトはSJISで書きます。
use Encode qw(encode decode);
use encoding "shiftjis"; #<----これを使うと表示などのもじは文字化けしません。
#// ただしこれにより内部処理はコードは、utf8 になります。
#// しかし、標準入力(input)は、SJISコードは自動でutf8に変換されます。
#// しかし、標準出力(print)は、内部コードのutf8は自動でSJISコードに変換されます。
binmode STDERR, ":encoding(shiftjis)"; #<--- エラー出力をSJISに変換します。
#// @ARGVからの読み込みは自動でutf8に変換しないので、下の処理をする
my @array;
push(@array,map{decode('shiftjis',$_)}@ARGV);
print join(/,/,@array);
#//標準出力への表示を出力
print "現在の時間を表示"; |
ファイルへの入出力は、UTF8の文字変換を参照してください。
TR/検索リスト/変換する文字リスト/cds;
C:検索リスト部に含まれない文字が検索対象
D:検索リスト部に含まれているが変換文字リスト部に対応する文字がない文字を削除する
変換文字リストが検索リストより短い場合、短い部分については、変換文字リストの最後文字がセットされる
S:連続している同じ文字をまとめて1文字にする。
漢字交じりの文字列を扱う場合は、一度EUCコードに変換後TR演算子にかけて、元の文字コード戻すことが望ましい。
数字(0−9)までの検査では、コード変換の必要はありません。(SJISのまま)
TRの検査 (検査 Date: Fri, 04 Jul 金曜日 2008 17:25:44 +09:00) length51
tr/0-9/*/ => (検査 Date: Fri, ** Jul 金曜日 **** **:**:** +**:**) count(16) <=検索文字と対応する文字に置き換える、ないところは最後の置き換え文字を用いる
tr/0-9/*/c => (*****************04************2008*17*25*44**09*00) count(35) <=上述の反対を行う
tr/0-9/*/d => (検査 Date: Fri, * Jul 金曜日 ** :: +*:**) count(16) <=対応する文字がない箇所は削除
tr/0-9/*/dc => (0420081725440900) count(35) <=上述のCをしてからDを実施
tr/0-9/*/s => (検査 Date: Fri, * Jul 金曜日 * *:*:* +*:*) count(16)
tr/0-9/*/cs => (*04*2008*17*25*44*09*00) count(35)
tr/0-9/a-z/ => (検査 Date: Fri, ae Jul 金曜日 caai bh:cf:ee +aj:aa) count(16)
tr/0-9/a-z/c => (zzzzzzzzzzzzzzzzz04zzzzzzzzzzzz2008z17z25z44zz09z00) count(35)
tr/0-9/a-z/dc => (0420081725440900) count(35)
tr/0-9/0-9/ => (検査 Date: Fri, 04 Jul 金曜日 2008 17:25:44 +09:00) count(16)
tr/0-9/0-9/s => (検査 Date: Fri, 04 Jul 金曜日 208 17:25:4 +09:0) count(16)
tr/ //d => (検査 Date:Fri,04Jul金曜日200817:25:44+09:00) count(7)
tr/\x00-\x7f/\x00-\x7f/ => (検査 Date: Fri, 04 Jul 金曜日 2008 17:25:44 +09:00) count(39)
tr/0-9//dc => (0420081725440900) count(35) <=数字のみ取り出し
tr/\x20|\t//d => (検査 Date:Fri,04Jul金曜日200817:25:44+09:00) count(7) <=空白とタブの削除 |
検査の直後にSHIFTJISの全角空白(\x81\x40)がある場合、\x40は@で表示される
tr/\81/K/ => (検査K@Date: Fri, 04 Jul 金曜日 2008 17:25:44 +09:00) count(1) |
文字列数値の列順整形
$day = "7851952244555";
$day =~ tr/0-7//cd;$day =join(//,sort(split(//,$day)));$day=~tr/0-7//s;
結果 "12457" |
検査の直後にSHIFTJISの全角空白(\x81\x40)があるので配列宣言と勘違いしている
###Global symbol "@Date" requires explicit package name のエラー発生
$str = "検査 Date: Fri, 04 Jul 金曜日 2008 17:25:44 +09:00";
### 回避策
$str = q(検査 Date: Fri, 04 Jul 金曜日 2008 17:25:44 +09:00); |
書式「&#10進数;」
print "驪"; #// 10進数表記、ドコモ携帯 1の表示
print ""; #// 10進数表記、SoftBank携帯 1の表示 |
書式「&#x16進数;」
print ""; #// 16進数表記、docomo 携帯 1の表示
print ""; #// 16進数表記、SoftBank携帯 1の表示 |
my @csvdata=qq("yuki","umi",23,"hare","234,900");#//データー
foreach my $line (@csvdata){
$line =~ s/,*$/,/;
push(@ans,[ map{/"(.*?)"/?$1:$_}($line =~ /(".*?"|[^,]*),/g) ]);
}
print Dumper \@ans;
結果 [ [ 'yuki', 'umi', '23', 'hare', '234,900' ] ]; |
DOSコマンドラインで、"perl -d スクリプト名.cgi"を実行して、
DB<1> c を入力するとブレークポイントまで実行して止まります。
#//実行を中断したい箇所に挿入してください
$DB::single = 1; |
DB<1> x $abc,@array,%hash を入力すると変数の値を表示します
DB<1> b kansu を入力すると kansu サブルーチンの始めにブレークポイントを設定します
DB<1> n スクリプトの一行実行します。サブルーチンは一挙に実行します
DB<1> s スクリプトの一行実行します。サブルーチンの中でも1行実行します
DB<1> b 353 を入力するとスクリプトの行番号353手前まで実行して中断します。
use CGI::Carp qw(fatalsToBrowser);#//confess
...
open (IN,$fname) || confess "open error $fname $!";
... |
#//バージョン設定
package hoge;
use CGI::Carp qw(fatalsToBrowser);#//confess
use strict;
use warnings;
our $VERSION = '1.0';#//Perl5.6 以降で有効
#//----------------これは5.6未満の場合
#// use vars qw($VERSION);
#// $VERSION = '1.0';
#//-----------------
....
1;
#//通常スクリプト
use hoge;
print $hoge::VERSION; #//バージョンの番号印刷
#//通常スクリプト
use hoge 1.01;
#エラーが発生 Utilsub version 1.01 required--this is only version 1.0 |
最終更新時間:2019年09月10日 17時11分46秒