#! /usr/bin/perl # ================================================================== # # Fumy Redirect CGI Ver 1.00 [r.cgi] # # ================================================================== # # Copyright (C) Fumihiro-Nishimura.(Nishishi) 2006. # # # # 指定されたURLへリダイレクトさせるCGIです。 # # リダイレクト先は複数登録できます。 # # 長いURLを短く表現する目的などでも利用できるでしょう。 # # # # このCGIはどなたでも自由にご使用頂けます。個人・商用を問いません。 # # なお、著作権表示は削除・改変しないで下さい。 # # # # http://www.nishishi.com/ # # ================================================================== # use warnings; use strict; # ================ # # ▼ユーザ設定▼ # # ================ # # データファイル名(CSV) my $datafile = 'redirects.csv'; # 一覧を表示するかどうか(1:する,0:しない) my $listshow = 1; # このCGIのファイル名（サーバ上での呼び出しに使う名称） my $myname = 'r.cgi'; # ---------------------------------- # # ▼これ以降に設定項目はありません▼ # # ---------------------------------- # my $param = &getparam(); print 'Location: ' . &checkurl(&checkdatas("$param")) . "\n\n"; exit; # ---------------- # # パラメータの取得 # # ---------------- # sub getparam { my $query = $ENV{'QUERY_STRING'}; # クエリがなければ if( $query eq "" ) { &defaultmsg(); } return $query; } # -------------------------- # # データの読み込みと一致確認 # # -------------------------- # sub checkdatas { my $checkstring = shift @_; # データファイルを呼んで一致項目を探す my $redurl = ""; if( open(IN,"$datafile") ) { foreach my $oneline ( ) { if( $oneline =~ m/^$checkstring,(.*)/ ) { # 見つかったらループを抜ける $redurl = $1; last; } } close(IN); # ファイルを閉じる } else { # 読めなかったらエラー &errorexit("データファイル $datafile が読めませんでした。存在を確認して下さい。"); } return $redurl; } # ---------------------------- # # データの読み込みとリスト表示 # # ---------------------------- # sub showlist { my @html; if( open(IN,"$datafile") ) { push(@html, qq|| ); push(@html, qq|\n| ); foreach my $oneline ( ) { my ($key,$value) = split(/,/, $oneline); push(@html, qq|\n| ); } close(IN); # ファイルを閉じる push(@html, qq|

パラメータ	リダイレクト先URL
$key	$value

| ); } else { # 読めなかったらエラー &errorexit("データファイル $datafile が読めませんでした。存在を確認して下さい。"); } return @html; } # ------------- # # URLのチェック # # ------------- # sub checkurl { my $url = shift @_; if( $url eq "" ) { &errorexit('登録されていないリダイレクト文字列が指定されました。'); } return $url; } # -------------------- # # デフォルトメッセージ # # -------------------- # sub defaultmsg { my @listhtml = (); if( $listshow == 1 ) { # 一覧表示する場合 @listhtml = &showlist(); } print "Content-type: text/html\n\n"; print qq|Fumy Redirector CGI\n\n

Fumy Redirector CGI

リダイレクト文字列が指定されていません。

|; print @listhtml; print qq||; exit; } # ---------------- # # エラーメッセージ # # ---------------- # sub errorexit { my $msg = shift @_; print "Content-type: text/html\n\n"; print qq|Fumy Redirector CGI ERROR\n|; print qq|

Fumy Redirector CGI ERROR

\n|; print qq|

エラー内容：

\n|; print qq|

$msg

\n|; print qq|

|; print qq|

Fumy Redirector CGI

|; print qq|\n|; exit; }