From: Mugen Kenichi <mugen.kenichi@uninets.eu>
Date: Tue, 27 Sep 2011 11:11:40 +0000 (+0200)
Subject: Seperate DBIC Storage Engine
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ef49e6b82517f1795954c486f5c800d7df14e519;p=p5sagit%2FEmail-Archive.git

Seperate DBIC Storage Engine
---

diff --git a/lib/Email/Archive/Storage/DBI.pm b/lib/Email/Archive/Storage/DBI.pm
index 1dcf8a7..3ee81f6 100644
--- a/lib/Email/Archive/Storage/DBI.pm
+++ b/lib/Email/Archive/Storage/DBI.pm
@@ -1,78 +1,116 @@
 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 Email::Archive::Schema;
+use SQL::Abstract;
+use Scalar::Util qw(looks_like_number);
 use autodie;
-use Try::Tiny;
 with q/Email::Archive::Storage/;
 
-has schema => (
-  is => 'rw',
+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',
   isa => sub {
-    ref $_[0] eq 'Email::Archive::Schema' or die "schema must be a Email::Archive schema",
+    looks_like_number($_[0]) or die "deployed_schema_version must be integer"
   },
+  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);
-  $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,
-  });
+  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);
 }
 
 sub search {
-  my ($self, $attribs) = @_;
-  my $message = $self->schema
-                  ->resultset('Messages')
-                  ->find($attribs);
+  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;
   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) = @_;
-  $self->search({ message_id => $message_id });
+  my ($self, $message_id) = shift;
+  $self->search({message_id => $message_id});
 }
 
 sub _deploy {
   my ($self) = @_;
-  $self->schema->deploy;
+  my $schema = module_file('Email::Archive::Storage::DBI', 'latest_schema.txt');
+  my $sql = read_file($schema);
+  $self->do($sql);
 }
 
 sub _deployed {
   my ($self) = @_;
-  my $deployed = 1;
-  try {
-      # naive check if table metadata exists
-      $self->schema->resultset('Metadata')->all;
+  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+$/;
   }
-  catch {
-      $deployed = 0;
-  };
-
-  return $deployed;
 }
 
-sub storage_connect_dbic {
+sub storage_connect {
   my ($self, $dsn) = @_;
-  $self->schema(Email::Archive::Schema->connect($dsn));
-  my $deployed = $self->_deployed;
-  $self->_deploy unless $deployed;
+  $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;
+  }
 }
 
 1;
-
diff --git a/lib/Email/Archive/Storage/DBIC.pm b/lib/Email/Archive/Storage/DBIC.pm
new file mode 100644
index 0000000..1dcf8a7
--- /dev/null
+++ b/lib/Email/Archive/Storage/DBIC.pm
@@ -0,0 +1,78 @@
+package Email::Archive::Storage::DBI;
+use Moo;
+use Carp;
+use Email::MIME;
+use Email::Abstract;
+use Email::Archive::Schema;
+use autodie;
+use Try::Tiny;
+with q/Email::Archive::Storage/;
+
+has schema => (
+  is => 'rw',
+  isa => sub {
+    ref $_[0] eq 'Email::Archive::Schema' or die "schema must be a Email::Archive schema",
+  },
+);
+
+sub store {
+  my ($self, $email) = @_;
+  $email = Email::Abstract->new($email);
+  $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) = @_;
+  my $message = $self->schema
+                  ->resultset('Messages')
+                  ->find($attribs);
+  return Email::MIME->create(
+    header => [
+      From    => $message->from_addr,
+      To      => $message->to_addr,
+      Subject => $message->subject,
+    ],
+    body => $message->body,
+  );
+}
+
+sub retrieve {
+  my ($self, $message_id) = @_;
+  $self->search({ message_id => $message_id });
+}
+
+sub _deploy {
+  my ($self) = @_;
+  $self->schema->deploy;
+}
+
+sub _deployed {
+  my ($self) = @_;
+  my $deployed = 1;
+  try {
+      # naive check if table metadata exists
+      $self->schema->resultset('Metadata')->all;
+  }
+  catch {
+      $deployed = 0;
+  };
+
+  return $deployed;
+}
+
+sub storage_connect_dbic {
+  my ($self, $dsn) = @_;
+  $self->schema(Email::Archive::Schema->connect($dsn));
+  my $deployed = $self->_deployed;
+  $self->_deploy unless $deployed;
+}
+
+1;
+
diff --git a/lib/Email/Archive/Schema.pm b/lib/Email/Archive/Storage/DBIC/Schema.pm
similarity index 100%
rename from lib/Email/Archive/Schema.pm
rename to lib/Email/Archive/Storage/DBIC/Schema.pm
diff --git a/lib/Email/Archive/Schema/Result/Messages.pm b/lib/Email/Archive/Storage/DBIC/Schema/Result/Messages.pm
similarity index 100%
rename from lib/Email/Archive/Schema/Result/Messages.pm
rename to lib/Email/Archive/Storage/DBIC/Schema/Result/Messages.pm
diff --git a/lib/Email/Archive/Schema/Result/Metadata.pm b/lib/Email/Archive/Storage/DBIC/Schema/Result/Metadata.pm
similarity index 100%
rename from lib/Email/Archive/Schema/Result/Metadata.pm
rename to lib/Email/Archive/Storage/DBIC/Schema/Result/Metadata.pm