From: Mugen Kenichi <mugen.kenichi@uninets.eu>
Date: Wed, 28 Sep 2011 12:32:39 +0000 (+0200)
Subject: added mongodb storage engine
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=20b4be81745b0c09a878c9375b351417bf4be3c1;p=p5sagit%2FEmail-Archive.git

added mongodb storage engine
---

diff --git a/lib/Email/Archive.pm b/lib/Email/Archive.pm
index e34d618..16cb782 100644
--- a/lib/Email/Archive.pm
+++ b/lib/Email/Archive.pm
@@ -31,6 +31,10 @@ I only uploaded this to get it out there and kick myself into making it more
 useful. As you can see it's not documented or tested yet. I put this together
 mostly in one evening in a coffeeshop. It shows in some ways. caveat programmer.
 
+=head1 SYNOPSIS
+
+Email::Archive provides an interface to store emails. Storage engines should implement 
+
 =head1 LICENSE
 
 This library may be used under the same terms as Perl itself.
diff --git a/lib/Email/Archive/Storage/MongoDB.pm b/lib/Email/Archive/Storage/MongoDB.pm
new file mode 100644
index 0000000..4c6bd94
--- /dev/null
+++ b/lib/Email/Archive/Storage/MongoDB.pm
@@ -0,0 +1,86 @@
+package Email::Archive::Storage::MongoDB;
+use Moo;
+use Carp;
+use Email::MIME;
+use Email::Abstract;
+use MongoDB;
+use autodie;
+with q/Email::Archive::Storage/;
+
+has host => (
+    is => 'rw',
+    default => 'localhost',
+);
+
+has port => (
+    is => 'rw',
+    default => 27017,
+);
+
+has database => (
+    is => 'rw',
+);
+
+has collection => (
+    is => 'rw',
+);
+
+sub store {
+  my ($self, $email) = @_;
+  $email = Email::Abstract->new($email);
+  $self->collection->insert({
+    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->collection->find_one($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 storage_connect {
+  my ($self, $mongo_con_info) = @_;
+  if (defined $mongo_con_info){
+    # should look like host:port:database
+    my ($host, $port, $database, $collection) = split ':', $mongo_con_info;
+    $self->host($host);
+    $self->port($port);
+    $self->database($database);
+    $self->collection($collection);
+  }
+
+  my $conn = MongoDB::Connection->new(
+    host => $self->host,
+    port => $self->port,
+  );
+
+  my $datab = $self->database;
+  my $collec = $self->collection;
+
+  my $db = $conn->$datab;
+  my $coll = $db->$collec;
+
+  # replace name with actual collection object
+  $self->collection($coll);
+
+  return 1;
+}
diff --git a/t/basic.t b/t/basic.t
index 4dbdc75..36ee684 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -26,17 +26,7 @@ my $found = $e->retrieve('helloworld');
 cmp_ok($found->header('subject'), 'eq', "Message in a bottle",
   "can find stored message by ID");
 
-my $e_dbic = Email::Archive->new(
-    storage => Email::Archive::Storage::DBIC->new,
-);
-$e_dbic->connect('dbi:SQLite:dbname=t/test_dbic.db');
-$e_dbic->store($email);
-
-$found = $e_dbic->retrieve('helloworld');
-cmp_ok($found->header('subject'), 'eq', "Message in a bottle",
-  "can find stored message by ID");
-
-
 done_testing;
+
 unlink 't/test.db';
-unlink 't/dbic_test.db';
+
diff --git a/t/dbic.t b/t/dbic.t
new file mode 100644
index 0000000..386ab16
--- /dev/null
+++ b/t/dbic.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Email::MIME;
+
+use Test::More;
+
+use Email::Archive;
+use Email::Archive::Storage::DBIC;
+
+my $email = Email::MIME->create(
+    header => [
+      From    => 'foo@example.com',
+      To      => 'drain@example.com',
+      Subject => 'Message in a bottle',
+      'Message-ID' => 'helloworld',
+    ],
+    body => 'hello there!'
+);
+
+my $e = Email::Archive->new(
+    storage => Email::Archive::Storage::DBIC->new,
+);
+$e->connect('dbi:SQLite:dbname=t/test_dbic.db');
+$e->store($email);
+
+my $found = $e->retrieve('helloworld');
+cmp_ok($found->header('subject'), 'eq', "Message in a bottle",
+  "can find stored message by ID");
+
+
+done_testing;
+
+unlink 't/test_dbic.db';
+
diff --git a/t/mongodb.t b/t/mongodb.t
new file mode 100644
index 0000000..6a81957
--- /dev/null
+++ b/t/mongodb.t
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Email::MIME;
+
+use Test::More;
+
+use Email::Archive;
+use Email::Archive::Storage::MongoDB;
+
+my $email = Email::MIME->create(
+  header => [
+    From    => 'foo@example.com',
+    To      => 'drain@example.com',
+    Subject => 'Message in a bottle',
+    'Message-ID' => 'helloworld',
+  ],
+  body => 'hello there!'
+);
+
+my $storage = Email::Archive::Storage::MongoDB->new(
+  host       => 'localhost',
+  port       => 27017,
+  database   => 'EmailArchiveTestMongoDB',
+  collection => 'emails',
+);
+
+my $e = Email::Archive->new(
+  storage => $storage,
+);
+
+$e->connect;
+$e->store($email);
+
+my $found = $e->retrieve('helloworld');
+
+$found = $e->retrieve('helloworld');
+cmp_ok($found->header('subject'), 'eq', "Message in a bottle",
+  "can find stored message by ID");
+
+
+done_testing;
+
+my $conn = MongoDB::Connection->new(
+    host => 'localhost',
+    port => 27017
+);
+
+$conn->EmailArchiveTestMongoDB->drop;
+