From 7a005adbf486cbb6c3f64ba26b1aa97c2f696025 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sun, 9 Dec 2012 15:30:06 +0000 Subject: renaming roles --- lib/Feed.pm | 2 +- lib/Feed/AuthorName.pm | 30 -------- lib/Feed/DeDupe.pm | 141 ---------------------------------- lib/Feed/FixDateTime.pm | 29 ------- lib/Feed/HelperRole/Mail.pm | 179 +++++++++++++++++++++++++++++++++++++++++++ lib/Feed/Mail.pm | 179 ------------------------------------------- lib/Feed/MailDir.pm | 76 ------------------ lib/Feed/Printer.pm | 28 ------- lib/Feed/Role/AuthorName.pm | 30 ++++++++ lib/Feed/Role/DeDupe.pm | 141 ++++++++++++++++++++++++++++++++++ lib/Feed/Role/FixDateTime.pm | 29 +++++++ lib/Feed/Role/MailDir.pm | 76 ++++++++++++++++++ lib/Feed/Role/Printer.pm | 28 +++++++ 13 files changed, 484 insertions(+), 484 deletions(-) delete mode 100644 lib/Feed/AuthorName.pm delete mode 100644 lib/Feed/DeDupe.pm delete mode 100644 lib/Feed/FixDateTime.pm create mode 100644 lib/Feed/HelperRole/Mail.pm delete mode 100644 lib/Feed/Mail.pm delete mode 100644 lib/Feed/MailDir.pm delete mode 100644 lib/Feed/Printer.pm create mode 100644 lib/Feed/Role/AuthorName.pm create mode 100644 lib/Feed/Role/DeDupe.pm create mode 100644 lib/Feed/Role/FixDateTime.pm create mode 100644 lib/Feed/Role/MailDir.pm create mode 100644 lib/Feed/Role/Printer.pm (limited to 'lib') diff --git a/lib/Feed.pm b/lib/Feed.pm index 652c438..f01eb8d 100644 --- a/lib/Feed.pm +++ b/lib/Feed.pm @@ -14,7 +14,7 @@ sub log { return Log::Log4perl->get_logger($caller) } -has '+_trait_namespace' => ( default => __PACKAGE__ ); +has '+_trait_namespace' => ( default => __PACKAGE__ . '::Role' ); has uri => ( is => 'ro', diff --git a/lib/Feed/AuthorName.pm b/lib/Feed/AuthorName.pm deleted file mode 100644 index ae883b2..0000000 --- a/lib/Feed/AuthorName.pm +++ /dev/null @@ -1,30 +0,0 @@ -package Feed::AuthorName; -use Moose::Role; -use 5.016; -use namespace::autoclean; -use Email::Address; -use Try::Tiny; - -requires 'process_entry'; - -before process_entry => sub { - my ($self,$entry) = @_; - - $self->log->trace('before process_entry - begin'); - - my $author = $entry->author; - - return unless $author && $author =~ /\@/; - - try { - my $address = (Email::Address->parse($author))[0]; - if (my $name = $address->name) { - $entry->author($name); - } - }; - - $self->log->trace('before process_entry - end'); -}; - -1; - diff --git a/lib/Feed/DeDupe.pm b/lib/Feed/DeDupe.pm deleted file mode 100644 index f617154..0000000 --- a/lib/Feed/DeDupe.pm +++ /dev/null @@ -1,141 +0,0 @@ -package Feed::DeDupe; -use Moose::Role; -use 5.016; -use namespace::autoclean -also => ['_maybe_build_schema']; -use DBI; -use Try::Tiny; -use Encode; -use Digest::SHA1 'sha1_base64'; - -requires 'get_feed','process','process_entry'; - -has 'dupe_dsn' => ( - is => 'ro', - isa => 'Str', - required => 1, -); - -has dbh => ( - is => 'ro', - lazy_build => 1, -); - -has ['_find_sth','_insert_sth'] => ( - is => 'ro', - lazy_build => 1, -); - -sub _build_dbh { - my ($self) = @_; - - my $dbh = DBI->connect($self->dupe_dsn,undef,undef,{ - RaiseError => 1, - PrintError => 0, - AutoCommit => 0, - }); - - _maybe_build_schema($dbh); - - return $dbh; -} - -sub _maybe_build_schema { - my ($dbh) = @_; - - try { - $dbh->selectrow_array(q{SELECT * FROM seen_items LIMIT 1}); - $dbh->rollback; - } catch { - $dbh->do(<<'SQL'); -CREATE TABLE seen_items ( - id VARCHAR(255) PRIMARY KEY -) -SQL -$dbh->commit; - }; - - return; -} - -sub _build__find_sth { - my ($self) = @_; - - return $self->dbh->prepare(<<'SQL'); -SELECT COUNT(*) -FROM seen_items -WHERE id=? -SQL -} - -sub _build__insert_sth { - my ($self) = @_; - - return $self->dbh->prepare(<<'SQL'); -INSERT INTO seen_items(id) -VALUES (?) -SQL -} - -after process => sub { - my ($self) = @_; - - $self->log->trace('after process'); - - $self->dbh->commit; -}; - -around process_entry => sub { - my ($orig,$self,$entry) = @_; - - $self->log->trace('around process_entry - begin'); - - return if $self->seen_already($entry); - - $self->log->trace('around process_entry - call original'); - - $self->$orig($entry); - - $self->mark_seen($entry); - - $self->log->trace('around process_entry - end'); - - return; -}; - -sub seen_already { - my ($self,$e) = @_; - - $self->log->trace('seen_already - begin'); - - my $id = $self->_entry_id($e); - - $self->_find_sth->execute($id); - my ($count) = $self->_find_sth->fetchrow_array; - - $self->log->trace("seen_already - end ($count)"); - - return $count; -} - -sub mark_seen { - my ($self,$e) = @_; - - $self->log->trace('mark_seen - begin'); - - my $id = $self->_entry_id($e); - - $self->_insert_sth->execute($id); - - $self->log->trace('mark_seen - end'); -} - -sub _entry_id { - my ($self,$e) = @_; - - my $body = $e->content->body; - my $content_digest = sha1_base64(encode('utf-8',$body)); - my $id = join '-',$e->id,$e->modified->iso8601,$content_digest; - return encode('utf-8',$id); -} - -1; diff --git a/lib/Feed/FixDateTime.pm b/lib/Feed/FixDateTime.pm deleted file mode 100644 index 6034931..0000000 --- a/lib/Feed/FixDateTime.pm +++ /dev/null @@ -1,29 +0,0 @@ -package Feed::FixDateTime; -use Moose::Role; -use 5.016; -use namespace::autoclean; -use DateTime; - -requires 'process_entry'; - -before process_entry => sub { - my ($self,$entry) = @_; - - $self->log->trace('before process_entry - begin'); - - for my $f ('issued','modified') { - my $date = $entry->$f; - if (!$date) { - $date = DateTime->from_epoch(epoch=>0); - } - if ($date && $date->time_zone->is_floating) { - $date->set_time_zone('UTC'); - } - - $entry->$f($date); - } - - $self->log->trace('before process_entry - end'); -}; - -1; diff --git a/lib/Feed/HelperRole/Mail.pm b/lib/Feed/HelperRole/Mail.pm new file mode 100644 index 0000000..c37c42a --- /dev/null +++ b/lib/Feed/HelperRole/Mail.pm @@ -0,0 +1,179 @@ +package Feed::HelperRole::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 $/;}; + 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' -%] + + + + + + + +
+ [% SET link = entry.link || entry.id -%] + [% entry.title %]
+ [% feed.title %]
+ [% IF entry.author %] + by [% entry.author | html %] + [% END %] + [% IF entry.tags.size %] + on [% entry.tags.join(',') %] + [% END %] +
+
+ [% IF content.body -%] + [% IF content.body.match('(?i)^]') %] + [% content.body %] + [% ELSE %] +
[% content.body %]
+ [% END %] + [% ELSE %] +
+ [% END %] +
+
+ [% 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 %] + | + permalink + | + [% feed.title | html %] +
+
+ + diff --git a/lib/Feed/Mail.pm b/lib/Feed/Mail.pm deleted file mode 100644 index cc52b6a..0000000 --- a/lib/Feed/Mail.pm +++ /dev/null @@ -1,179 +0,0 @@ -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 $/;}; - 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' -%] - - - - - - - -
- [% SET link = entry.link || entry.id -%] - [% entry.title %]
- [% feed.title %]
- [% IF entry.author %] - by [% entry.author | html %] - [% END %] - [% IF entry.tags.size %] - on [% entry.tags.join(',') %] - [% END %] -
-
- [% IF content.body -%] - [% IF content.body.match('(?i)^]') %] - [% content.body %] - [% ELSE %] -
[% content.body %]
- [% END %] - [% ELSE %] -
- [% END %] -
-
- [% 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 %] - | - permalink - | - [% feed.title | html %] -
-
- - diff --git a/lib/Feed/MailDir.pm b/lib/Feed/MailDir.pm deleted file mode 100644 index 4b8f542..0000000 --- a/lib/Feed/MailDir.pm +++ /dev/null @@ -1,76 +0,0 @@ -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 deleted file mode 100644 index 8d673e0..0000000 --- a/lib/Feed/Printer.pm +++ /dev/null @@ -1,28 +0,0 @@ -package Feed::Printer; -use Moose::Role; -use 5.016; -use namespace::autoclean; - -requires 'process'; - -before process => sub { - my ($self) = @_; - - say $self->title; -}; - -sub process_entry { - my ($self,$entry) = @_; - - $self->log->trace('process_entry - begin'); - - for my $f (qw(id author title link issued modified)) { - say " $f:",$entry->$f//''; - } - say $entry->content->body; - say ''; - - $self->log->trace('process_entry - end'); -} - -1; diff --git a/lib/Feed/Role/AuthorName.pm b/lib/Feed/Role/AuthorName.pm new file mode 100644 index 0000000..ec8a44d --- /dev/null +++ b/lib/Feed/Role/AuthorName.pm @@ -0,0 +1,30 @@ +package Feed::Role::AuthorName; +use Moose::Role; +use 5.016; +use namespace::autoclean; +use Email::Address; +use Try::Tiny; + +requires 'process_entry'; + +before process_entry => sub { + my ($self,$entry) = @_; + + $self->log->trace('before process_entry - begin'); + + my $author = $entry->author; + + return unless $author && $author =~ /\@/; + + try { + my $address = (Email::Address->parse($author))[0]; + if (my $name = $address->name) { + $entry->author($name); + } + }; + + $self->log->trace('before process_entry - end'); +}; + +1; + diff --git a/lib/Feed/Role/DeDupe.pm b/lib/Feed/Role/DeDupe.pm new file mode 100644 index 0000000..f1bfc71 --- /dev/null +++ b/lib/Feed/Role/DeDupe.pm @@ -0,0 +1,141 @@ +package Feed::Role::DeDupe; +use Moose::Role; +use 5.016; +use namespace::autoclean -also => ['_maybe_build_schema']; +use DBI; +use Try::Tiny; +use Encode; +use Digest::SHA1 'sha1_base64'; + +requires 'get_feed','process','process_entry'; + +has 'dupe_dsn' => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +has dbh => ( + is => 'ro', + lazy_build => 1, +); + +has ['_find_sth','_insert_sth'] => ( + is => 'ro', + lazy_build => 1, +); + +sub _build_dbh { + my ($self) = @_; + + my $dbh = DBI->connect($self->dupe_dsn,undef,undef,{ + RaiseError => 1, + PrintError => 0, + AutoCommit => 0, + }); + + _maybe_build_schema($dbh); + + return $dbh; +} + +sub _maybe_build_schema { + my ($dbh) = @_; + + try { + $dbh->selectrow_array(q{SELECT * FROM seen_items LIMIT 1}); + $dbh->rollback; + } catch { + $dbh->do(<<'SQL'); +CREATE TABLE seen_items ( + id VARCHAR(255) PRIMARY KEY +) +SQL +$dbh->commit; + }; + + return; +} + +sub _build__find_sth { + my ($self) = @_; + + return $self->dbh->prepare(<<'SQL'); +SELECT COUNT(*) +FROM seen_items +WHERE id=? +SQL +} + +sub _build__insert_sth { + my ($self) = @_; + + return $self->dbh->prepare(<<'SQL'); +INSERT INTO seen_items(id) +VALUES (?) +SQL +} + +after process => sub { + my ($self) = @_; + + $self->log->trace('after process'); + + $self->dbh->commit; +}; + +around process_entry => sub { + my ($orig,$self,$entry) = @_; + + $self->log->trace('around process_entry - begin'); + + return if $self->seen_already($entry); + + $self->log->trace('around process_entry - call original'); + + $self->$orig($entry); + + $self->mark_seen($entry); + + $self->log->trace('around process_entry - end'); + + return; +}; + +sub seen_already { + my ($self,$e) = @_; + + $self->log->trace('seen_already - begin'); + + my $id = $self->_entry_id($e); + + $self->_find_sth->execute($id); + my ($count) = $self->_find_sth->fetchrow_array; + + $self->log->trace("seen_already - end ($count)"); + + return $count; +} + +sub mark_seen { + my ($self,$e) = @_; + + $self->log->trace('mark_seen - begin'); + + my $id = $self->_entry_id($e); + + $self->_insert_sth->execute($id); + + $self->log->trace('mark_seen - end'); +} + +sub _entry_id { + my ($self,$e) = @_; + + my $body = $e->content->body; + my $content_digest = sha1_base64(encode('utf-8',$body)); + my $id = join '-',$e->id,$e->modified->iso8601,$content_digest; + return encode('utf-8',$id); +} + +1; diff --git a/lib/Feed/Role/FixDateTime.pm b/lib/Feed/Role/FixDateTime.pm new file mode 100644 index 0000000..86bc19a --- /dev/null +++ b/lib/Feed/Role/FixDateTime.pm @@ -0,0 +1,29 @@ +package Feed::Role::FixDateTime; +use Moose::Role; +use 5.016; +use namespace::autoclean; +use DateTime; + +requires 'process_entry'; + +before process_entry => sub { + my ($self,$entry) = @_; + + $self->log->trace('before process_entry - begin'); + + for my $f ('issued','modified') { + my $date = $entry->$f; + if (!$date) { + $date = DateTime->from_epoch(epoch=>0); + } + if ($date && $date->time_zone->is_floating) { + $date->set_time_zone('UTC'); + } + + $entry->$f($date); + } + + $self->log->trace('before process_entry - end'); +}; + +1; diff --git a/lib/Feed/Role/MailDir.pm b/lib/Feed/Role/MailDir.pm new file mode 100644 index 0000000..f7cfc20 --- /dev/null +++ b/lib/Feed/Role/MailDir.pm @@ -0,0 +1,76 @@ +package Feed::Role::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::HelperRole::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/Role/Printer.pm b/lib/Feed/Role/Printer.pm new file mode 100644 index 0000000..44b05a8 --- /dev/null +++ b/lib/Feed/Role/Printer.pm @@ -0,0 +1,28 @@ +package Feed::Role::Printer; +use Moose::Role; +use 5.016; +use namespace::autoclean; + +requires 'process'; + +before process => sub { + my ($self) = @_; + + say $self->title; +}; + +sub process_entry { + my ($self,$entry) = @_; + + $self->log->trace('process_entry - begin'); + + for my $f (qw(id author title link issued modified)) { + say " $f:",$entry->$f//''; + } + say $entry->content->body; + say ''; + + $self->log->trace('process_entry - end'); +} + +1; -- cgit v1.2.3