<html lang="ja">である場合、
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; |
(結果) Content-Type: text/html; charset=Shift_JIS <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html lang="ja"> <head> <title>タイトル</title> <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS"> <meta http-equiv="Content-style-type" content="text/css"> </head> <body> ..... </body> </html> |
または <html xmlns..> である場合、
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; |
(結果) Content-Type: text/html; charset=Shift_JIS <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" lang="ja" xml:lang="ja"> <head> <title>タイトル</title> <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS" /> <meta http-equiv="Content-style-type" content="text/css" /> </head> <body> ...... </body> </html> |
#!/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=<<STEND; div.chapter,div.section,.newpage { page-break-after : always ; } STEND #//--------------------- #// HTMLヘッダー出力前処理 #//--------------------- &prehedder($q); #//--------------------- #// HTMLヘッダー出力 #//--------------------- my $meta = ""; $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 => "$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(....)への他の追加項目(<head></head>の間に追加する項目)
-style=>{'src'=>"./index.css"}, -meta=>{'keywords'=>'abc,def,xyz', 'description'=>'本日は曜日'}, -script=>{-language=>'JAVASCRIPT',-src=>'/javascript/sp.js'}, -head=>$meta, |
(結果) <link rel="stylesheet" type="text/css" href="./index.css"> <meta name="keywords" content="abc,def,xyz"> <meta name="description" content="本日は曜日"> <script src="/javascript/sp.js" type="text/javascript"></script> |
-head=>$metaにつて、次のように文字列連結を行う
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"}); |
(結果) <meta http-equiv="Content-Type" charset="shift_jis" content="text/html"> <meta http-equiv="Content-style-type" content="text/css"> <meta http-equiv="Content-script-type" content="text/javascript"> <link title="RSS" type="application/rss+xml" rel="alternate" href="http://localhost/index.xml"> |
-styleにつて、CODEの挿入方法
my $newStyle=<<END; P.Tip { margin-right: 50pt; margin-left: 50pt; color: red; } P.Alert { font-size: 30pt; font-family: sans-serif; color: red; } div.chapter,div.section,.newpage { page-break-after : always ; } END -style=>{'src'=>"./index.css",code=>$newStyle} 複数の場合-style=>{'src'=>["./index.css","./wipe.css"],code=>$newStyle} |
(結果) <link rel="stylesheet" type="text/css" href="./index.css"> <style type="text/css"> <!-- P.Tip { margin-right: 50pt; margin-left: 50pt; color: red; } P.Alert { font-size: 30pt; font-family: sans-serif; color: red; } div.chapter,div.section,.newpage { page-break-after : always ; } --> </style> |
-scriptにつて、CODEの挿入方法
-script=>[ {-language=>'JAVASCRIPT',-src=>'/javascript/sphinx.js'}, {-language=>'JAVASCRIPT',-code=>'alert("how are you");'}, ], |
(結果) <script src="/javascript/sphinx.js" type="text/javascript"></script> <script type="text/javascript"> <!-- Hide script alert("how are you");// End script hiding --> </script> |
my $jscode=<<JSEND; alert("how are you"); JSEND .... -script=>{-code=>$jscode} |
(結果) <script type="text/javascript"> <!-- Hide script alert("how are you"); // End script hiding --> </script> |
理解されるパラメータは-type、-status、-expires、-cookieで、その他の名前がついたパラメータは、すべて最初のハイフンを落として、ヘッダ・フィールドに変えられます
キャッシュ制御の場合、
print $query->header(-type =>$tp,-charset => $cset, -expires=>'-1d', -Pragma => 'no-cache', -'Cache-Control' => 'no-cache', ); |
指定のURLへ移動することができる。次と同様の機能です。
print "Location:http://....\n\n"; |
即座に移動して、ブラウザーの履歴に残りません。
my $redirect_url="http://foo.vom/me.cgi"; print $q->redirect($redirect_url); #//通常 print $q->redirect(-uri=>"$rdirect_url",-cookie =>[$cookie1]); #//クッキーを含む |
METATAGの"refresh"は、移動までの秒数を指定できます。ブラウザーの履歴に残ります。
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'; |
" Content-Type " プロパティが省略された場合、文字セットが分らないため、HTML 標準の団体では、使用する HTML 文書の文字セットがわかるように、HTML 文書内部に文字セットを指定する方法としてオプションのメタタグを規定しました。ただし、PERLでは、" Content-Type "出力は必須です。そのため、このhttp-equivは省略できます。しかし、ブラウザーの再表示を行うと、たまに、文字が崩れる場合があります。これは、'http-equiv' がないため文字コードの判別ができないためです。
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,"桁0","桁1"); push(@ans,"桁2"); push(@ans,"桁3"); push(@ans,"桁4","桁5"); #//-------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,"内容1","内容2","内容3","内容4","内容5","内容6"); my %attr = ( #//背景色用CSSクラスの選択 13=>{-class=>'listtable03'},12=>{-class=>'listtable02'}, 11=>{-class=>'listtable01'},10=>{-class=>'listtable00'} ); my $attrindx=13;#// $attrindx=12 if($yobi == 0);#//条件1 my $tabletd1 = "\n" . $q->td({-class=>'textleft'},[@ans]); print $q->Tr($attr{$attrindx},$tabletd1),"\n"; print $q->end_table(); } |
例:DOSコマンド行のプログラムの引数(imode=1)で出力文字コード(sjis)を指示する。プログラムチェックで使用 UTF8で保存すること
#!/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, <DATA> 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=<<END; div.chapter,div.section,.newpage { page-break-after : always ; } END #//ローカルホストか否か確認のためホスト名獲得 $keyss{'httphost'} = $q->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); } |