#!/usr/local/bin/perl -w
# $Id$
use strict;
use DateTime;
use DateTime::Format::Mail;
use Encode;
use FindBin;
use File::Spec;
use Getopt::Long;
use MIME::Lite;
use Template;
use WebService::Bloglines;
use YAML;
our $VERSION = '0.10';
GetOptions(\our %opt, "test", "verbose", "conf=s");
my $conf = $opt{conf} || File::Spec->catfile($FindBin::Bin, "bloglines2email.conf");
my $cfg = YAML::LoadFile($conf);
my $bws = WebService::Bloglines->new(
username => $cfg->{username},
password => $cfg->{password},
);
setup_mailroute($cfg);
my $mark_read = $opt{test} ? 0 : 1;
my @updates = $bws->getitems(0, $mark_read);
debug(scalar(@updates) . " feeds updated.");
for my $update (@updates) {
send_email($cfg, $update);
}
sub setup_mailroute {
my $cfg = shift;
my $route = $cfg->{mailroute} || { via => 'smtp', host => 'localhost' };
my @args = $route->{host} ? ($route->{host}) : ();
MIME::Lite->send($route->{via}, @args);
}
sub debug {
my $msg = "@_";
chomp($msg);
print STDERR encode('utf-8', "$msg\n") if $opt{verbose};
}
sub send_email {
my($cfg, $update) = @_;
my $feed = $update->feed;
my @items = $update->items;
if ($cfg->{'group-items'}) {
send_email_feed($cfg, $feed, \@items);
}
else {
for my $item (@items) {
send_email_item($cfg, $feed, $item);
}
}
}
sub send_email_feed {
my($cfg, $feed, $items) = @_;
my $subject = $feed->{title} || '(no-title)';
my $body = join '
', map format_body($feed, $_, $cfg), @$items;
do_send_mail($cfg, $feed, $subject, $body);
}
sub send_email_item {
my($cfg, $feed, $item) = @_;
my $subject = $item->{title} || '(no-title)';
my $body = format_body($feed, $item, $cfg);
do_send_mail($cfg, $feed, $subject, $body);
}
sub do_send_mail {
my($cfg, $feed, $subject, $body) = @_;
debug("Sending $subject to $cfg->{mailto}");
my $feed_title = $feed->{title};
$feed_title =~ tr/,//d;
my $msg = MIME::Lite->new(
Date => get_rfc2822_date($cfg),
From => encode('MIME-Header', qq("$feed_title" <$cfg->{mailfrom}>)),
To => $cfg->{mailto},
Subject => encode('MIME-Header', $subject),
Type => 'multipart/related',
);
$msg->attach(
Type => 'text/html; charset=utf-8',
Data => encode("utf-8", $body),
);
$msg->send();
}
sub get_rfc2822_date {
my $cfg = shift;
my $dt = @_
? DateTime::Format::Mail->parse_datetime($_[0])
: DateTime->now;
my $tz = $cfg->{'date-timezone'} || 'local';
$dt->set_time_zone($tz);
DateTime::Format::Mail->format_datetime($dt);
}
sub format_body {
my($feed, $item, $cfg) = @_;
my $template = get_template();
my $tt = Template->new;
$tt->process(\$template, {
feed => $feed,
item => $item,
cfg => $cfg,
get_rfc2822_date => sub { get_rfc2822_date($cfg, @_) },
utf8 => sub { encode("utf-8", $_[0]) }
}, \my $out) or die $tt->error;
$out;
}
sub get_template {
return <<'HTML';
[% IF feed.image %]
![[% feed.image.title | html %]]([% feed.image.url | html %])
[% END %]
[% var = 'group-items'; IF cfg.$var %]
[% item.title %][% END %]
[% SET link = item.link || item.guid -%]
Link:
[% link | html %]
[% IF item.dc.creator %]by [% item.dc.creator | html %][% END %][% IF item.dc.subject %] on [% item.dc.subject %][% END %]
[% IF item.description -%]
[% IF item.description.match('(?i)^
]') %][% item.description %][% ELSE %]
[% item.description %]
[% END %]
[% ELSE %]
[% END %]
[% IF item.pubDate %]Posted on [% get_rfc2822_date(item.pubDate) %][% END %] |
permalink |
[% feed.title | html %][% var = 'delicious-username'; IF cfg.$var %][% SET u = "http://del.icio.us/" _ cfg.$var; USE delicious = url(u) %] |
Post to del.icio.us[% END %]
HTML
}
=head1 NAME
bloglines2email - Send Bloglines unread items as HTML mail
=head1 SYNOPSIS
% bloglines2email
% bloglines2email --conf=/path/to/bloglines2email.conf --test --verbose
=head1 DESCRIPTION
C is a command line application that fetches
Bloglines unread items via Bloglines Web Services and sends them as
HTML mail to your address (Gmail is preferrable). It gives you an easy
way to manage, browse and search Blog entries rather than using
Bloglines interface directly.
You'd better run this app by crontab like every 5 minutes.
=head1 REQUIREMENT
This app requires perl 5.8.0 with following Perl modules installed on your box.
=over 4
=item DateTime
=item DateTime::Format::Mail
=item MIME::Lite
=item Template
=item WebService::Bloglines
=item YAML
=back
=head1 OPTIONS
This application has following command line options.
=over 4
=item --test
Doesn't mark unread items as read. Default: mark read.
=item --verbose
Gives diagnostic messages to STDERR. Default: no verbose.
=item --conf
Specifies a path of configuration YAML file. Default:
C in the same directory as script.
=back
=head1 CONFIGURATION
This app uses C that sits beside the script in
the same directory (or you can specify the file path using C<--conf>
option). The distribution has a sample configuration file named
C that you can use by copying.
The config file uses YAML syntax and most of the directives are self-discriptive.
=over 4
=item username, password
Set your username and password for Bloglines.
=item mailto
Set email address that this app sends emails to. Gmail address is recommended.
=item mailfrom
Set email address that this app uses for C header.
=item mailroute
Set how to send emails. Default is to use SMTP.
=item group-items (Optional)
With this directive on (set to 1), C groups updated
items per feed. That reduces a volume of emails sent, and enables a
better user experience with Gmail, thanks to the conversation
threading based on C header. Strongly recommended.
=item date-timezone (Optional)
Sets Date timezone for outgoing email C header and I
phrase inside email body. Default is to use local timezone on your machine.
=item delicious-username (Optional)
Sets your del.icio.us username. With this option set, the email body
will have I link, which is a handy shortcut for
bookmarking items to the social bookmarking service.
=head1 DEVELOPMENT
The newest version is always available via subversion:
svn://svn.bulknews.net/public/bloglines2email/trunk
And you can browse the files via ViewCVS at:
http://svn.bulknews.net/viewcvs/public/bloglines2email/trunk
Feel free to send patches or suggestions to Emiyagawa@bulknews.netE
=head1 AUTHOR
Tatsuhiko Miyagawa Emiyagawa@bulknews.netE
This script is free software and licensed under the same terms as Perl
(Artistic/GPL).
=cut