FS mailstore & tests

the store has also gained a ->remove method

3 files changed, 94 insertions, 1 deletions

diff --git a/lib/Sietima/MailStore.pm b/lib/Sietima/MailStore.pm
index 6f0a2ab..d26d475 100644
--- a/lib/Sietima/MailStore.pm
+++ b/lib/Sietima/MailStore.pm
@@ -2,6 +2,6 @@ package Sietima::MailStore;
 use Moo::Role;
 use Sietima::Policy;
 
-requires 'store','retrieve_by_tags','retrieve_by_id';
+requires 'store','retrieve_by_tags','retrieve_by_id','remove','clear';
 
 1;
diff --git a/lib/Sietima/MailStore/FS.pm b/lib/Sietima/MailStore/FS.pm
new file mode 100644
index 0000000..1641c55
--- /dev/null
+++ b/lib/Sietima/MailStore/FS.pm
@@ -0,0 +1,92 @@
+package Sietima::MailStore::FS;
+use Moo;
+use Sietima::Policy;
+use Types::Path::Tiny qw(Dir);
+use Types::Standard qw(Object ArrayRef Str slurpy);
+use Type::Params qw(compile);
+use Sietima::Types qw(EmailMIME);
+use Digest::SHA1 qw(sha1_hex);
+use namespace::clean;
+
+with 'Sietima::MailStore';
+
+has root => (
+    is => 'ro',
+    required => 1,
+    isa => Dir,
+    coerce => 1,
+);
+
+has [qw(_tagdir _msgdir)] => ( is => 'lazy' );
+sub _build__tagdir($self) { $self->root->child('tags') }
+sub _build__msgdir($self) { $self->root->child('msgs') }
+
+sub BUILD($self,@) {
+    $self->$_->mkpath for qw(_tagdir _msgdir);
+    return;
+}
+
+sub clear($self) {
+    do { $self->$_->remove_tree;$self->$_->mkpath } for qw(_tagdir _msgdir);
+    return;
+}
+
+sub store($self,$mail,@tags) {
+    state $check = compile(Object,EmailMIME,slurpy ArrayRef[Str]);$check->(@_);
+
+    my $str = $mail->as_string;
+    my $id = sha1_hex($str);
+
+    $self->_msgdir->child($id)->spew_raw($str);
+
+    $self->_tagdir->child($_)->append("$id\n") for @tags;
+
+    return $id;
+}
+
+sub retrieve_by_id($self,$id) {
+    state $check = compile(Object,Str);$check->(@_);
+
+    my $msg_path = $self->_msgdir->child($id);
+    return unless -e $msg_path;
+    return Email::MIME->new($msg_path->slurp_raw);
+}
+
+sub _tagged_by($self,$tag) {
+    my $tag_file = $self->_tagdir->child($tag);
+    return unless -e $tag_file;
+    return $tag_file->lines({chomp=>1});
+}
+
+sub retrieve_by_tags($self,@tags) {
+    state $check = compile(Object,slurpy ArrayRef[Str]);$check->(@_);
+
+    my %msgs;
+    for my $tag (@tags) {
+        $_++ for @msgs{$self->_tagged_by($tag)};
+    }
+
+    my @ret;
+    for my $id (keys %msgs) {
+        next unless $msgs{$id} == @tags;
+        push @ret, {
+            id => $id,
+            mail => $self->retrieve_by_id($id),
+        };
+    }
+
+    return \@ret;
+}
+
+sub remove($self,$id) {
+    state $check = compile(Object,Str);$check->(@_);
+
+    for my $tag_file ($self->_tagdir->children) {
+        $tag_file->edit_lines( sub { /\A\Q$id\E\n?\z/ ? '' : $_ } );
+    }
+    $self->_msgdir->child($id)->remove;
+
+    return;
+}
+
+1;
diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm
index 89cac02..0d9fd58 100644
--- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm
+++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm
@@ -28,6 +28,7 @@ sub resume ($self,$mail_id) {
     my $mail = $self->mail_store->retrieve_by_id($mail_id);
     local $Sietima::Role::SubscriberOnly::let_it_pass=1;
     $self->handle_mail($mail);
+    $self->mail_store->remove($mail_id);
 }
 
 1;