#!/usr/local/bin/perl

# RSS Headline Grabber - rsshg.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 LWP::Simple;
use Jcode;
use XML::RSS;

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

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

# 引数解釈
my %param = &setparam(@ARGV);

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

# URLリストファイル読み込み
my @rssurls = &loadurllist($param{'urllist'});

# スキンファイル読み込み
my %skin = &loadskin($param{'skin'});

# メインループ
my($output, $newsidx, $rssurl, $lastarticle, $rss, $rsscache, $chlmod, $chlink, $chdesc, $chname);
foreach(@rssurls){
	# RSSファイルのURLと最新記事のタイトルを切り出す
	($rssurl, $lastarticle) = split(/<>/, $j->set(\$_)->utf8);
	printf("%02d/%02d $rssurl\n", ++$newsidx, scalar(@rssurls));
	# RSSファイル読み込み
	print "  Grabbing   ... ";
	if(my $content = &escapeamp(get($rssurl))){
		print "Done.\n";
		# RSSファイル解析
		print "  Parsing    ... ";
		$rss = new XML::RSS;
		eval{
			$rss->parse($content);
		};
		if($@){
			$output .= &a_header('parse_fail');
		}
		else{
			$output .= &a_header;
			$output .= &a_body;
		}
	}
	else{
		$output .= &a_header('grab_fail');
	}
	$output .= &a_footer;
	print "Done.\n\n";
	$rsscache .= "$rssurl<>$lastarticle\n";
}
$output = $skin{'header'} . $output . $skin{'footer'};

# ファイル出力
&output($param{'output'}, $param{'charset'});

# URLリストファイル更新
&updateurllist($param{'urllist'}, $rsscache);

exit;

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

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

# 引数解釈サブルーチン
sub setparam{
	my @param = @_;
	# 引数省略時のデフォルト設定
	my %temp = (
		"charset" => "sjis",
		"urllist" => "urllist.txt",
		"skin" => "skin.html",
		"title" => "RSS Headline Grabber",
		"limit" => "5",
		"output" => "output.html",
	);
	my %word = (
		"c" => "charset",
		"u" => "urllist",
		"s" => "skin",
		"t" => "title",
		"l" => "limit",
		"o" => "output",
	);
	if(@param){
		for(my $i = 0; $i <= $#param; $i++){
			# ヘルプ表示
			if($param[$i] eq '-h' or $param[$i] eq '-?'){
				&help;
			}
			elsif($param[$i] =~ /-(\S)/){
				if($word{$1}){
					$temp{$word{$1}} = $param[++$i];
					next;
				}
				else{
					&error(2, $1);
				}
			}
			else{
				&error(2, $param[$i]);
			}
		}
	}
	print <<"_PARAM_";
RSS Headline Grabber $ver
  出力文字コード : $temp{'charset'}
  URLリスト      : $temp{'urllist'}
  スキンファイル : $temp{'skin'}
  タイトル       : $temp{'title'}
  記事最大取得数 : $temp{'limit'}
  出力ファイル   : $temp{'output'}

_PARAM_
	return(%temp);
}

# 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;
		$_ =~ $j->set($_)->utf8;
	}
	return @temp;
}

# アンパサンドエスケープサブルーチン
sub escapeamp{
	my $temp = $_[0];
	if($temp){
		$temp =~ s/&amp;/&/g;
		$temp =~ s/&/&amp;/g;
	}
	return $temp;
}

# スキンファイル読み込みサブルーチン
sub loadskin{
	my $file = $_[0];
	open(SKIN, $file) || &error(1, $file);
	my $temp = join('', <SKIN>);
	close(SKIN);
	$temp = $j->set(\$temp)->utf8;
	my $title = $j->set(\$param{'title'})->utf8;
	my $update = &formattime(time);
	$temp =~ s/_%title%_/$title/g;
	$temp =~ s/_%update%_/$update/g;
	my @temp = split(/_%s%_/, $temp);
	my %temp = (
		"header" => $temp[0],
		"a_header" => $temp[1],
		"a_body" => $temp[2],
		"a_body_new" => $temp[3],
		"a_footer" => $temp[4],
		"footer" => $temp[5],
	);
	return(%temp);
}

