#!/usr/local/bin/perl
# READMEJ の自動更新スクリプト（御茶御茶の新着情報専用）
# 抜き出す部分を書き換えることによって、任意に対応
# 2003/09/07 版
#                     Copyright(c) 2003-20xx Yuumi
#                     http://gochagocha.ribbon.to/
#                     gochagocha@ribbon.to
#
#　本プログラムはフリーソフトウェアーです。使用するには以下の使用許諾事項をお守りください
#
#　使用許諾事項
#　１．商用目的に使用してはいけません
#　２．著作権を削除して使用してはいけません
#　３．著作権を削除して２次創作物を作成する、又は２次配布を行ってはいけません

use strict;
use Net::HTTP;

use vars qw(
	$UAgent
	$myURL
	$TmpDir
	$ReadmeURL
	$ReadmeExecURL
	$ReadmeID
	$ReadmePass
	$ReadmeGenre
	$ReadmeClass
);
$TmpDir = 'tmp/';
$UAgent = 'Mozilla/4.8 [en] (Win98\; U)';

#設定
$myURL = 'あなたのサイト';
$ReadmeURL = 'http://m.readmej.com/confirm_update.cgi';
$ReadmeExecURL = 'http://m.readmej.com/exec_update.cgi';
$ReadmeID = 'README!のID';
$ReadmePass = 'README!のパスワード';
$ReadmeGenre = 'README!のジャンル';
$ReadmeClass = README の属性（下記より選択）;

#<SELECT NAME="class" SIZE="1">
#<OPTION VALUE="0">-未選択-
#<OPTION VALUE="1" SELECTED>日刊
#<OPTION VALUE="2">週刊
#<OPTION VALUE="3">月刊
#<OPTION VALUE="4">不定期

&main;

sub main{
	use vars qw(
		$UpdateString
		$PostRes
		$regKey
	);

	&GetHtmlPage( $myURL , '' , 'gochaTmp.file' );
	$UpdateString = &GochaLogCut( $TmpDir . 'gochaTmp.file' );
	if( $UpdateString ne '0' ){
		$PostRes = &PostHtmlPage( $ReadmeURL , 'http://m.readmej.com/show_update.cgi' ,
			'account' , $ReadmeID ,
			'password' , $ReadmePass ,
			'genre' , $ReadmeGenre , 
			'class' , $ReadmeClass , 
			'catchcopy' , $UpdateString
		);
		if( $PostRes =~ m|<INPUT TYPE="hidden" NAME="regkey" VALUE="([A-Za-z0-9]*?)" >|i ){
			my $regkey = $1;
			my $j = 0;
			$PostRes = &PostHtmlPage( $ReadmeExecURL , $ReadmeURL ,
				'account' , $ReadmeID ,
				'password' , $ReadmePass ,
				'catchcopy' , $UpdateString ,
				'genre' , $ReadmeGenre , 
				'class' , $ReadmeClass , 
				'regkey' , $regkey
			);
			while( ( $PostRes =~ m|submit| ) && $j < 5 ){
				$PostRes = &PostHtmlPage( $ReadmeExecURL , $ReadmeURL ,
					'account' , $ReadmeID ,
					'password' , $ReadmePass ,
					'catchcopy' , $UpdateString ,
					'genre' , $ReadmeGenre , 
					'class' , $ReadmeClass , 
					'regkey' , $regkey
				);
				$j++;
			}
#			print $PostRes;
		}else{
			print "README! 自動更新スクリプトエラー\n";
		}
	}
}

#新着情報から新着部分を抜き出すスクリプト
#あなたのサイトに対応させるにはこのルーチンを書き換える
sub GochaLogCut{
	my $LogFile = shift;

	use vars qw(
		$np
		$std_p
		$etd_p
		$line
		$outputtxt
	);

	if( $LogFile eq '' ){	return 0;	}

	if(open( FI , $LogFile )){	
		my @lines = <FI>;
		close( FI );
		foreach $line ( @lines ){
			if( $line =~ m/<tr>/i ){	$std_p = $np;	}
			if( $line =~ m/<\/tr>/i ){	$etd_p = $np;	}
			if( $line =~ m/<!-----EOF---->/ ){	last;	}
			$np++;
		}
		my $i = $std_p + 1;
		while( $i < $etd_p ){
			$lines[$i] =~ s/<.*?>//g;
			$lines[$i] =~ s|[\n\r ]||g;
			$outputtxt .= $lines[$i];
			$i++;
		}
		if( $outputtxt =~ m|(.*?)。| ){
			$outputtxt = $1;
		}elsif( $outputtxt =~ m|(.*?)、| ){
			$outputtxt = $1;
		}
		if( $outputtxt =~ m|^(.{,100})| ){
			$outputtxt = $1;
		}
	}
#	print $outputtxt;
#	exit;
	return $outputtxt;
}

sub GetHtmlPage{
	my $GUrl = shift;	#Get URL HOST
	my $SReferer = shift;
	my $GdataSaveFile = shift;

	my ( $GUrlHost , $GUrlPage ) = &URL_Divide( $GUrl );
	if( $GUrlHost eq 'ERROR' ){	return 0;	}
	if( $GdataSaveFile =~ m|/| ){	return 0;	}

	my $cNT = Net::HTTP->new( Host => $GUrlHost );
	$cNT->write_request(
		GET => $GUrlPage,
		'User-Agent' => $UAgent
		'Referer' => $SReferer,
	);
	my($code, $mess, %h) = $cNT->read_response_headers;
	if( open( FI , ">$TmpDir$GdataSaveFile" )){
		while( $code == 200 ){
			my $rbuf;
			my $rn = $cNT->read_entity_body($rbuf, 1024);
			last unless $rn;
			print FI $rbuf;
		}
		close( FI );
	}
}

sub PostHtmlPage{
	my $GUrl = shift;	#POST URL HOST
	my $SReferer = shift;
	my @dataChunk = @_;
	my $getResponce;

	$getResponce = '';
	my ( $GUrlHost , $GUrlPage ) = &URL_Divide( $GUrl );
	if( $GUrlHost eq 'ERROR' ){	return 0;	}

	my $WriteChunk;
	my $i = 0;
	for( 0 .. (( scalar( @dataChunk ) * 0.5 ) - 1 ) ){
		if( $_ > 0 ){
			$WriteChunk .= '&';
		}
		$WriteChunk .= $dataChunk[ $i ] . '=' . $dataChunk[ $i + 1 ];
		$i += 2;
	}
	my $cNT = Net::HTTP->new( Host => $GUrlHost );
	$cNT->write_request(
		POST => $GUrlPage,
		'User-Agent' => $UAgent,
		'Referer' => $SReferer,
		$WriteChunk
	);

	my($code, $mess, %h) = $cNT->read_response_headers;
	while( $code == 200 ){
		my $rbuf;
		my $rn = $cNT->read_entity_body($rbuf, 1024);
		last unless $rn;
		$getResponce .= $rbuf;
	}

	return $getResponce;
}

sub URL_Divide{
	my $NormalURI = shift;	#URL with HOST

	my $dHost;
	my $dFile;

	$dFile = '/';
	if( $NormalURI =~ m|://(.*?)/(.*)$| ){
		$dHost = $1;
		$dFile .= $2;
	}elsif( $NormalURI =~ m|://(.*)| ){
		$dHost = $1;
	}else{
		$dHost = 'ERROR';
	}

	return $dHost , $dFile;
}