タイトル

{{mobile}} !!!PERL USE CGIに関して !!use CGIでのHTTPヘッダー出力である場合、 {{code Perl,0,0 use CGI qw(-no_xhtml); #//HTML 4.01 Transitional//EN my $tp="text/html"; my $cset="shift_jis"; #これは（POSTとGETメソッドの両方からの）入力も含む my $q = new CGI; #//標準HTTPヘッダの作成と出力 print $q->header(-type =>$tp,-charset => $cset); #//HTMLドキュメント・ヘッダの作成 my $meta = $q->meta({-http_equiv => 'Content-Type',-content => $tp,-charset=>$cset}); $meta .= "\n".$q->meta({-http_equiv=>'Content-style-type',-content=>"text/css"}); #//HTMLドキュメント・ヘッダの出力 print $q->start_html(-title=>'タイトル',-lang => 'ja',-head=>$meta); ..... print $q->end_html; }} {{code HTML,0,0 (結果) Content-Type: text/html; charset=Shift_JIS タイトル ..... }} または　である場合、 {{code Perl,0,0 use CGI; #//XHTMLモード my $tp="text/html"; my $cset="shift_jis"; #これは（POSTとGETメソッドの両方からの）入力も含む my $q = new CGI; #//標準HTTPヘッダの作成と出力 print $q->header(-type =>$tp,-charset => $cset); #//HTMLドキュメント・ヘッダの作成 $meta = $q->meta({-http_equiv=>'Content-style-type',-content=>"text/css"}); #//HTMLドキュメント・ヘッダの出力 print $q->start_html(-title=>'タイトル',-lang => 'ja',-head=>$meta); ...... print $q->end_html; }} {{code HTML,0,0 (結果) Content-Type: text/html; charset=Shift_JIS タイトル ...... }} !まとめ　PERLでの組み込み {{code Perl,0,0 #!/usr/local/bin/perl use CGI::Carp qw(fatalsToBrowser); use strict; use warnings; use Data::Dumper; #次の2行のいずれかをコメントにする #use CGI qw(-nosticky); my $noxhtml = 0;#// XHTML use CGI qw(-no_xhtml -nosticky); my $noxhtml = 1;#// NO_XHTML my $tp="text/html"; #//HTTP内容形式 my $cset="shift_jis"; #//HTTP文字コード #----------------------------- #これは（POSTとGETメソッドの両方からの）入力を解析 my $q = new CGI; my %keyss; foreach ($q->param()){ if ($_ eq 'keywords'){ foreach ($q->param($_)){ $keyss{$_}=""; } }else{ my $a=join('|',$q->param($_)); # パラメータ値取得 $a=~ s/\0/|/g; $keyss{$_}=$a; #//Varsに習って%keyssに格納する } } my $newStyle=<meta({-http_equiv=>'Content-style-type',-content=>"text/css"}); $meta .= "\n".$q->meta({-http_equiv=>'Content-script-type',-content=>"text/javascript"}); $meta .= "\n".$q->meta({-http_equiv => 'Content-Type',-content => "$tp; charset=$cset"}) if($noxhtml); print $q->header(-type =>$tp,-charset => $cset); #//標準HTTPヘッダの作成 print $q->start_html(-head=>$meta,-lang => 'ja',-title=>'タイトル',-style=>{-code=>$newStyle});#//HTMLドキュメント・ヘッダの作成 print $q->start_div({-id=>'body'}); #//--------------------- #//メイン呼び出し始まり #//--------------------- &mainsub($q,\%keyss); #//--------------------- #//メイン呼び出し終わり #//--------------------- print $q->end_div; print $q->end_html; exit; #//--------------------- #// ヘッダー出力前処理 #//--------------------- sub prehedder{ my($q)=@_; $q="" unless $q; } #//--------------------- #//PERLスクリプト　メイン #//--------------------- sub miansub{ my ($q,$refkeyss)=@_; $q="" unless $q; ..... return; } }} !補足追加 $q->start-html(....)への他の追加項目(の間に追加する項目) {{code Perl,0,0 -style=>{'src'=>"./index.css"}, -meta=>{'keywords'=>'abc,def,xyz', 'description'=>'本日は曜日'}, -script=>{-language=>'JAVASCRIPT',-src=>'/javascript/sp.js'}, -head=>$meta, }} {{code HTML,0,0 (結果) }} -head=>$metaにつて、次のように文字列連結を行う {{code Perl,0,0 my $meta = $q->meta({-http_equiv => 'Content-Type',-content => $tp,-charset=>$cset}); $meta .= "\n".$q->meta({-http_equiv=>'Content-style-type',-content=>"text/css"}); $meta .= "\n".$q->meta({-http_equiv=>'Content-script-type',-content=>"text/javascript"}); $meta .= "\n".$q->Link({-rel=>"alternate", -type=>"application/rss+xml", -title=>"RSS", -href=>$q->url(-base=>1)."/index.xml"}); }} {{code HTML,0,0 （結果） }} -styleにつて、CODEの挿入方法 {{code Perl,0,0 my $newStyle=<{'src'=>"./index.css",code=>$newStyle} 複数の場合-style=>{'src'=>["./index.css","./wipe.css"],code=>$newStyle} }} {{code HTML,0,0 （結果） }} -scriptにつて、CODEの挿入方法 {{code Perl,0,0 -script=>[ {-language=>'JAVASCRIPT',-src=>'/javascript/sphinx.js'}, {-language=>'JAVASCRIPT',-code=>'alert("how are you");'}, ], }} {{code HTML,0,0 （結果） }} {{code Perl,0,0 my $jscode=<{-code=>$jscode} }} {{code HTML,0,0 （結果） }} !$q->header()について理解されるパラメータは-type、-status、-expires、-cookieで、その他の名前がついたパラメータは、すべて最初のハイフンを落として、ヘッダ・フィールドに変えられますキャッシュ制御の場合、 {{code Perl,0,0 print $query->header(-type =>$tp,-charset => $cset, -expires=>'-1d', -Pragma => 'no-cache', -'Cache-Control' => 'no-cache', ); }} !$q->redirect()について指定のURLへ移動することができる。次と同様の機能です。 {{code Perl,0,0 print "Location:http://....\n\n"; }} 即座に移動して、ブラウザーの履歴に残りません。 {{code Perl,0,0 my $redirect_url="http://foo.vom/me.cgi"; print $q->redirect($redirect_url); #//通常 print $q->redirect(-uri=>"$rdirect_url",-cookie =>[$cookie1]); #//クッキーを含む }} METATAGの"refresh"は、移動までの秒数を指定できます。ブラウザーの履歴に残ります。 !環境GETについて {{code Perl,0,0 print Dumper ($q->script_name,$q->url(-base=>1),$q->remote_addr,$q->remote_host, $q->virtual_host,$q->raw_cookie,$q->user_agent, $q->referer,$q->request_method,$q->self_url ); #結果 $VAR1 = '/cgi-bin/hoge/hoge.cgi'; $VAR2 = 'http://localhost'; $VAR3 = '127.0.0.1'; $VAR4 = '127.0.0.1'; $VAR5 = 'localhost'; $VAR6 = 'count=1234; countx=5673'; $VAR7 = 'Mozilla/5.0 (Windows; U; Windows NT 6.0; ja; rv:1.9.2.2) Gecko/20100316 Firefox/3.6.2 ( .NET CLR 3.5.30729)'; $VAR8 = 'http://localhost/cgi-bin/hoge/'; $VAR9 = 'GET'; $VAR10= 'http://localhost/cgi-bin/hoge/hoge.cgi' #補足コマンドラインからの場合の結果 $VAR1 = ''; $VAR2 = 'http://localhost'; $VAR3 = '127.0.0.1'; $VAR4 = 'localhost'; $VAR5 = 'localhost'; $VAR6 = ''; $VAR7 = undef; $VAR8 = undef; $VAR9 = undef; $VAR10 = 'http://localhost'; }} !文字コード指定の　http-equiv　と　content-typeについて、 " Content-Type " プロパティが省略された場合、文字セットが分らないため、HTML 標準の団体では、使用する HTML 文書の文字セットがわかるように、HTML 文書内部に文字セットを指定する方法としてオプションのメタタグを規定しました。ただし、PERLでは、" Content-Type "出力は必須です。そのため、このhttp-equivは省略できます。しかし、ブラウザーの再表示を行うと、たまに、文字が崩れる場合があります。これは、'http-equiv' がないため文字コードの判別ができないためです。 !!テーブルの表示テスト {{code Perl,0,0 sub tabletest{ my($q,$cdata2,$cdata)=@_; return if (ref ($q) ne 'CGI'); my @ans; my $yobi =1; print $q->start_table({-class=>'listtable'})."\n"; #//--------もし必要ならば、print $q->caption($title); push(@ans,"桁０","桁１"); push(@ans,"桁２"); push(@ans,"桁３"); push(@ans,"桁４","桁５"); #//-------TH 同じクラスの場合 #print $q->Tr($q->th({-class=>'caption1'}[@ans]))."\n"; #//-------TH 異なるクラスの場合 print $q->Tr(map{$q->th({-class=>qq(caption$_)},$ans[$_])}0 .. scalar(@ans)-1)."\n"; @ans = (); #//クラスをある条件で切替へ push(@ans,"内容１","内容２","内容３","内容４","内容５","内容６"); my %attr = ( #//背景色用CSSクラスの選択 13=>{-class=>'listtable03'},12=>{-class=>'listtable02'}, 11=>{-class=>'listtable01'},10=>{-class=>'listtable00'} ); my $attrindx=13;#// $attrindx=12 if($yobi == 0);#//条件１ my $tabletd1 = "\n" . $q->td({-class=>'textleft'},[@ans]); print $q->Tr($attr{$attrindx},$tabletd1),"\n"; print $q->end_table(); } }} !!use utf8;での使用法例：ＤＯＳコマンド行のプログラムの引数（imode=1）で出力文字コード(sjis)を指示する。プログラムチェックで使用　UTF8で保存すること {{code Perl,0,0 #!/usr/local/bin/perl #//-------------------------------------------------------------- #//このエラーが出た場合はUTF8でスクリプトコードが保存されていません #//[Sat Jul 18 21:26:55 2015] hanamarutest.cgi: Malformed UTF-8 character (unexpected continuation byte 0x8c, with no preceding start byte) at D:\test.cgi line 134, line 855. #// 2015.6.1Creat by 星まる UFT8に変更する場合 #//-------------------------------------------------------------- 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; #//UTF8用 $Data::Dumper::Indent = 2;# インデントを0（なし）、1（固定幅）、2（自動可変幅）デフォルトが2 $Data::Dumper::Sortkeys = 1; # キー項目のソートを0（ソートしない）、1（ソートする）で指定できる。デフォルトは0 #$Data::Dumper::Terse = 1; #Terse 変数名の出力を0（省略しない）、1（可能であれば省略）で指定できる。デフォルトが0 #use Devel::Peek; use open ":encoding(cp932)"; #//すべての入出力ファイルはSJIS指定 # use lib qw(./); # #use CGI qw(-nosticky); my $noxhtml = 0;#// XHTML use CGI qw(-no_xhtml -nosticky); my $noxhtml = 1;#// NO_XHTML #//----------------------------- #//これは（POSTとGETメソッドの両方からの）入力を解析 my $q = new CGI; my %keyss = &keyincgi($q); my %cookies = &getcookiecgi($q); #//必要なら $q->delete_all();#//delete allparam, This is because, it affects the text field #// 携帯のタイプを求める my $agent = "";#&pimode_agentck; #任意の関数 $keyss{'imode'}=$agent?1:0 unless exists $keyss{'imode'}; #// #//文字エンコーディングを指定（UTF-8・Shift_JIS・EUC-JP・cp932など） $keyss{'charset'}=$keyss{'imode'}?"shift_jis":"UTF-8"; $keyss{'cset'} =$keyss{'imode'}?"cp932" :"UTF-8"; $keyss{'tp'} ="text/html"; #// #//当該要素の直後では必ず改ページを行うものとします。 my $newStyle=<virtual_host;#//Localhostの確認のため #//imode検査 if($keyss{'imode'}){ binmode STDOUT, ':encoding(cp932)'; #//内部コードをSHIFTJISに変換 binmode STDERR, ':encoding(cp932)'; #//内部コードをSHIFTJISに変換 binmode STDIN, ':encoding(cp932)'; #//SHIFTJISコードを内部コードに変換 } #//--------------------- #// HTMLヘッダー出力前処理 #//--------------------- my $decodechar= exists $keyss{'csetx'} ? $keyss{'csetx'}:$keyss{'cset'}; %keyss = &arrayhash2decode({%keyss},$decodechar); %cookies = &arrayhash2decode({%cookies},'shiftjis'); $q->param('query',$keyss{'query'}); #//query パラメーターの漢字変換後の再セット &prehedder($q,\%keyss); #//--------------------- #// CSS 定義 #//--------------------- my @srccode; push(@srccode,-f "./css/webcal22.css" ? "./css/webcal22.css":""); #//--------------------- #// HTMLヘッダー出力 #//--------------------- my $meta = "";my $nocash=1; $meta .= $q->meta({-http_equiv=>'Content-style-type',-content=>"text/css"}); $meta .= "\n".$q->meta({-http_equiv=>'Content-script-type',-content=>"text/javascript"}); $meta .= "\n".$q->meta({-http_equiv => 'Content-Type',-content => "$keyss{'tp'}; charset=$keyss{'charset'}"}) if($noxhtml); $meta .= "\n".$q->meta({-http_equiv => 'Cache-Control',-content => "no-cache"}) if($nocash); $meta .= "\n".$q->meta({-http_equiv => 'pragma',-content => "no-cache"}) if($nocash); #//--------------------- print $q->header(-type =>$keyss{'tp'},-charset => $keyss{'charset'}); #//標準HTTPヘッダの作成 print $q->start_html(-head=>$meta,-lang => 'ja', -title=>'タイトル',-bgcolor=>'#dddddd',-text=>'#000000', -style=>{'src'=>[@srccode],code=>[$newStyle]} );#//HTMLドキュメント・ヘッダの作成 print $q->start_div({-id=>'body'}); #//--------------------- #//メイン呼び出し始まり #//--------------------- #print Data::Dumper->Dump([\%keyss,$decodechar],[qw(*keyss *decode)]); #print Data::Dumper->Dump([\%cookies],[qw(*cookies)]); &main_scp($q,\%keyss); #//--------------------- #//メイン呼び出し終わり #//--------------------- print $q->end_div; print $q->end_html; exit; #//--------------------- #// ヘッダー出力前処理 #//--------------------- sub prehedder{ my ($q,$cdata,$cdata2)=@_; $q="" unless $q; return if (ref ($q) ne 'CGI'); my $refvalue = (ref ($cdata) eq 'ARRAY' )?$cdata:($cdata) ?[split(/,/,$cdata) ]:[];#//[配列]か"文字列,文字列,,," my $reflabel = (ref ($cdata2) eq 'HASH' )?$cdata2:($cdata2)?{split(/,/,$cdata2)}:{};#//{ハッシュ}か"キー文字列" return; } #//--------------------- #//メイン #//--------------------- sub main_scp{ my($q,$cdata2,$cdata)=@_; $q="" unless $q; return if (ref ($q) ne 'CGI'); my $refkeyss = (ref ($cdata2) eq 'HASH' )?$cdata2:($cdata2)?{split(/,/,$cdata2)}:{};#//{ハッシュ}か"キー文字列"を{連想に} my $refvalue = (ref ($cdata) eq 'ARRAY' )?$cdata:($cdata) ?[split(/,/,$cdata) ]:[];#//[配列]か"文字列,文字列,,,"を[配列に] if(ref $refvalue->[0] ne 'ARRAY'){$refvalue = [[@{$refvalue}]]} #//[配列]を[[配列]]形式へもし必要ならば #print Data::Dumper->Dump([$refkeyss],[qw(*hash)]); #print Data::Dumper->Dump([$refvalue],[qw(*array)]); #----------ここから　自由にコーディングします、もちろん他の定義のところもそれなりに変更してください $refkeyss->{'query'}="" unless $refkeyss->{'query'}; print $q->start_form(-action=>'#', -method=>'get', )."\n"; print $q->hidden(-name=>'csetx',-default=>["$refkeyss->{'cset'}"])."\n"; #//どちらか要るなら print $q->textfield(-name=>'query',-value=>"$refkeyss->{'query'}" ,-size=>"32",-maxlength=>"80")."\n"; print $q->textfield(-name=>'query' ,-size=>"32",-maxlength=>"80")."\n";#//param('query')の内容が表示される print $q->submit(-value=>'検索')."\n"; print $q->reset(-value=>'消去')."\n"; print $q->end_form; #---------ここまで return; } #//-------------------------------------------------------------- #// サブルーチン例 #// #// #// #// 作成： #//-------------------------------------------------------------- sub kansu{ my ($q,$cdata,$cdata2)=@_; $q="" unless $q; my $refarray = (ref ($cdata) eq 'ARRAY' )?$cdata:($cdata)?[split(/,/,$cdata)]:[];#//[配列]か"文字列,文字列,,," my $reflabel = (ref ($cdata2) eq 'HASH' )?$cdata2:($cdata2)?{split(/,/,$cdata2)}:{};#//{ハッシュ}か"キー文字列" if(ref $refarray->[0] ne 'ARRAY'){$refarray = [[@{$refarray}]]} #//配列を[[配列]]二次配列形式へ必要なら print Data::Dumper->Dump([$refarray],[qw(*array)]); print Data::Dumper->Dump([$reflabel],[qw(*hash)]); print Data::Dumper->Dump([$q],[qw(*q)]); #//二次元配列[n][0]から取得 foreach my $dat1 (map{$_->[0]}@{$refarray}){ print Dumper $dat1; } return; } #//-------------------------------------------------------------- #// USE CGI仕様　これは（POSTとGETメソッドの両方からの）入力を解析 #// my $q = new CGI; #// my %keyss=keyincgi($q);#//これは（POSTとGETメソッドの両方からの）入力を解析 #// #// 作成　2015年06月12日 #//-------------------------------------------------------------- sub keyincgi{ my ($q)=@_; my %keyss; return (%keyss) if (ref $q ne "CGI"); foreach ($q->param()){ if ($_ eq 'keywords'){ foreach ($q->param($_)){ $keyss{$_}=""; } }else{ my $a=join('|',$q->param($_)); # パラメータ値取得 $a=~ s/\0/|/g; $keyss{$_}=$a; #//Varsに習って%keyssに格納する } } return(%keyss); } #//-------------------------------------------------------------- #// USE CGI仕様　これは Cookie を取得 #// my $q = new CGI; #// %cookies = &getcookiecgi($q); #// 作成　2015年6月24日 #//-------------------------------------------------------------- sub getcookiecgi{ my ($q)=@_; my %cookies; $q="" unless $q; return (%cookies) if (ref $q ne "CGI"); my @cookiesname = $q->cookie(); foreach (@cookiesname){ $cookies{"$_"}=$q->cookie($_); } return(%cookies); } #// -------------------------------------------------------------------- #// 2次元配列および配列と連想配列を内部コードに変換 #// @ans3out = &arrayhash2decode([@ans3in],$code); #// @ans3in ：元の文字データー配列 #// %ans3outhash = &arrayhash2decode({%ans3inhash},$code); #// %ans3inhash ：元の文字データー連想配列 #// $code ：変換元の文字コード　省略はshiftjis #// use open ":encoding(shiftjis)"; #//すべての入出力ファイルはSJIS指定 #// use open があると　PERLのバージョンによりREQUIREで取り込んだデーターが自動的内部コード化される場合がある #// -------------------------------------------------------------------- sub arrayhash2decode{ my ($cdata,$code)=@_; $code = "shiftjis" unless $code; if(ref ($cdata) eq 'HASH'){ my $reflabel = (ref ($cdata) eq 'HASH' )?$cdata:($cdata)?{split(/,/,$cdata)}:{};#//{ハッシュ}か"キー文字列" my %cookies=map{ $_,Encode::is_utf8($reflabel->{$_}) ?$reflabel->{$_}:decode($code, $reflabel->{$_}) } keys %${reflabel}; #//SHIFTJISから内部コードへ return(%cookies); } my $refarray = (ref ($cdata) eq 'ARRAY' )?$cdata:($cdata)?[split(/,/,$cdata)]:[];#//[配列]か"文字列,文字列,,," my @ans; if(ref ($refarray->[0]) eq 'ARRAY'){ @ans = map{[ map{Encode::is_utf8($_)?$_:decode($code,$_)}@{$_} ]} @${refarray};#//shiftjisから内部コードへ }else{ @ans = map{Encode::is_utf8($_) ?$_:decode($code, $_) } @${refarray}; #//shiftjisから内部コードへ } return(@ans); } }}