#!/usr/local/bin/perl
#!D:/Perl/bin/perl.exe

#---------------------------------------------------------------------------------
# 検索エンジンへのURL自動登録用Perlスクリプト
# ＵＲＬ：http://sakaguch.com        電子メール：http://sakaguch.com/cgi/postmail/ より送信して下さい。
# ファイル名：RegURL.pl              2004.04.03 作成：鷹の巣
#--------------------------------------------------------------------------------- 
# 改版記録：
# 2004.03.22 Rev.0.000 初版
# 2004.04.03 Rev.1.000 コメントを追加して、公開。
$ver = 'RegURL.pl   Rev.1.000(作成：鷹の巣)';
#--------------------------------------------------------------------------------- 
# 1.用途
#
# 　このPerlスクリプトは、フリーソフトです。詳細は、項4をご一読願います。
#
# 　このPerlスクリプトは、URLリストファイルに記載された複数のURLを
# 　一括して検索エンジンへ自動登録します。
#
# 　同じディレクトリ（フォルダ）内にこのPerlスクリプト（RegURL.pl）と
# 　登録するURLをリストしたファイル（url_list.txt）を入れて起動して下さい。
# 　正常に登録されたURLは、同じディレクトリ内の記録ファイル（url_log.txt）に
# 　登録日時と登録検索エンジン名と登録URLが追記されます。
#
# 　登録検索エンジンの例として、Googleだけを登録する様にしています。
# 　他の検索エンジンへも登録する場合は、このスクリプト内の
# 　■□■ URLの設定 ■□■に追加して下さい。
#
# 　この機会に是非、クライアント機にPerlをインストールして、
# 　このスクリプトを実行して下さい。
# 　
#--------------------------------------------------------------------------------- 
# 2.作成されるファイルの表示例と特徴
#
# 　実行例は、以下のURLのリンク先に設置しています。
# 　http://sakaguch.com/AccessUp.html#SearchEngine
#
# 　○利点：登録URLが多い場合、ブラウザを利用しての登録に比べると遥かに楽です。
# 　　　　　登録URLを記録するので、管理すれば無駄な登録を排除出来る。
#
# 　○欠点：登録URLが少ない場合、ブラウザを利用しての登録の方が楽です。
# 　　　　　クライアント機にPerlをインストールしなければならない。
# 　　　　　スクリプトの読みやすさに重点を置いているので、処理速度が遅い。
#
#--------------------------------------------------------------------------------- 
# 3.ご注意事項
#
# 　このスクリプトは、Windows 2000 Professional
# 　Active Perl 5.8.4.810 built for MSWin32-x86-multi-thread
# 　の環境にて、動作確認を行っております。
# 　基本的にPerl5以降でしか、動作しません。
#
# 　このスクリプトに対するご質問や不具合がございましたら、電子メールで、
# 　webmaster@sakaguch.com まで、お寄せ下さい。
# 　また、「鷹の巣」の自宅サーバー掲示板
# 　http://sakaguch.com/cgi/bbs/
# 　にご投稿して頂いても結構です。
#
#--------------------------------------------------------------------------------- 
# 4.著作権
#
# 　このスクリプトは、鷹の巣が作成しましたが、著作権は放棄しています。
# 　スクリプトの再配布や改造は自由ですが、無償として下さい。
# 　いかなる目的であっても、このスクリプトに付加価値をつけて、
# 　有償配布してはなりません。
#
#--------------------------------------------------------------------------------- 
# 5.起動方法
#
# 　コマンドラインから、perl RegURL.plを実行します。
#
#--------------------------------------------------------------------------------- 

#■□■ URLの設定 ■□■
# 登録する検索サイトのURLリスト
# 例．検索サイト名＝google、検索サイトのURL＝http://www.google.com/addurl?q=*&dq=　*は、登録するURLの挿入位置記号です。
# 　　url_list.txt内に登録したいURLのhttp://www.example.com/page1.htmlとhttp://www.example.com/page2.htmlが記述されている場合は、
# 　　　http://www.google.com/addurl?q=http://www.example.com/page1.html&dq=
# 　　　http://www.google.com/addurl?q=http://www.example.com/page2.html&dq=
# 　　のURLにアクセスして、URLを登録します。
%add_url = (
		'google','http://www.google.com/addurl?q=*&dq=',
		"","",
		"",""
		);
$url_list = './url_list.txt';	# 登録するURLリストファイル名
$url_log  = './url_log.txt';	# 登録済みURLの記録ファイル名（追記形）
#■□■ URLの設定終わり ■□■

