#!/usr/local/bin/perl

# RSS Headline Mailer Each - rsshme.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 HTML::FormatText;
use HTML::TreeBuilder;
use HTTP::Date;
use Jcode;
use LWP::Simple;
use Net::SMTP;
use XML::RSS;

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

# 署名(改変可)
my $signature = <<"_SIGNATURE_";
// --------------------------------- RSS Headline Mailer Each $ver -- //
_SIGNATURE_

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

# 引数解釈
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 = Jcode->new();

# メインループ
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(LWP::Simple::get($rssurl))->utf8) {
		# encodingをむりやりUTF-8に設定
		$content =~ s/<\?xml.*?\?>/<\?xml version="1.0" encoding="UTF-8"\?>/;
		print "Done.\n";

		# RSSファイルをパース
		print "  Parsing    ... ";
		$rss = XML::RSS->new();
		$rss->add_module(
			'prefix' => 'content',
			'uri' => 'http://purl.org/rss/1.0/modules/content/',
		);

		eval {
			$rss->parse($content);
		};

		if ($@) {
			# パース失敗
			print "Cannot parse the RSS file.\n\n";
		}
		else {
			print "Done.\n";

			# RSSファイル解析
			print "  Sending    ... ";
			print &checkrss;
		}
	}
	else {
		# 取得失敗
		print "Cannot grab the RSS file.\n\n";
	}

	# キャッシュに追加
	$rsscache .= "$rssurl<>$la_link\n";
}

# SMTPサーバーから切断
$smtp->quit();

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

print "Misson completed.\n\n";

exit;

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

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

# 引数解釈サブルーチン
sub setparam {
	my @params = @_;
	# 引数省略時のデフォルト設定
	my %param = (
		"urllist" => "urllist.txt",
		"smtpcfg" => "smtpcfg.ini",
	);
	my %word = (
		"u" => "urllist",
		"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{'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];
	my %smtpcfg;

	open(FH, $file) || &error(1, $file);
	my @smtpcfg = <FH>;
	close(FH);

	foreach (@smtpcfg) {
		chomp;

		if (/^(.*?)="(.*?)"$/) {
			$smtpcfg{$1} = $2;
		}
	}

	return %smtpcfg;
}

# RSSファイルごとの処理サブルーチン
sub checkrss {
	my $result;

	my $sep = $j->set(\$smtpcfg{'separator'})->utf8;
	$signature = $j->set(\$signature, 'sjis')->utf8;
	my $chname = &formatstr($rss->{'channel'}->{'title'});
	my $chlink = &formatstr($rss->{'channel'}->{'link'});

	if (&formatstr($rss->{'items'}[0]->{'link'}) eq $la_link) {
		$result = "Canceled.\n\n";
	}
	else {
		my $count = 0;

		for my $item (@{$rss->{'items'}}) {
			my($itemname, $itemlink, $itemdesc, $itemdate);
			$itemlink = &formatstr($item->{'link'});

			if ($itemlink eq $la_link) {
				last;
			}

			$itemname = &formatstr($item->{'title'});

			if ($item->{'content'}->{'encoded'}) {
				$itemdesc = &formathtml($item->{'content'}->{'encoded'});
				$itemdesc =~ s!^[\x0D\x0A]*!!;
				$itemdesc =~ s![\x0D\x0A]*$!!;
				$itemdesc = "\n" . $itemdesc . "\n";
			}
			elsif ($item->{'description'}) {
				$itemdesc = "\n" . &formatstr($item->{'description'}) . "\n";
			}

			if ($item->{'dc'}->{'date'}) {
				$itemdate = &formatdate($item->{'dc'}->{'date'});
			}

			my $subject = "$itemname - $chname";
			my $date = $itemdate;
			my $body = "$itemname\n$itemlink\n$itemdesc\n$sep\n\n$chname\n$chlink\n\n$signature";
			$count += &sendmail($subject, $date, $body);
		}

		$la_link = &formatstr($rss->{'items'}[0]->{'link'});
		$result = "Done($count).\n\n";
	}

	return $result;
}

# メール送信サブルーチン
sub sendmail {
	my($subject, $date, $body) = @_;

	$subject = $j->set(\$subject, 'utf8')->jis;
	$body = $j->set(\$body, 'utf8')->jis;

	if ($smtpcfg{'smtp-id'} and $smtpcfg{'smtp-password'}) {
		$smtp->auth($smtpcfg{'smtp-id'}, $smtpcfg{'smtp-password'});
	}

	my $from = $smtpcfg{'from'};
	my $to = $smtpcfg{'to'};

	$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("Date: $date\n") if $date;
	$smtp->datasend("Content-Type: text/plain; charset=ISO-2022-JP\n");
	$smtp->datasend("X-Mailer: RSS Headline Mailer Each $ver\n");
	$smtp->datasend("\n");
	$smtp->datasend("$body\n");
	$smtp->dataend();

	return 1;
}

# URLリストファイル更新サブルーチン
sub updateurllist {
	my $file = $_[0];

	open(URLLIST, "> $file") || &error(3, $file);
	print URLLIST $j->set(\$rsscache)->sjis;
	close(URLLIST);

	return "Done.\n";
}

# ヘルプ表示サブルーチン
sub help {
	print <<"_HELP_";
RSS Headline Mailer Each version $ver
  Copyright (c) 2003 kyo <kyo\@hail2u.net>.
  Example:
    rsshme.pl -u rssurl.lst -m smtp.cfg
  Options:
    -u <file>   : URLリストファイルを指定する。
    -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;
}

# HTML整形サブルーチン
sub formathtml {
	my $html = $_[0];

	if ($html) {
		$html = $j->set(\$html, 'utf8')->euc;
		my $tree = HTML::TreeBuilder->new();
		my $formatter = HTML::FormatText->new(
			'leftmargin' => 0,
			'rightmargin' => 100000,
		);
		$html = $formatter->format($tree->parse($html));
		$html = $j->set(\$html, 'euc')->utf8;
	}

	return $html;
}

# 文字列整形サブルーチン
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/&nbsp;/ /g;
		$str =~ s/&quot;/"/g;
		$str =~ s/&lt;/</g;
		$str =~ s/&gt;/>/g;
		$str =~ s/&amp;/&/g;
	}

	return $str;
}

# 時刻整形サブルーチン
sub formatdate {
	my $date = $_[0];

	if ($date) {
		$date = HTTP::Date::str2time($date);
		$date = HTTP::Date::time2str($date);
	}

	return $date;
}

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