diff options
Diffstat (limited to 'lib/Sietima/MailStore/FS.pm')
-rw-r--r-- | lib/Sietima/MailStore/FS.pm | 92 |
1 files changed, 92 insertions, 0 deletions
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; |