# RSSファイルごとのヘッダー出力サブルーチン
sub a_header{
	my $flag = $_[0];
	my $temp = $skin{'a_header'};
	my %chname = (
		"grab_fail"=>"Cannot grab the RSS file.",
		"parse_fail"=>"Cannot parse the RSS file.",
	);
	my %chdesc = (
		"grab_fail"=>"The RSS file is not found or the server is busy.",
		"parse_fail"=>"The RSS file is probably corrupted or not well-formed.",
	);
	$chlmod = &getlmod($rssurl);
	if($flag){
		print "$chname{$flag}\n";
		print "  Generating ... ";
		$chname = $chname{$flag};
		$chlink = $rssurl;
		$chdesc = $chdesc{$flag};
	}
	else{
		print "Done.\n";
		print "  Generating ... ";
		$chname = &formatstr($j->set(\$rss->{'channel'}->{'title'})->utf8);
		$chlink = &formatstr($j->set(\$rss->{'channel'}->{'link'})->utf8);
		$chdesc = &formatstr($j->set(\$rss->{'channel'}->{'description'})->utf8);
	}
	$temp =~ s/_%rssurl%_/$rssurl/g;
	$temp =~ s/_%chname%_/$chname/g;
	$temp =~ s/_%chlink%_/$chlink/g;
	$temp =~ s/_%chdesc%_/$chdesc/g;
	$temp =~ s/_%chlmod%_/$chlmod/g;
	return $temp;
}

# RSSファイルの各記事出力サブルーチン
sub a_body{
	my($temp, $cnt, $itemlink, $itemname);
	my $flag = 1;
	for my $item (@{$rss->{'items'}}){
		if($param{'limit'} >= 0 and $cnt++ >= $param{'limit'}){
			last;
		}
		$itemname = &formatstr($j->set(\$item->{'title'})->utf8);
		$itemlink = &formatstr($j->set(\$item->{'link'})->utf8);
		if($itemname eq $lastarticle){
			$flag = 0;
		}
		my $a_item = $skin{'a_body'};
		if($flag == 1){
			$a_item = $skin{'a_body_new'};
		}
		$a_item =~ s/_%itemlink%_/$itemlink/g;
		$a_item =~ s/_%itemname%_/$itemname/g;
		$temp .= $a_item;
	}
	# 最後に最新記事を取得
	$lastarticle = &formatstr($j->set(\$rss->{'items'}[0]->{'title'})->utf8);
	return $temp;
}

# RSSファイルごとのフッター出力サブルーチン
sub a_footer{
	my $temp = $skin{'a_footer'};
	$temp =~ s/_%rssurl%_/$rssurl/g;
	$temp =~ s/_%chname%_/$chname/g;
	$temp =~ s/_%chlink%_/$chlink/g;
	$temp =~ s/_%chdesc%_/$chdesc/g;
	$temp =~ s/_%chlmod%_/$chlmod/g;
	return $temp;
}

# ファイル出力サブルーチン
sub output{
	my($file, $charset) = @_;
	print "Outputting ... ";
	open(OUTPUT, "> $file") || &error(1, $file);
	print OUTPUT $j->set(\$output)->$charset;
	close(OUTPUT);
	print "Done.\n\n";
}

# URLリストファイル更新サブルーチン
sub updateurllist{
	my($file, $temp) = @_;
	print "Saving     ... ";
	open(URLLIST, "> $file") || &error(3, $file);
	print URLLIST $j->set(\$temp)->sjis;
	close(URLLIST);
	print "Done.\n\n";
}

# ヘルプ表示サブルーチン
sub help{
	print <<"_HELP_";
RSS Headline Grabber version $ver
  Copyright (c) 2003 kyo <kyo\@hail2u.net> & Naoto <run\@cha.to>.
  Example:
    rsshg.pl -c utf8 -u rss.lst -s myskin.html -t "My News" -l 8 -o rsshg.html
  Options:
    -c <code>   : 出力文字コードセットを指定する。
                    <code> = euc
                           = sjis
                           = iso_2022_jp
                           = utf8
    -u <file>   : URLリストファイルを指定する。
    -s <file>   : スキンファイルを指定する。
    -t <string> : 出力ファイルのタイトルを指定する。
    -l <n>      : 記事最大取得数を指定する(-1で無制限)。
    -o <file>   : 出力ファイル名を指定する。
    -h or -?    : このメッセージを表\示する。

_HELP_
	exit;
}

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

# 時刻整形サブルーチン
sub formattime{
	my $time = $_[0];
	my($ss, $nn, $hh, $dd, $mm, $yy) = localtime($time);
	$yy = $yy + 1900;
	$mm = sprintf "%02d", ++$mm;
	$dd = sprintf "%02d", $dd;
	$hh = sprintf "%02d", $hh;
	$nn = sprintf "%02d", $nn;
	$ss = sprintf "%02d", $ss;
	my $temp = "$yy/$mm/$dd $hh:$nn:$ss";
	return $temp;
}

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

# 文字列整形サブルーチン
sub formatstr{
	my $temp = $_[0];
	if($temp){
		$temp =~ s/^\s+//;
		$temp =~ s/\s+$//;
		$temp =~ s/&amp;/&/g;
		$temp =~ s/&/&amp;/g;
	}
	return $temp;
}

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