$interval_time = 2;		# 登録時間間隔(秒)　※サーバー側に負担を掛けない様に0秒には設定しないで下さい。
$http_version = '1.0';		# HTTPプロトコル(Hypertext Transfer Protocol)の改版番号
$timeout = 60;			# 接続待ち許容時間（秒）

use IO::Socket;			# IO::Socketモジュールを使用

&main();			# 主回路
exit;

#--------------
# 主回路（）
#--------------
sub main {
	# 改版番号の表示
	print "$ver\n\n";

	open( OUT , ">> $url_log"  ) || &error ( $url_log );
	while (( $add_site , $add_url ) = each ( %add_url )) {
		if ( $add_site ne "" ) {
			open( IN , "<   $url_list" ) || &error ( $url_list );
			while ( <IN> ) {
				# 行末の改行コードを削除
				chomp ( $_ );
				# 登録先検索サイトの基底URLを代入
				$url = $add_url;
				# 登録先検索サイトの基底URLに登録するURLを挿入
				$url =~ s/\*/$_/;
				# $urlに設定したURLのWebページをGETして登録する。
				$mes_error = &get ( $url , $http_version , $timeout );
				if ( !$mes_error ) {
					# 登録日時を取得
					$date = &get_time;
					# 登録URLを記録し、画面にも出力する。
					print     "$date\,$add_site\,$url\n";
					print OUT "$date\,$add_site\,$url\n";
					# 登録時間間隔(秒)だけ処理を休止する。
					sleep ( $interval_time );
				}
			}
			close ( IN );
		}
	}
	close ( OUT );
}

#------------------------------------------------------------------------
# Webページ表示チェックプログラムその２(IO::Socketモジュール使用例)
# SOCKEThttp2.pl 2002.08.17 作成：鷹の巣　http://sakaguch.com/
# 参考URL
# 説明が豊富なURL:http://x68000.q-e-d.net/~68user/net/http-2.html
# 説明が豊富なURL:http://ash.or.jp/perl/socket_http.htm
#------------------------------------------------------------------------
sub get {
	my ($url, $http_version, $timeout) = @_;		# 引数0:URI、引数1:HTTPプロトコルのバージョン、引数2:接続待ち許容時間（秒）
	$url =~ /(http:)?(\/\/)?([^:\/]*)?(:([0-9]+))?(\/.*)?/;
	my $host = $3; if ($host eq "") {$host = 'localhost';}
	my $port = $5; if ($port eq "") {$port = 80;}		# HTTPプロトコルgetservbyname('http','tcp')は80。
	my $path = $6; if ($path eq "") {$path = '/';}

	my $mes_err = "";					# 戻り値を初期化。
	my $SOCKET = IO::Socket::INET	->	new(PeerAddr	=>	$host,	# HTTPプロトコルでWWWサーバーへ接続する
						PeerPort	=>	$port,	# サービスポート番号
						Proto		=>	"tcp",	# プロトコル
						Timeout		=>	$timeout,# 接続待ち許容時間（秒） 
						);
	if ($SOCKET) {
		if ($http_version eq '1.1') {			# WWWサーバにHTTPリクエストを送る
			print $SOCKET "GET  $path  HTTP/1.1\r\n";
			print $SOCKET "Host: $host\r\n";
			print $SOCKET "Connection: close\r\n";
		} else {
			print $SOCKET "GET $path HTTP/1.0\r\n";
		}
		print $SOCKET "\r\n";
		$SOCKET	-> flush();				# バッファに溜まっているデータも送る

#		while (<$SOCKET>){ m/^\r\n$/ and last; }	# ヘッダ部分を除去する(改行のみの行ならループを抜ける)
#		print <$SOCKET>;				# HTTP応答を（ヘッダも含めて）受信して表示

		$SOCKET -> close();				# WWWサーバーから切断する
	} else {
		$mes_err = "$hostのポート$portに接続できません。";
	}
	return ($mes_err);					# 戻り値を格納する。
}

#--------------
# 時間の取得
#--------------
sub get_time {
	my ( $date ) = $_[0];
	my ( $day , $mon , $year , $date );
	if ( $date eq "") {
		( $sec, $min, $hour, $day , $mon , $year ) = localtime ( time() );
		$date = sprintf ( "%04d\.%02d\.%02d %02d:%02d:%02d" , $year+1900 , $mon+1 , $day , $hour , $min , $sec );
	}
	return $date;
}

#------------------
# エラー内容表示
#------------------
sub error {
	# エラーの内容を表示して終了する。
print "$_[0]\n";
	die "$_[0] : $!";
}