TOP > スクリプト制作メモ > プチ・ルーチン集

≫ホスト情報取得ルーチン

リモートホストとIPを返します。リモートホストが取得できない場合はどちらもIPになります。 

($remote_host,$remote_addr) = &get_host;

sub get_host {
	my($remote_host,$remote_addr);
	$remote_host = $ENV{'REMOTE_HOST'};
	$remote_addr = $ENV{'REMOTE_ADDR'};
	if($remote_host eq '' || $remote_host eq $remote_addr){
		$remote_host = gethostbyaddr(pack('C4',split(/\./,$remote_addr)),2);
		if($remote_host eq ''){ $remote_host = $remote_addr; }
	}
	return($remote_host,$remote_addr);
}

≫クエリー取得ルーチン

クエリーを取得して値を %COM に格納します。 

%COM = &get_query_string;

sub get_query_string {
	my(%COM,$buffer,@pairs,$pair,$name);
	$buffer = $ENV{'QUERY_STRING'};
	@pairs = split(/&/,$buffer);
	foreach $pair (@pairs){
		($name,$value) = split(/=/,$pair);
		$COM{$name} = $value;
	}
	return %COM;
}

≫標準入力を取得ルーチン

標準入力の値を %FORM に格納します。 

%FORM = &get_content_length;

sub get_content_length {
	my(%FORM,$buffer,@pairs,$pair,$name);
	read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
	@pairs = split(/&/,$buffer);
	foreach $pair (@pairs){
		($name,$value) = split(/=/,$pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2",$1)/eg;
		#&jcode::convert(\$value,'euc'); # 文字コード変換
		#$value =~ s/\x0D\x0A|\x0D|\x0A/\r/g; # 改行コードの統一
		#$value =~ s/\t//g; # タブ(データ区切り文字)無効化
		#$value =~ s/&/&/g;
		#$value =~ s//>/g;
		#$value =~ s/"/"/g;
		#$value =~ s/&([a-zA-Z0-9]+);/&$1;/g;
		$FORM{$name} = $value;
	}
	return %FORM;
}

≫クッキーを取得ルーチン

$cookie_name のクッキーを取得して値を %COOKIE に格納します。
クッキーデータは
キー:値,キー:値,キー:値,キー:値
という構造とします。 

%COOKIE = &get_cookie($cookie_name);

sub get_cookie {
	my($cookie_name) = @_;
	my(%COOKIE,$http_cookie,@pairs,$pair,$name,$value,%cookie_data);
	$http_cookie = $ENV{'HTTP_COOKIE'};
	@pairs = split(/;/, $http_cookie);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$name =~ s/ //g;
		$cookie_data{$name} = $value;
	}
	@pairs = split(/\,/,$cookie_data{$cookie_name});
	foreach $pair (@pairs) {
		($name, $value) = split(/\:/, $pair);
		$COOKIE{$name} = $value;
	}
	return %COOKIE;
}

≫クッキーを出力ルーチン

クッキーを出力します。引数でクッキー名、クッキーの有効期間、データ、クッキーパスを指定します。
クッキーデータは
キー:値,キー:値,キー:値,キー:値
という構造とします。 

&put_cookie($cookie_name,$cookie_on_days,$cookie_data,$cookie_path);

sub put_cookie {
	my($cookie_name,$cookie_on_days,$cookie_data,$cookie_path) = @_;
	my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,$month,$youbi,$date_gmt);
	$ENV{'TZ'} = "GMT";
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time + $cookie_on_days * 24 * 60 * 60);
	$month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
	$youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday];
	$date_gmt = sprintf("%s\, %02d\-%s\-%04d %02d:%02d:%02d GMT",$youbi,$mday,$month,$year + 1900,$hour,$min,$sec);
	print "Set-Cookie: $cookie_name=$cookie_data; expires=$date_gmt; path=$cookie_path\n";
}

≫HTTPヘッダ出力ルーチン

$charset に文字コードを指定します(ex. EUC-JP, Shift_JIS)。
$gzip に gzip コマンドパスを設定することで gzip 転送に対応します。


&http_header;

sub http_header {
	print "Content-type: text/html;charset=$charset\n";
	if($ENV{'HTTP_ACCEPT_ENCODING'} =~ /gzip/ && $gzip ne ''){  
		if($ENV{'HTTP_ACCEPT_ENCODING'} =~ /x-gzip/){
			print "Content-encoding: x-gzip\n\n";
		}else{
			print "Content-encoding: gzip\n\n";
		}
		open(STDOUT,"| $gzip -1 -c");
	}else{
		print "\n";
	}
	return;
}

≫URLエンコード＆デコード

$str をURLエンコード＆デコードするルーチンです。 

&url_encode($str);
&url_decode($str);

# エンコード
sub url_encode {
	my($str) = @_;
	$str =~ s/(\W)/'%'.unpack("H2", $1)/ego;
	return $str;
}

# デコード
sub url_decode {
	my($str) = @_;
	$str =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/ego;
	return $str;
}
TOP > スクリプト制作メモ > プチ・ルーチン集
(C) bayashi.net