#!/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 を1つに $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 を1つに $b =~ s/^\s//g; # 行頭の space を削除 $b =~ s/\s$//ge; # 行末の space を削除 $b =~ s/,,/,/g; # 連続の , を1つに $b =~ s/,$//g; # 行末の "," return $b; }