FS mailstore & tests

the store has also gained a ->remove method

5 files changed, 223 insertions, 4 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;
diff --git a/t/lib/Test/Sietima/MailStore.pm b/t/lib/Test/Sietima/MailStore.pm
index 60054c3..2925fd3 100644
--- a/t/lib/Test/Sietima/MailStore.pm
+++ b/t/lib/Test/Sietima/MailStore.pm
@@ -1,7 +1,8 @@
 package Test::Sietima::MailStore;
 use Moo;
 use Sietima::Policy;
-use List::AllUtils qw(all);
+use List::AllUtils qw(all first_index);
+use Digest::SHA1 qw(sha1_hex);
 use namespace::clean;
 
 with 'Sietima::MailStore';
@@ -14,10 +15,11 @@ has _mails => (
 sub clear { shift->_mails([]) }
 
 sub store ($self,$mail,@tags) {
-    my $id = time();
+    my $str = $mail->as_string;
+    my $id = sha1_hex($str);
     push $self->_mails->@*, {
         id => $id,
-        mail => $mail->as_string,
+        mail => $str,
         tags => { map {$_ => 1;} @tags, },
     };
     return $id;
@@ -45,4 +47,11 @@ sub retrieve_by_id ($self,$id) {
     return;
 }
 
+sub remove($self,$id) {
+    my $idx = first_index { $_->{id} eq $id } $self->_mails->@*;
+    return unless defined $idx;
+    splice $self->_mails->@*,$idx,1;
+    return;
+}
+
 1;
diff --git a/t/tests/sietima/mailstore.t b/t/tests/sietima/mailstore.t
new file mode 100644
index 0000000..2c2c74a
--- /dev/null
+++ b/t/tests/sietima/mailstore.t
@@ -0,0 +1,117 @@
+#!perl
+use lib 't/lib';
+use Test::Sietima;
+use Email::Stuffer;
+use Path::Tiny;
+
+sub mkmail($id) {
+    Email::Stuffer
+          ->from("from-${id}\@example.com")
+          ->to("to-${id}\@example.com")
+          ->subject("subject $id")
+          ->text_body("body $id \nbody body\n")
+          ->email;
+}
+
+sub chkmail($id) {
+    object {
+        call [header=>'from'] => "from-${id}\@example.com";
+        call [header=>'to'] => "to-${id}\@example.com";
+        call [header=>'subject'] => "subject $id";
+        call body => match qr{\bbody \Q$id\E\b};
+    };
+}
+
+sub chk_multimail(@ids) {
+    return bag {
+        for my $id (@ids) {
+            item hash {
+                field id => D();
+                field mail => chkmail($id);
+                end;
+            };
+        }
+        end;
+    };
+}
+
+sub test_store($store) {
+    my %stored_id;
+
+    subtest 'storing' => sub {
+        ok($stored_id{1}=$store->store(mkmail(1),'tag1','tag2'));
+        ok($stored_id{2}=$store->store(mkmail(2),'tag2'));
+        ok($stored_id{3}=$store->store(mkmail(3),'tag1'));
+    };
+
+    subtest 'retrieving by id' => sub {
+        is(
+            $store->retrieve_by_id($stored_id{$_}),
+            chkmail($_),
+        ) for 1..3;
+    };
+
+    subtest 'retrieving by tag' => sub {
+        my $tag1 = $store->retrieve_by_tags('tag1');
+        is(
+            $tag1,
+            chk_multimail(1,3),
+            'tag1 should have mails 1 & 3',
+        );
+
+        my $tag2 = $store->retrieve_by_tags('tag2');
+        is(
+            $tag2,
+            chk_multimail(1,2),
+            'tag1 should have mails 1 & 2',
+        );
+
+        my $tag12 = $store->retrieve_by_tags('tag2','tag1');
+        is(
+            $tag12,
+            chk_multimail(1),
+            'tag1+tag2 should have mail 1',
+        );
+
+        my $tag_all = $store->retrieve_by_tags();
+        is(
+            $tag_all,
+            chk_multimail(1,2,3),
+            'no tags should retrieve all mails',
+        );
+    };
+
+    subtest 'removing' => sub {
+        $store->remove($stored_id{2});
+        is(
+            $store->retrieve_by_tags('tag2'),
+            chk_multimail(1),
+            'remove should remove',
+        );
+    };
+
+    subtest 'clearing' => sub {
+        $store->clear;
+        is(
+            $store->retrieve_by_tags(),
+            [],
+            'clear should clear',
+        );
+    };
+}
+
+subtest 'test store' => sub {
+    require Test::Sietima::MailStore;
+
+    test_store(Test::Sietima::MailStore->new);
+};
+
+subtest 'file store' => sub {
+    require Sietima::MailStore::FS;
+
+    my $root = Path::Tiny->tempdir;
+
+    test_store(Test::Sietima::MailStore->new({root => $root}));
+};
+
+done_testing;