#!/usr/local/bin/perl

# RSS Headline Mailer - rsshm.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 Net::SMTP;
use Jcode;
use XML::RSS;

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

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

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

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

# メール設定ファイル読み込み
my %smtpcfg = &loadsmtpcfg($param{'smtpcfg'});

# Net::SMTPオブジェクト作成
my $smtp = Net::SMTP->new(
	$smtpcfg{'smtp-address'},
	Hello => $smtpcfg{'smtp-address'},
	Timeout => 15,
);
if (!$smtp) {
	&error(4, $smtpcfg{'smtp-address'});
}

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

# メインループ
my($newsidx, $rssurl, $la_link, $rss, $mail_body, $rsscache);
foreach (@rssurls) {
	# RSSファイルのURLと最新記事のタイトルを切り出す
	($rssurl, $la_link) = split(/<>/, $j->set(\$_)->utf8);
	printf("%02d/%02d $rssurl\n", ++$newsidx, scalar(@rssurls));
	# RSSファイル読み込み
	print "  Grabbing   ... ";
	if (my $content = $j->set(get($rssurl))->utf8) {
		# encodingをむりやりUTF-8に設定
		$content =~ s/<\?xml.*?\?>/<\?xml version="1.0" encoding="UTF-8"\?>/;
		print "Done.\n";
		# RSSファイル解析
		print "  Parsing    ... ";
		$rss = new XML::RSS;
		eval {
			$rss->parse($content);
		};
		if ($@) {
			$mail_body .= &generate('parse_fail');
		}
		else {
			$mail_body .= &generate('success');
		}
	}
	else {
		$mail_body .= &generate('grab_fail');
	}
	print "Done.\n\n";
	$rsscache .= "$rssurl<>$la_link\n";
}

# メール送信
&sendmail($param{'title'}, $mail_body);

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

exit;

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

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

# 引数解釈サブルーチン
sub setparam {
	my @params = @_;
	# 引数省略時のデフォルト設定
	my %param = (
		"urllist" => "urllist.txt",
		"title" => "RSS Headline Mailer",
		"smtpcfg" => "smtpcfg.ini",
	);
	my %word = (
		"u" => "urllist",
		"t" => "title",
		"m" => "smtpcfg",
	);
	if (@params) {
		for (my $i = 0; $i <= $#params; $i++) {
			# ヘルプ表示
			if ($params[$i] eq '-h' or $params[$i] eq '-?') {
				&help;
			}
			elsif ($params[$i] =~ /-(\S)/) {
				if ($word{$1}) {
					$param{$word{$1}} = $params[++$i];
					next;
				}
				else {
					&error(2, $1);
				}
			}
			else {
				&error(2, $params[$i]);
			}
		}
	}
	print <<"_PARAM_";
RSS Headline Mailer $ver
  URLリスト          : $param{'urllist'}
  タイトル           : $param{'title'}
  メール設定ファイル : $param{'smtpcfg'}

_PARAM_
	return %param;
}

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

# メール設定ファイル読み込みサブルーチン
sub loadsmtpcfg {
	my $file = $_[0];
	open(FH, $file) || &error(1, $file);
	my @smtpcfg = <FH>;
	close(FH);
	my %smtpcfg;
	foreach (@smtpcfg) {
		if (/^(.*?)="(.*?)"$/) {
			$smtpcfg{$1} = $2;
		}
	}
	return %smtpcfg;
}

# RSSファイルごとの処理サブルーチン
sub generate {
	my($flag, $body) = ($_[0], '');
	if ($flag eq 'grab_fail') {
		print "Cannot grab the RSS file.\n";
	}
	elsif ($flag eq 'parse_fail') {
		print "Cannot parse the RSS file.\n";
	}
	elsif ($flag eq 'success') {
		print "Done.\n";
		print "  Generating ... ";
		my $sep = $j->set(\$smtpcfg{'separator'})->utf8;
		my $chname = &formatstr($rss->{'channel'}->{'title'});
		my $chlink = &formatstr($rss->{'channel'}->{'link'});
# 		my $chdesc = &formatstr($rss->{'channel'}->{'description'});
		for my $item (@{$rss->{'items'}}) {
			my $itemname = &formatstr($item->{'title'});
			my $itemlink = &formatstr($item->{'link'});
# 			my $itemdesc = &formatstr($item->{'description'});
			# 前回の最新記事のURLが見つかったらループを抜ける
			if($itemlink eq $la_link){
				last;
			}
			# メール本文に追加
			$body .= "> $itemname\n$itemlink\n\n";
# 			$body .= "> $itemname\n$itemlink\n$itemdesc\n\n";
		}
		# メール本文に追加
		if ($body) {
			$body = "$chname\n$chlink\n\n$body$sep\n\n";
		}
		# 最後に最新記事を取得して上書き
		$la_link = &formatstr($rss->{'items'}[0]->{'link'});
	}
	else {
		print "Unknown error occurred.\n";
	}
	return $body;
}

# メール送信サブルーチン
sub sendmail {
	my($subject, $body) = @_;
	if ($body eq '') {
		print "Sending    ... Canceled.\n";
	}
	else {
		print "Sending    ... ";
		$subject = $j->set(\$smtpcfg{'subject-prefix'})->utf8 . $subject . $j->set(\$smtpcfg{'subject-suffix'})->utf8;
		$subject = $j->set(\$subject)->jis;
		$body = $j->set(\$body)->jis;
		my $from = $smtpcfg{'from'};
		my $to = $smtpcfg{'to'};
		$smtp->auth($smtpcfg{'smtp-id'}, $smtpcfg{'smtp-password'});
		$smtp->mail($from);
		$smtp->to($to);
		$smtp->data();
		$smtp->datasend("From:$from\n");
		$smtp->datasend("To:$to\n");
		$smtp->datasend("Subject:$subject\n");
		$smtp->datasend("Content-Type:text/plain; charset=ISO-2022-JP\n");
		$smtp->datasend("X-Mailer:RSS Headline Mailer $ver\n");
		$smtp->datasend("\n");
		$smtp->datasend("$body\n");
		$smtp->dataend();
		$smtp->quit;
		print "Done.\n";
	}
}

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

# ヘルプ表示サブルーチン
sub help {
	print <<"_HELP_";
RSS Headline Mailer version $ver
  Copyright (c) 2003 kyo <kyo\@hail2u.net>.
  Example:
    rsshm.pl -u rssurl.lst -t "My News" -m smtp.txt
  Options:
    -u <file>   : URLリストファイルを指定する。
    -t <string> : 送信されるメールの件名の一部を指定する。
    -m <file>   : メール設定ファイル名を指定する。
    -h or -?    : このメッセージを表\示する。

_HELP_
	exit;
}

# エラー表示サブルーチン
sub error {
	my($num, $mes) = @_;
	my %error = (
		"1" => "Cannot find a file.",
		"2" => "Invalid option.",
		"3" => "Cannot find or write to a file.",
		"4" => "Cannot find remote host or IP-address.",
	);
	print "Error : $error{$num} $mes\n\n";
	exit;
}

# 文字列整形サブルーチン
sub formatstr {
	my $str = $_[0];
	if ($str) {
		$str =~ s/\x0D\x0A|\x0D|\x0A//g;
		$str =~ s/^\s+//;
		$str =~ s/\s+$//;
		$str =~ s/<.*?>//g;
		$str =~ s/&amp;/&/g;
		$str =~ s/&/&amp;/g;
	}
	return $str;
}

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