#!/usr/local/bin/perl

# RSS Generator - rssgen.pl
#
# Author : Kyo Nagashima
# E-Mail : kyo@hail2u.net
# URL    : http://hail2u.net/
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

use strict;
use Jcode;
use LWP::Simple;
use URI;

# バージョン情報
my $ver = "1.0";

# 引数ない場合は終了
die "Usage: rssgen.pl <URL list file>\n" unless @ARGV == 1;

# メインルーチン ----------------------------------------------------- #

print "RSS Generator $ver\n\n";

# Jcodeオブジェクト作成
my $j = new Jcode;

# 引数取得(かなり手抜き)
my $arg = shift;

# URLリストファイル読み込み
my @urllist = &loadurllist($arg);

# メインループ
my $urlidx;
foreach(@urllist){
	# UTF-8化して、リストから切り出す
	my($churl, $chname, $chdesc, $limit, $from, $to, $regexp, $rssurl, $output) = split(/<>/, $j->set(\$_)->utf8);

	printf("%02d/%02d $churl\n", ++$urlidx, scalar(@urllist));

	# HTMLファイル取得
	print "  Grabbing   ... ";
	my $content = get($churl);
	$content = $j->set(\$content)->utf8;
	# 改行コード統一
	$content =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
	# その上で\nで分割
	my @content = split(/\n/, $content);
	print "Done.\n";

	# RSSファイル生成
	print "  Generating ... ";
	my($flag, $i, @itemlink, @itemname);
	foreach(@content){
		# 検索開始語句がみつかったらフラグを立てる
		$flag = 1 if m/$from/;
		# フラグが立ってるなら
		if($flag){
			# 検索終了語句がみつかったらforeachループを抜ける
			last if m/$to/;
			# 検索する
			if(m/$regexp/){
				my $value = $1;
				# 絶対URIに(強引に)変換
				$value = URI->new_abs($value, $churl);
				$itemlink[++$i] = $value;
				$value = $2;
				# タグ削除
				$value =~ s/<.*?>//g;
				$itemname[$i] = $value;
			}
			# 制限数に達したらforeachループを抜ける
			last if $i == $limit;
		}
	}
	# RSSヘッダ
	my $rss = &rssheader;
	# RSS->channel
	$rss .= &rsschannel($churl, $chname, $chdesc, $rssurl, @itemlink);
	# RSS->channel->items
	for $i (1..$#itemlink){
		$rss .= &rssitems($itemlink[$i])
	}
	$rss .= "\t\t\t</rdf:Seq>\n";
	$rss .= "\t\t</items>\n";
	$rss .= "\t</channel>\n";
	# RSS->item
	for $i (1..$#itemlink){
		$rss .= &rssitem($itemlink[$i], $itemname[$i])
	}
	$rss .= "</rdf:RDF>\n";
	print "Done.\n";

	# &でパースエラーが出るのを防ぐためにエスケープ
	# 現状では余計なものまでエスケープされる
	$rss =~ s/&amp;/&/g;
	$rss =~ s/&/&amp;/g;

	# RSSファイル出力
	print "  Outputting ... ";
	open(OUTPUT, "> $output") || &error(2, $output);
	print OUTPUT Jcode->new(\$rss)->utf8;
	close(OUTPUT);
	# 対象URLの更新時間でタイムスタンプ変更
	# FTPでアップロードすると意味なし
	my $utime = &getlmod($churl);
	utime($utime, $utime, $output);
	print "Done.\n\n";
}

exit;

# ----------------------------------------------------- メインルーチン #

# サブルーチン-------------------------------------------------------- #

# URLリストファイル読み込みサブルーチン
sub loadurllist{
	my $file = $_[0];
	open(URLLIST, $file) || &error(1, $file);
	my @temp = <URLLIST>;
	close(URLLIST);
	foreach(@temp){
		$_ =~ s/^\s+//;
		$_ =~ s/\s$//;
		$_ =~ s/\x0D|\x0A//g;
	}
	return @temp;
}

# ヘッダー出力サブルーチン
sub rssheader{
	my $temp .= <<"_RSS_";
<?xml version="1.0" encoding="UTF-8"?>

<rdf:RDF
	xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
	xmlns="http://purl.org/rss/1.0/"
	xml:lang="ja"
>
_RSS_
	return $temp;
}

# channel出力サブルーチン
sub rsschannel{
	my $temp .= <<"_RSS_";
	<channel rdf:about="$_[3]">
		<title>$_[1]</title>
		<link>$_[0]</link>
		<description>$_[2]</description>
		<items>
			<rdf:Seq>
_RSS_
	return $temp;
}

# items出力サブルーチン
sub rssitems{
	my $temp .= <<"_RSS_";
				<rdf:li rdf:resource="$_[0]"/>
_RSS_
	return $temp;
}

# item出力サブルーチン
sub rssitem{
	my $temp .= <<"_RSS_";
	<item rdf:about="$_[0]">
		<title>$_[1]</title>
		<link>$_[0]</link>
	</item>
_RSS_
	return $temp;
}

# エラー表示サブルーチン
sub error{
	my($num, $mes) = @_;
	my %error = (
		"1" => "File not found.",
		"2" => "File not found or unable to write.",
	);
	print "Error : $error{$num} $mes\n\n";
	exit;
}

# 更新時間取得サブルーチン
sub getlmod{
	my $url = $_[0];
	my $modified_time = (head($url))[2];
	my $temp = time();
	if($modified_time){
		$temp = $modified_time;
	}
	return $temp;
}