File Coverage

blib/lib/Email/Archive/Storage/DBIC.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Email::Archive::Storage::DBIC;
2 2     2   1459 use Moo;
  2         4  
  2         13  
3 2     2   1739 use Carp;
  2         4  
  2         186  
4 2     2   13 use Email::MIME;
  2         4  
  2         59  
5 2     2   13 use Email::Abstract;
  2         5  
  2         50  
6 2     2   1551 use Email::Archive::Storage::DBIC::Schema;
  0            
  0            
7             use autodie;
8             use Try::Tiny;
9             with q/Email::Archive::Storage/;
10              
11             has schema => (
12             is => 'rw',
13             isa => sub {
14             ref $_[0] eq 'Email::Archive::Storage::DBIC::Schema' or die "schema must be a Email::Archive::Storage::DBIC schema",
15             },
16             );
17              
18             sub store {
19             my ($self, $email) = @_;
20             $email = Email::Abstract->new($email);
21             $self->schema->resultset('Messages')->update_or_create({
22             message_id => $email->get_header('Message-ID'),
23             from_addr => $email->get_header('From'),
24             to_addr => $email->get_header('To'),
25             date => $email->get_header('Date'),
26             subject => $email->get_header('Subject'),
27             body => $email->get_body,
28             });
29             }
30              
31             sub search {
32             my ($self, $attribs) = @_;
33             my $message = $self->schema
34             ->resultset('Messages')
35             ->find($attribs);
36             return Email::MIME->create(
37             header => [
38             From => $message->from_addr,
39             To => $message->to_addr,
40             Subject => $message->subject,
41             ],
42             body => $message->body,
43             );
44             }
45              
46             sub retrieve {
47             my ($self, $message_id) = @_;
48             $self->search({ message_id => $message_id });
49             }
50              
51             sub _deploy {
52             my ($self) = @_;
53             $self->schema->deploy;
54             }
55              
56             sub _deployed {
57             my ($self) = @_;
58             my $deployed = 1;
59             try {
60             # naive check if table metadata exists
61             $self->schema->resultset('Metadata')->all;
62             }
63             catch {
64             $deployed = 0;
65             };
66              
67             return $deployed;
68             }
69              
70             sub storage_connect {
71             my ($self, $dsn) = @_;
72             $self->schema(Email::Archive::Storage::DBIC::Schema->connect($dsn));
73             my $deployed = $self->_deployed;
74             $self->_deploy unless $deployed;
75             }
76              
77             1;
78              
79             __END__