List of ap/browser.pl

#!/usr/local/bin/perl5
#
# browser.pl
#	WWW ブラウザの名称
#		1997/11/21 Ver.0.01
#		1997/12/24 Ver.0.02
#		1997/12/26 Ver.0.03
#		1998/03/07 Ver.0.04
#		1998/03/08 Ver.0.05
#		1999/02/28 Ver.0.06 AVE-Front 対応など
#		1999/03/01 Ver.0.07 bugfix
#		1999/03/02 Ver.0.08 bugfix
#		1999/03/03 Ver.0.09 bugfix
#		2000/03/25 Ver.0.10 i-mode
#		2001/09/30 Ver.0.11
#
# (C) 1997-2001 がま <gama@mvg.biglobe.ne.jp>
#-----------------------------------------------------------------------
# 変換用のデータファイル名
$file ='/home2/www2d/025/gama/public_html/cgi/ap/browser.dat';
#-----------------------------------------------------------------------
{
	$a = $ENV{'HTTP_USER_AGENT'};		# 環境変数の USER_AGENT を得る。

	$a =~ s/(.*)via .*$/$1/;			# via の前を取出す
	$a =~ s/  / /ge;					# 連続の space を１つに
	$a =~ s/ $//ge; 					# 行末の space を削除

	$b = &conv($a); 					# 変換！

	print "$b";
	close (STDOUT);

	open (FILE, $file); 				# 変換記録用ファイルを探す。
	while (<FILE>) {
		chomp;
		($a1, $a2) = split(/ <=== /, $_);
		if ( $a2 eq $a ) {
			$f = "found";
			last;						# ループを抜ける
		}
	}
	close (FILE);

	unless (defined($f)) {				# $f 設定されていないとき
		open (FILE,">>$file");			# 追加
		printf FILE "$b <=== $a\n";
		close (FILE);
	}
	exit;
}
#-----------------------------------------------------------------------
sub conv {
	my($a)=$_[0];					# サブルーチンの引数
	my($b);
	$a =~ s/;/, /g; 				#
	$a =~ s/\(/, /g;				#
	$a =~ s/\)/, /g;				#
	$a =~ s/\s,/,/g;				# "," の前の space を削除

	if ( $a =~ /AVE-Front/ ) {					#-------------- AVE-Front
			$b = $a;
			$b =~ s/.*(AVE-Front[\/\.\d]*).*Product=(.*?),.*/$1, $2/;
	} elsif ( $a =~ /^DoCoMo/ ) {
			$b = $a;
			$b =~ s/^.*\/.*\/(.*)(\/)*.*$/$1/;
			$b = "DoCoMo,".$b;
	} elsif ( $a =~ /^Mozilla/ ) {
		if ( $a =~ / MSIE / ) { 				#------------------- MSIE
			$b = $a;
			$b =~ s/.*(MSIE [\.\d]*).+?(Win[\w.\/ ]+).*/$1, $2/;
			$b =~ s/.*(MSIE [\.\d]*).+?(Mac\w*).*/$1, Macintosh/;
		} elsif ( $a =~ /compatible,(.*)/ ) {	#------ その他 compatible
			$b = $1;
		} else {								#--------------- Netscape
			$b = $a;
			$b =~ s/^Mozilla/Netscape/;
			$b =~ s/(Netscape[\/\.\d]*).*?(,|$)/$1, /;
		}
	} elsif ( $a =~ /^WWWC\//) {				#------------------ WWWC/
		 $b = $a;
	} elsif ( $a =~ /^Lynx\//) {				#------------------ Lynx/
		 $b = $a;
		 $b =~ s/^(Lynx\/[\d.-]*).*/$1/;
	} elsif ( $a =~ /compatible,(.*)/ ) {		#------ その他 compatible
		 $b = $1;
	} else {
		 $b = $a;
		 $b =~ s/, http:\/\/.*?\s//;
	}
	#-----------------------------------------------------------------------
	$b =~ s/,.*(Windows|Win)(\w*?),.*?$/, Windows $2/;
	$b =~ s/Windows 16/Windows 3.1/;
	$b =~ s/Windows 32/Windows 9x\/NT/;
	$b =~ s/Win32/Windows 9x\/NT/;
	$b =~ s/,.*(Macintosh).*/, $1/;
	$b =~ s/,.*(SunOS).*/, $1/;
	$b =~ s/,.*(FreeBSD).*/, $1/;
	$b =~ s/,.*(Linux).*/, $1/;
	$b =~ s/,.*(BSD\/OS).*/, $1/;
	$b =~ s/,.*(OSF1).*/, $1/;
	$b =~ s/,.*(IRIX).*/, \U$1\Q/i;
	$b =~ s/,.*(AIX).*/, $1/;
	$b =~ s/,.*(UNIX).*/, $1/;
	$b =~ s/,.*(HI-UX).*/, $1/;
	$b =~ s/,.*(HP-UX).*/, $1/;
	$b =~ s/,.*(NEWS-OS).*/, $1/;
	$b =~ s/ [A-Z0-9],//g;
	$b =~ s/X11,//;
	$b =~ s/(.*?),(.*?),.*/$1, $2/;
	#-----------------------------------------------------------------------
	$b =~ s/\s+/ /g;				# 連続の space を１つに
	$b =~ s/^\s//g; 				# 行頭の space を削除
	$b =~ s/\s$//ge;				# 行末の space を削除
	$b =~ s/,,/,/g; 				# 連続の , を１つに
	$b =~ s/,$//g;					# 行末の ","
	return $b;
}