utilize DBIx::Class

diff --git a/lib/Email/Archive.pm b/lib/Email/Archive.pm
index 8d17fcb..e34d618 100644 (file)
--- a/lib/Email/Archive.pm
+++ b/lib/Email/Archive.pm
@@ -19,7 +19,7 @@ has storage => (
 1;
 
 
-__END__ 
+__END__
 
 =head1 NAME
 

diff --git a/lib/Email/Archive/Schema.pm b/lib/Email/Archive/Schema.pm
new file mode 100644 (file)
index 0000000..bb26edd
--- /dev/null
+++ b/lib/Email/Archive/Schema.pm
@@ -0,0 +1,10 @@
+package Email::Archive::Schema;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Schema';
+
+__PACKAGE__->load_namespaces;
+
+1;

diff --git a/lib/Email/Archive/Schema/Result/Messages.pm b/lib/Email/Archive/Schema/Result/Messages.pm
new file mode 100644 (file)
index 0000000..d6e9796
--- /dev/null
+++ b/lib/Email/Archive/Schema/Result/Messages.pm
@@ -0,0 +1,57 @@
+package Email::Archive::Schema::Result::Messages;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Core';
+
+__PACKAGE__->table('messages');
+
+__PACKAGE__->add_columns(
+  'message_id', {
+    data_type => 'varchar',
+    default_value => '',
+    is_nullable => 0,
+    size => 255,
+  },
+  'from_addr', {
+    data_type => 'varchar',
+    default_value => '',
+    is_nullable => 0,
+    size => 255,
+  },
+  'to_addr', {
+    data_type => 'varchar',
+    default_value => '',
+    is_nullable => 0,
+    size => 255,
+  },
+  'cc', {
+    data_type => 'varchar',
+    default_value => '',
+    is_nullable => 0,
+    size => 255,
+  },
+  'subject', {
+    data_type => 'varchar',
+    default_value => '',
+    is_nullable => 0,
+    size => 255,
+  },
+  'date', {
+    data_type => 'varchar',
+    default_value => '',
+    is_nullable => 0,
+    size => 255,
+  },
+  'body', {
+    data_type => 'text',
+    default_value => '',
+    is_nullable => 0,
+  },
+);
+
+__PACKAGE__->set_primary_key('message_id');
+
+1;
+

diff --git a/lib/Email/Archive/Schema/Result/Metadata.pm b/lib/Email/Archive/Schema/Result/Metadata.pm
new file mode 100644 (file)
index 0000000..aede4af
--- /dev/null
+++ b/lib/Email/Archive/Schema/Result/Metadata.pm
@@ -0,0 +1,21 @@
+package Email::Archive::Schema::Result::Metadata;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Core';
+
+__PACKAGE__->table('metadata');
+
+__PACKAGE__->add_columns(
+  'schema_version', {
+    data_type => 'integer',
+    extra => { unsigned => 1 },
+    default_value => 0,
+  },
+);
+
+__PACKAGE__->set_primary_key('schema_version');
+
+1;
+

diff --git a/lib/Email/Archive/Storage/DBI.pm b/lib/Email/Archive/Storage/DBI.pm
index 3ee81f6..1dcf8a7 100644 (file)
--- a/lib/Email/Archive/Storage/DBI.pm
+++ b/lib/Email/Archive/Storage/DBI.pm
@@ -1,116 +1,78 @@
 package Email::Archive::Storage::DBI;
 use Moo;
 use Carp;
-use DBI;
-use File::ShareDir 'module_file';
-use File::Slurp 'read_file';
 use Email::MIME;
 use Email::Abstract;
-use SQL::Abstract;
-use Scalar::Util qw(looks_like_number);
+use Email::Archive::Schema;
 use autodie;
+use Try::Tiny;
 with q/Email::Archive::Storage/;
 
-has sqla => (
-  is   => 'ro',
-  isa  => sub { 
-    ref $_[0] eq 'SQL::Abstract' or die "sqla must be a SQL::Abstract object" 
-  },
-  lazy => 1,
-  default => sub { SQL::Abstract->new },
-  handles => [qw/
-    select
-    insert
-  /],
-);
-
-has dbh => (
-  is   => 'rw',
-  isa  => sub { 
-    ref $_[0] eq 'DBI::db' or die "dbh must be a DBI handle",
-  },
-  handles => [qw/
-    prepare
-    do
-  /],
-);
-
-has deployed_schema_version => (
-  is  => 'rw',
+has schema => (
+  is => 'rw',
   isa => sub {
-    looks_like_number($_[0]) or die "deployed_schema_version must be integer"
+    ref $_[0] eq 'Email::Archive::Schema' or die "schema must be a Email::Archive schema",
   },
-  default => 0,
 );
 
-
-my $SCHEMA_VERSION = 1;
-
 sub store {
   my ($self, $email) = @_;
-  # passing an E::A to E::A->new is perfectly valid
   $email = Email::Abstract->new($email);
-  my $fields = {
-    from_addr   => $email->get_header('From'),
-    to_addr     => $email->get_header('To'),
-    date        => $email->get_header('Date'),
-    subject     => $email->get_header('Subject'),
-    message_id  => $email->get_header('Message-ID'),
-    body        => $email->get_body,
-  };
-  my ($sql, @bind) = $self->insert('messages', $fields);
-  my $sth = $self->prepare($sql);
-  $sth->execute(@bind);
+  $self->schema->resultset('Messages')->update_or_create({
+    message_id => $email->get_header('Message-ID'),
+    from_addr  => $email->get_header('From'),
+    to_addr    => $email->get_header('To'),
+    date       => $email->get_header('Date'),
+    subject    => $email->get_header('Subject'),
+    body       => $email->get_body,
+  });
 }
 
 sub search {
-  my ($self, $attribs) = shift;
-  my ($sql, @bind) = $self->select('messages', [qw/message_id from_addr to_addr date subject body/], $attribs);
-  my $sth = $self->prepare($sql);
-  $sth->execute(@bind);
-  my ($message) = $sth->fetchrow_hashref;
+  my ($self, $attribs) = @_;
+  my $message = $self->schema
+                  ->resultset('Messages')
+                  ->find($attribs);
   return Email::MIME->create(
     header => [
-      From    => $message->{from_addr},
-      To      => $message->{to_addr},
-      Subject => $message->{subject},
+      From    => $message->from_addr,
+      To      => $message->to_addr,
+      Subject => $message->subject,
     ],
-    body => $message->{body},
+    body => $message->body,
   );
 }
 
 sub retrieve {
-  my ($self, $message_id) = shift;
-  $self->search({message_id => $message_id});
+  my ($self, $message_id) = @_;
+  $self->search({ message_id => $message_id });
 }
 
 sub _deploy {
   my ($self) = @_;
-  my $schema = module_file('Email::Archive::Storage::DBI', 'latest_schema.txt');
-  my $sql = read_file($schema);
-  $self->do($sql);
+  $self->schema->deploy;
 }
 
 sub _deployed {
   my ($self) = @_;
-  my $schema_version = eval { $self->selectcol_array('SELECT schema_version FROM metadata') };
-  if(defined $schema_version and $schema_version =~ /^\d+$/) {
-    $self->deployed_schema_version($schema_version);
-    return $schema_version =~ /^\d+$/;
+  my $deployed = 1;
+  try {
+      # naive check if table metadata exists
+      $self->schema->resultset('Metadata')->all;
   }
+  catch {
+      $deployed = 0;
+  };
+
+  return $deployed;
 }
 
-sub storage_connect {
+sub storage_connect_dbic {
   my ($self, $dsn) = @_;
-  $self->dbh(DBI->connect($dsn));
-  if(!$self->_deployed) {
-    $self->_deploy;
-  }
-  elsif(!$self->_is_latest_schema) {
-    croak sprintf "Schema version %d not supported; we support version " .
-                  "$SCHEMA_VERSION. Please upgrade your schema before "  .
-                  "continuing.", $self->_deployed_schema_version;
-  }
+  $self->schema(Email::Archive::Schema->connect($dsn));
+  my $deployed = $self->_deployed;
+  $self->_deploy unless $deployed;
 }
 
 1;
+