summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--feeder.pl24
-rw-r--r--lib/Feed.pm13
-rw-r--r--lib/Feed/Mail.pm179
-rw-r--r--lib/Feed/MailDir.pm76
-rw-r--r--lib/Feed/Printer.pm2
5 files changed, 288 insertions, 6 deletions
diff --git a/feeder.pl b/feeder.pl
index 8a96805..e0bd7ba 100644
--- a/feeder.pl
+++ b/feeder.pl
@@ -14,7 +14,7 @@ log4perl.appender.Screen.layout.ConversionPattern = [%d{ISO8601}] (%c) %m{chomp}
LOG
my $feed_class = Feed->with_traits(
- 'Printer',
+ 'MailDir',
'FixDateTime',
'DeDupe',
'AuthorName',
@@ -24,12 +24,26 @@ sub feed {
my (%args) = @_;
my $feed = $feed_class->new({
dupe_dsn => 'dbi:SQLite:dbname=dedup.db',
+ maildir_base => 'maildir',
%args,
});
$feed->process;
}
-feed(uri=>'http://www.gentoo.org/rdf/en/gentoo-news.rdf');
-feed(uri=>'http://feeds2.feedburner.com/sydneypadua/yBZX');
-feed(uri=>'http://oglaf.com/feeds/rss/');
-feed(uri=>'http://feeds.gawker.com/io9/full');
+feed(
+ uri=>'http://www.gentoo.org/rdf/en/gentoo-news.rdf',
+ mail_folders => 'Gentoo',
+);
+feed(
+ uri=>'http://feeds2.feedburner.com/sydneypadua/yBZX',
+ mail_folders => 'Fun',
+);
+feed(
+ uri=>'http://oglaf.com/feeds/rss/',
+ title=>'Oglaf',
+ mail_folders => 'Fun',
+);
+feed(
+ uri=>'http://feeds.gawker.com/io9/full',
+ mail_folders => 'Weblogs',
+);
diff --git a/lib/Feed.pm b/lib/Feed.pm
index fbcdf10..652c438 100644
--- a/lib/Feed.pm
+++ b/lib/Feed.pm
@@ -30,6 +30,19 @@ has feed => (
builder => 'get_feed',
);
+has title => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+ builder => 'extract_title',
+);
+
+sub extract_title {
+ my ($self) = @_;
+
+ return $self->feed->title;
+}
+
has _entries => (
is => 'ro',
isa => 'ArrayRef[XML::Feed::Entry]',
diff --git a/lib/Feed/Mail.pm b/lib/Feed/Mail.pm
new file mode 100644
index 0000000..cc52b6a
--- /dev/null
+++ b/lib/Feed/Mail.pm
@@ -0,0 +1,179 @@
+package Feed::Mail;
+use Moose::Role;
+use 5.016;
+use namespace::autoclean;
+use Encode;
+use Encode::MIME::Header;
+use MIME::Lite;
+use DateTime::Format::Mail;
+use Digest::SHA1 qw/ sha1_hex /;
+use Template;
+use Template::Provider::Encoding;
+use Template::Stash::ForceUTF8;
+use Moose::Util::TypeConstraints;
+
+subtype 'ArrayOfStr', as 'ArrayRef[Str]';
+coerce 'ArrayOfStr', from 'Str', via { [ $_ ] };
+
+has _mail_folders => (
+ is => 'ro',
+ isa => 'ArrayOfStr',
+ coerce => 1,
+ default => sub { [] },
+ traits => [ 'Array' ],
+ init_arg => 'mail_folders',
+ handles => {
+ mail_folders => 'elements',
+ }
+);
+
+has tt => (
+ is => 'ro',
+ isa => 'Template',
+ lazy_build => 1,
+);
+
+has template => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+has date_formatter => (
+ is => 'ro',
+ lazy_build => 1,
+);
+
+sub _build_tt {
+ my ($self) = @_;
+
+ return Template->new(
+ LOAD_TEMPLATES => [ Template::Provider::Encoding->new ],
+ STASH => Template::Stash::ForceUTF8->new,
+ );
+}
+
+sub _build_template {
+ my ($self) = @_;
+
+ my $curpos = tell(DATA);
+ binmode(DATA);
+ my $template = do {local $/;<DATA>};
+ seek(DATA,$curpos,0);
+
+ return $template;
+}
+
+sub _build_date_formatter {
+ return DateTime::Format::Mail->new();
+}
+
+sub entry_to_mime {
+ my ($self,$entry) = @_;
+
+ my $from = 'feeder@localhost';
+ my $date = $entry->modified;
+ my $from_name = $entry->author // $self->title;
+ $from_name =~ tr/,//d;
+ my $id = sha1_hex($entry->id);
+
+ my $body = $self->prepare_body($entry);
+
+ my $msg = MIME::Lite->new(
+ Date => $self->date_formatter->format_datetime($entry->modified),
+ From => encode('MIME-Header',qq{"$from_name" <$from>}),
+ To => $from,
+ Subject => encode('MIME-Header',$entry->title//'(no title)'),
+ Type => 'multipart/related',
+ );
+ $msg->attach(
+ Type => 'text/html; charset=utf-8',
+ Data => encode('utf-8',$body),
+ Encoding => 'quoted-printable',
+ );
+
+ $msg->add('Message-Id', "<$id.feeder\@localhost>");
+ $msg->add('X-Tags', encode('MIME-Header', join(' ', $entry->tags )));
+
+ return $msg;
+}
+
+sub prepare_body {
+ my ($self,$entry) = @_;
+
+ my $template=$self->template;
+ my $out;
+ $self->tt->process(
+ \$template,
+ {
+ feeder => $self,
+ feed => $self->feed,
+ entry => $entry,
+ content => $entry->content,
+ },
+ \$out,
+ )
+ or die $self->tt->error;
+ return $out;
+}
+
+1;
+
+__DATA__
+[% USE encoding 'utf-8' -%]
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+ <head>
+ <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
+ <style TYPE=text/css>
+ body { padding:0; margin:20px }
+ strong { font-weight:bold; font-size:1.2em }
+ div#msgheader { background:#65869E; color:#F5F5F5; padding:10px; margin:-20px -20px 0 -20px }
+ div#msgbody { margin: 1em }
+ div#msgfooter { text-align:right; font-size:0.8em }
+ #msgheader a:link { color:#F5F5F5 }
+ #msgheader a { font-size: 90% }
+ #msgbody a:link { color:#000000 }
+ #msgbody img { border:1px solid; background:#F5F5F5 }
+ #msgbody hr { border:1px solid }
+ #msgbody pre { font-size: 90% }
+ </style>
+ </head>
+ <body>
+ <div id="msgheader">
+ [% SET link = entry.link || entry.id -%]
+ <a href="[% link | html %]"><strong>[% entry.title %]</strong></a><br />
+ [% feed.title %]<br />
+ [% IF entry.author %]
+ by [% entry.author | html %]
+ [% END %]
+ [% IF entry.tags.size %]
+ on [% entry.tags.join(',') %]
+ [% END %]
+ </div>
+ <div id="msgbody">
+ [% IF content.body -%]
+ [% IF content.body.match('(?i)^<p[ >]') %]
+ [% content.body %]
+ [% ELSE %]
+ <div id="msgbody">[% content.body %]</div>
+ [% END %]
+ [% ELSE %]
+ <br />
+ [% END %]
+ </div>
+ <div id="msgfooter">
+ [% IF entry.issued %]
+ Posted on [% self.date_formatter.format_datetime(entry.issued) %]
+ [% END %]
+ [% IF entry.modified %]
+ Modified on [% self.date_formatter.format_datetime(entry.modified) %]
+ [% END %]
+ |
+ <a href="[% entry.link | html %]">permalink</a>
+ |
+ <a href="[% feed.link | html %]">[% feed.title | html %]</a>
+ <br clear="all" />
+ </div>
+ </body>
+</html>
diff --git a/lib/Feed/MailDir.pm b/lib/Feed/MailDir.pm
new file mode 100644
index 0000000..4b8f542
--- /dev/null
+++ b/lib/Feed/MailDir.pm
@@ -0,0 +1,76 @@
+package Feed::MailDir;
+use Moose::Role;
+use 5.016;
+use namespace::autoclean;
+use Encode;
+use Encode::IMAPUTF7;
+use MooseX::Types::Path::Class 'Dir';
+use Maildir::Lite;
+
+with 'Feed::Mail';
+
+requires 'extract_entries';
+
+has maildir_base => (
+ is => 'ro',
+ isa => Dir,
+ coerce => 1,
+ required => 1,
+);
+
+has maildir_folder => (
+ is => 'ro',
+ isa => 'Maildir::Lite',
+ lazy_build => 1,
+);
+
+sub _build_maildir_folder {
+ my ($self) = @_;
+
+ my $feed = $self->feed;
+
+ my $folder = encode('IMAP-UTF-7',$self->maildir_folder_for($feed));
+
+ $self->maildir_base->mkpath;
+
+ return Maildir::Lite->new(
+ dir => $self->maildir_base->subdir($folder)->stringify,
+ );
+}
+
+sub process_entry {
+ my ($self,$entry) = @_;
+
+ my ($msg) = $self->entry_to_mime($entry);
+
+ $self->store_into_maildir($msg);
+
+ return;
+}
+
+sub _clean_folder_part {
+ return map { s{\W+}{-}gr } @_;
+}
+
+sub maildir_folder_for {
+ my ($self,$feed) = @_;
+
+ my (@comps) = _clean_folder_part($self->mail_folders,$self->title);
+ return join '.','',@comps;
+}
+
+sub store_into_maildir {
+ my ($self,$msg) = @_;
+
+ my ($fh,$stat) = $self->maildir_folder->creat_message();
+ die "maildir create message failed ($stat)" if $stat;
+
+ binmode($fh);
+ $msg->print($fh)
+ or die "print to maildir failed: $!";
+
+ $self->maildir_folder->deliver_message($fh)
+ and die "maildir write failed";
+}
+
+1;
diff --git a/lib/Feed/Printer.pm b/lib/Feed/Printer.pm
index 89dd93f..8d673e0 100644
--- a/lib/Feed/Printer.pm
+++ b/lib/Feed/Printer.pm
@@ -8,7 +8,7 @@ requires 'process';
before process => sub {
my ($self) = @_;
- say $self->feed->title;
+ say $self->title;
};
sub process_entry {
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-10 06:31:03 +0000