File Coverage

blib/lib/Email/Sender/Transport/SQLite.pm
Criterion Covered Total %
statement 41 41 100.0
branch 3 4 75.0
condition 4 5 80.0
subroutine 7 7 100.0
pod 1 3 33.3
total 56 60 93.3


line stmt bran cond sub pod time code
1             package Email::Sender::Transport::SQLite 0.092004;
2             # ABSTRACT: deliver mail to an sqlite db for testing
3              
4 1     1   93183 use Moo;
  1         11695  
  1         5  
5             with 'Email::Sender::Transport';
6              
7             #pod =head1 DESCRIPTION
8             #pod
9             #pod This transport makes deliveries to an SQLite database, creating it if needed.
10             #pod The SQLite transport is intended for testing programs that fork or that
11             #pod otherwise can't use the Test transport. It is not meant for robust, long-term
12             #pod storage of mail.
13             #pod
14             #pod The database will be created in the file named by the C attribute,
15             #pod which defaults to F.
16             #pod
17             #pod The database will have two tables:
18             #pod
19             #pod CREATE TABLE emails (
20             #pod id INTEGER PRIMARY KEY,
21             #pod body varchar NOT NULL,
22             #pod env_from varchar NOT NULL
23             #pod );
24             #pod
25             #pod CREATE TABLE recipients (
26             #pod id INTEGER PRIMARY KEY,
27             #pod email_id integer NOT NULL,
28             #pod env_to varchar NOT NULL
29             #pod );
30             #pod
31             #pod Each delivery will insert one row to the F table and one row per
32             #pod recipient to the F table.
33             #pod
34             #pod Delivery to this transport should never fail.
35             #pod
36             #pod =cut
37              
38 1     1   3128 use DBI;
  1         17882  
  1         557  
39              
40             has _dbh => (
41             is => 'rw',
42             init_arg => undef,
43             );
44              
45             has _dbh_pid => (
46             is => 'rw',
47             init_arg => undef,
48             default => sub { $$ },
49             );
50              
51             sub dbh {
52 3     3 0 9 my ($self) = @_;
53              
54             ## no critic Punctuation
55 3         14 my $existing_dbh = $self->_dbh;
56              
57 3 100 66     35 return $existing_dbh if $existing_dbh and $self->_dbh_pid == $$;
58              
59 1         28 my $must_setup = ! -e $self->db_file;
60 1         13 my $dbh = DBI->connect("dbi:SQLite:dbname=" . $self->db_file);
61              
62 1         13633 $self->_dbh($dbh);
63 1         6 $self->_dbh_pid($$);
64 1 50       7 $self->_setup_dbh if $must_setup;
65              
66 1         12618 return $dbh;
67             }
68              
69             has db_file => (
70             is => 'ro',
71             default => sub { 'email.db' },
72             );
73              
74             sub _setup_dbh {
75 1     1   4 my ($self) = @_;
76 1         3 my $dbh = $self->_dbh;
77              
78 1         7 $dbh->do('
79             CREATE TABLE emails (
80             id INTEGER PRIMARY KEY,
81             body varchar NOT NULL,
82             env_from varchar NOT NULL
83             );
84             ');
85              
86 1         14999 $dbh->do('
87             CREATE TABLE recipients (
88             id INTEGER PRIMARY KEY,
89             email_id integer NOT NULL,
90             env_to varchar NOT NULL
91             );
92             ');
93             }
94              
95             sub send_email {
96 2     2 0 2260 my ($self, $email, $env) = @_;
97              
98 2         10 my $message = $email->as_string;
99 2         232 my $to = $env->{to};
100 2         5 my $from = $env->{from};
101              
102 2         8 my $dbh = $self->dbh;
103              
104 2         16 $dbh->do(
105             "INSERT INTO emails (body, env_from) VALUES (?, ?)",
106             undef,
107             $message,
108             $from,
109             );
110              
111 2         22528 my $id = $dbh->last_insert_id((undef) x 4);
112              
113 2         10 for my $addr (@$to) {
114 3         11768 $dbh->do(
115             "INSERT INTO recipients (email_id, env_to) VALUES (?, ?)",
116             undef,
117             $id,
118             $addr,
119             );
120             }
121              
122 2         21981 return $self->success;
123             }
124              
125             #pod =method retrieve_deliveries
126             #pod
127             #pod my @deliveries = $transport->retrieve_deliveries;
128             #pod
129             #pod This method returns a list of deliveries made so far to this transport's
130             #pod database. They're returned in order of insertion, and each delivery is a hash
131             #pod reference like this:
132             #pod
133             #pod id => $db_primary_key,
134             #pod env_from => $envelope_sender,
135             #pod env_to => \@all_env_recipients,
136             #pod message => $text_of_email_sent
137             #pod
138             #pod More fields may be added in the future.
139             #pod
140             #pod =cut
141              
142             sub retrieve_deliveries {
143 1     1 1 5895 my ($self) = @_;
144              
145 1         5 my $rows = $self->dbh->selectall_arrayref(
146             "SELECT e.id, env_from, env_to, body
147             FROM emails e
148             JOIN recipients r ON r.email_id = e.id
149             ORDER BY e.id"
150             );
151              
152 1         188 my %delivery;
153              
154 1         5 for my $d (@$rows) {
155 3   100     24 $delivery{$d->[0]} ||= {
156             id => $d->[0],
157             env_from => $d->[1],
158             env_to => [ ],
159             message => $d->[3],
160             };
161              
162 3         5 push @{ $delivery{$d->[0]}{env_to} }, $d->[2];
  3         10  
163             }
164              
165 1         11 return @delivery{ sort { $a <=> $b } keys %delivery };
  1         11  
166             }
167              
168             __PACKAGE__->meta->make_immutable;
169 1     1   10 no Moo;
  1         3  
  1         8  
170             1;
171              
172             __END__