From: Mugen Kenichi Date: Fri, 23 Sep 2011 15:58:49 +0000 (+0200) Subject: utilize DBIx::Class X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5161b4d90a8f226a86ddb02f429a0b8539a35a9;p=p5sagit%2FEmail-Archive.git utilize DBIx::Class --- diff --git a/lib/Email/Archive.pm b/lib/Email/Archive.pm index 8d17fcb..e34d618 100644 --- 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 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 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 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 --- 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; +