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 TagName);
use Digest::SHA qw(sha1_hex);
use namespace::clean;
our $VERSION = '1.0.4';
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 store($self,$mail,@tags) {
state $check = compile(Object,EmailMIME,slurpy ArrayRef[TagName]);$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_ids_by_tags($self,@tags) {
state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);
my %msgs;
if (@tags) {
for my $tag (@tags) {
$_++ for @msgs{$self->_tagged_by($tag)};
}
}
else {
$msgs{$_->basename}=0 for $self->_msgdir->children;
}
my @ret;
for my $id (keys %msgs) {
next unless $msgs{$id} == @tags;
push @ret, $id;
}
return \@ret;
}
sub retrieve_by_tags($self,@tags) {
state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);
my @ret;
for my $id ($self->retrieve_ids_by_tags(@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 { $_='' if /\A\Q$id\E\n?\z/ } );
}
$self->_msgdir->child($id)->remove;
return;
}
sub clear($self) {
do { $self->$_->remove_tree;$self->$_->mkpath } for qw(_tagdir _msgdir);
return;
}
1;
__END__