lib/Email/Archive/Storage/DBI.pm

   1 package Email::Archive::Storage::DBI;
   2 use Moose;
   3 use Carp;
   4 use DBI;
   5 use File::ShareDir 'module_file';
   6 use File::Slurp 'read_file';
   7 use Email::MIME;
   8 use Email::Abstract;
   9 use SQL::Abstract;
  10 use autodie;
  11 with q/Email::Archive::Storage/;
  12
  13 has sqla => (
  14   is   => 'ro',
  15   isa  => 'SQL::Abstract',
  16   lazy => 1,
  17   default => sub { SQL::Abstract->new },
  18   handles => [qw/
  19     select
  20     insert
  21   /],
  22 );
  23
  24 has dbh => (
  25   is   => 'rw',
  26   isa  => 'DBI::db',
  27   handles => [qw/
  28     prepare
  29     do
  30   /],
  31 );
  32
  33 has deployed_schema_version => (
  34   is  => 'rw',
  35   isa => 'Int',
  36   default => 0,
  37 );
  38
  39
  40 my $SCHEMA_VERSION = 1;
  41
  42 sub store {
  43   my ($self, $email) = @_;
  44   # passing an E::A to E::A->new is perfectly valid
  45   $email = Email::Abstract->new($email);
  46   my $fields = {
  47     from_addr   => $email->get_header('From'),
  48     to_addr     => $email->get_header('To'),
  49     date        => $email->get_header('Date'),
  50     subject     => $email->get_header('Subject'),
  51     message_id  => $email->get_header('Message-ID'),
  52     body        => $email->get_body,
  53   };
  54   my ($sql, @bind) = $self->insert('messages', $fields);
  55   my $sth = $self->prepare($sql);
  56   $sth->execute(@bind);
  57 }
  58
  59 sub search {
  60   my ($self, $attribs) = shift;
  61   my ($sql, @bind) = $self->select('messages', [qw/message_id from_addr to_addr date subject body/], $attribs);
  62   my $sth = $self->prepare($sql);
  63   $sth->execute(@bind);
  64   my ($message) = $sth->fetchrow_hashref;
  65   return Email::MIME->create(
  66     header => [
  67       From    => $message->{from_addr},
  68       To      => $message->{to_addr},
  69       Subject => $message->{subject},
  70     ],
  71     body => $message->{body},
  72   );
  73 }
  74
  75 sub retrieve {
  76   my ($self, $message_id) = shift;
  77   $self->search({message_id => $message_id});
  78 }
  79
  80 sub _deploy {
  81   my ($self) = @_;
  82   my $schema = module_file('Email::Archive::Storage::DBI', 'latest_schema.txt');
  83   my $sql = read_file($schema);
  84   $self->do($sql);
  85 }
  86
  87 sub _deployed {
  88   my ($self) = @_;
  89   my $schema_version = eval { $self->selectcol_array('SELECT schema_version FROM metadata') };
  90   if(defined $schema_version and $schema_version =~ /^\d+$/) {
  91     $self->deployed_schema_version($schema_version);
  92     return $schema_version =~ /^\d+$/;
  93   }
  94 }
  95
  96 sub storage_connect {
  97   my ($self, $dsn) = @_;
  98   $self->dbh(DBI->connect($dsn));
  99   if(!$self->_deployed) {
 100     $self->_deploy;
 101   }
 102   elsif(!$self->_is_latest_schema) {
 103     croak sprintf "Schema version %d not supported; we support version " .
 104                   "$SCHEMA_VERSION. Please upgrade your schema before "  .
 105                   "continuing.", $self->_deployed_schema_version;
 106   }
 107 }
 108
 109 1;