1 package Email::Archive::Storage::DBI;
5 use File::ShareDir 'module_file';
6 use File::Slurp 'read_file';
10 use Scalar::Util qw(looks_like_number);
12 with q/Email::Archive::Storage/;
17 ref $_[0] eq 'SQL::Abstract' or die "sqla must be a SQL::Abstract object"
20 default => sub { SQL::Abstract->new },
30 ref $_[0] eq 'DBI::db' or die "dbh must be a DBI handle",
38 has deployed_schema_version => (
41 looks_like_number($_[0]) or die "deployed_schema_version must be integer"
47 my $SCHEMA_VERSION = 1;
50 my ($self, $email) = @_;
51 # passing an E::A to E::A->new is perfectly valid
52 $email = Email::Abstract->new($email);
54 from_addr => $email->get_header('From'),
55 to_addr => $email->get_header('To'),
56 date => $email->get_header('Date'),
57 subject => $email->get_header('Subject'),
58 message_id => $email->get_header('Message-ID'),
59 body => $email->get_body,
61 my ($sql, @bind) = $self->insert('messages', $fields);
62 my $sth = $self->prepare($sql);
67 my ($self, $attribs) = shift;
68 my ($sql, @bind) = $self->select('messages', [qw/message_id from_addr to_addr date subject body/], $attribs);
69 my $sth = $self->prepare($sql);
71 my ($message) = $sth->fetchrow_hashref;
72 return Email::MIME->create(
74 From => $message->{from_addr},
75 To => $message->{to_addr},
76 Subject => $message->{subject},
78 body => $message->{body},
83 my ($self, $message_id) = shift;
84 $self->search({message_id => $message_id});
89 my $schema = module_file('Email::Archive::Storage::DBI', 'latest_schema.txt');
90 my $sql = read_file($schema);
96 my $schema_version = eval { $self->selectcol_array('SELECT schema_version FROM metadata') };
97 if(defined $schema_version and $schema_version =~ /^\d+$/) {
98 $self->deployed_schema_version($schema_version);
99 return $schema_version =~ /^\d+$/;
103 sub storage_connect {
104 my ($self, $dsn) = @_;
105 $self->dbh(DBI->connect($dsn));
106 if(!$self->_deployed) {
109 elsif(!$self->_is_latest_schema) {
110 croak sprintf "Schema version %d not supported; we support version " .
111 "$SCHEMA_VERSION. Please upgrade your schema before " .
112 "continuing.", $self->_deployed_schema_version;