- 追加された行はこのように表示されます。
- 削除された行は
このように表示されます。
{{mobile}}
!!!PERL USE CGIに関して
!!use CGIでのHTTPヘッダー出力
<html lang="ja">である場合、
{{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
<!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..> である場合、
{{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
<!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>
}}
!まとめ 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=<<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>の間に追加する項目)
{{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
(結果)
<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につて、次のように文字列連結を行う
{{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
(結果)
<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の挿入方法
{{code Perl,0,0
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}
}}
{{code HTML,0,0
(結果)
<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の挿入方法
{{code Perl,0,0
-script=>[
{-language=>'JAVASCRIPT',-src=>'/javascript/sphinx.js'},
{-language=>'JAVASCRIPT',-code=>'alert("how are you");'},
],
}}
{{code HTML,0,0
(結果)
<script src="/javascript/sphinx.js" type="text/javascript"></script>
<script type="text/javascript">
<!-- Hide script
alert("how are you");// End script hiding -->
</script>
}}
{{code Perl,0,0
my $jscode=<<JSEND;
alert("how are you");
JSEND
....
-script=>{-code=>$jscode}
}}
{{code HTML,0,0
(結果)
<script type="text/javascript">
<!-- Hide script
alert("how are you");
// End script hiding -->
</script>
}}
!$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,"桁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();
}
}}
!!use utf8;での使用法
例:DOSコマンド行のプログラムの引数(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, <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);
}
}}