From: Chris Nehren Date: Wed, 5 Aug 2009 02:36:52 +0000 (-0400) Subject: very simple, very stupid proof of concept X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FEmail-Archive.git;a=commitdiff_plain;h=8581da381ad4c1b81604271a934dab2c7862df56 very simple, very stupid proof of concept This was written in one hacking session at a coffeeshop. It's not the best code, for sure, but it's a starting point. The files in lib/auto are there for now so you can do perl -Mlib=lib -MEmail::Archive .... and also so you can run test_run, which is the only bit of tests this code has presently. All that said, the hard part is done: there's no longer a blank slate for this project in my mind. --- diff --git a/lib/Email/Archive.pm b/lib/Email/Archive.pm new file mode 100644 index 0000000..83d86d1 --- /dev/null +++ b/lib/Email/Archive.pm @@ -0,0 +1,35 @@ +package Email::Archive; +use Moose; +use Module::Load; + +has storage => ( + is => 'rw', + does => 'Email::Archive::Storage', + handles => [qw/ + store + retrieve + search + /], + lazy_build => 1, +); + +has dsn => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +has storage_class => ( + is => 'ro', + isa => 'Str', + required => 1, + default => 'Email::Archive::Storage::DBI', +); + +sub _build_storage { + my ($self) = @_; + load $self->storage_class; + my $storage = $self->storage_class->new(dsn => $self->dsn); +} + +1; diff --git a/lib/Email/Archive/Storage.pm b/lib/Email/Archive/Storage.pm new file mode 100644 index 0000000..3c9a6ff --- /dev/null +++ b/lib/Email/Archive/Storage.pm @@ -0,0 +1,5 @@ +package Email::Archive::Storage; +use Moose::Role; + +requires qw/store retrieve search/; +1; diff --git a/lib/Email/Archive/Storage/DBI.pm b/lib/Email/Archive/Storage/DBI.pm new file mode 100644 index 0000000..2017b10 --- /dev/null +++ b/lib/Email/Archive/Storage/DBI.pm @@ -0,0 +1,113 @@ +package Email::Archive::Storage::DBI; +use Moose; +use DBI; +use File::ShareDir 'module_file'; +use File::Slurp 'read_file'; +use Email::Simple::Creator; +use Email::Abstract; +use SQL::Abstract; +use autodie; +with q/Email::Archive::Storage/; + +has dsn => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +has sqla => ( + is => 'ro', + isa => 'SQL::Abstract', + lazy => 1, + default => sub { SQL::Abstract->new }, + handles => [qw/ + select + insert + /], +); + +has dbh => ( + is => 'rw', + isa => 'DBI::db', + handles => [qw/ + prepare + do + /], +); + +has deployed_schema_version => ( + is => 'rw', + isa => 'Int', + default => 0, +); + +my $SCHEMA_VERSION = 0; + +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); +} + +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; + return Email::Simple->create( + header => [ + From => $message->{from_addr}, + To => $message->{to_addr}, + Subject => $message->{subject}, + ], + body => $message->{body}, + ); +} + +sub retrieve { + my ($self, $message_id) = shift; + $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); +} + +sub BUILD { + my ($self) = @_; + $self->dbh(DBI->connect($self->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; + } +} + +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+$/; + } +} + +1; diff --git a/lib/auto/Email/Archive/Storage/DBI/insert_sql.txt b/lib/auto/Email/Archive/Storage/DBI/insert_sql.txt new file mode 100644 index 0000000..5432eb3 --- /dev/null +++ b/lib/auto/Email/Archive/Storage/DBI/insert_sql.txt @@ -0,0 +1,8 @@ +INSERT INTO messages ( + message_id, + from_addr, + to_addr, + cc, + subject, + body +) VALUES (?, ?, ?, ?, ?, ?); diff --git a/lib/auto/Email/Archive/Storage/DBI/latest_schema.txt b/lib/auto/Email/Archive/Storage/DBI/latest_schema.txt new file mode 100644 index 0000000..8e41d3d --- /dev/null +++ b/lib/auto/Email/Archive/Storage/DBI/latest_schema.txt @@ -0,0 +1,13 @@ +CREATE TABLE messages ( + message_id VARCHAR(50) PRIMARY KEY, + from_addr VARCHAR(255) NOT NULL DEFAULT '', + to_addr VARCHAR(255) NOT NULL DEFAULT '', + cc VARCHAR(255) NOT NULL DEFAULT '', + subject VARCHAR(255) NOT NULL DEFAULT '', + date VARCHAR(255) NOT NULL DEFAULT '', + body TEXT NOT NULL DEFAULT '' +); + +CREATE TABLE metadata ( + schema_version INT PRIMARY KEY DEFAULT 0 +); diff --git a/test_run b/test_run new file mode 100644 index 0000000..0174bf4 --- /dev/null +++ b/test_run @@ -0,0 +1,25 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Email::Simple; +use Email::Simple::Creator; + +use lib 'lib'; +use Email::Archive; + +my $email = Email::Simple->create( + header => [ + From => 'casey@geeknest.com', + To => 'drain@example.com', + Subject => 'Message in a bottle', + 'Message-ID' => 'helloworld', + ], + body => 'hello there!' +); + +my $e = Email::Archive->new({dsn => 'dbi:SQLite:dbname=test.db'}); +print "sending @{[$email->as_string]}\n"; +$e->store($email); + +my $found = $e->retrieve('helloworld'); +print $found->as_string;