[prev] [thread] [next] [lurker] [Date index for 2005/02/08]
Author: simon
Date: 2005-02-08 12:54:42 +0000 (Tue, 08 Feb 2005)
New Revision: 1841
Added:
trunk/buscador/lib/
trunk/buscador/lib/Buscador.pm
trunk/buscador/lib/Buscador/
trunk/buscador/lib/Buscador/Addressing.pm
trunk/buscador/lib/Buscador/Atom.pm
trunk/buscador/lib/Buscador/Attachment.pm
trunk/buscador/lib/Buscador/Build.pm
trunk/buscador/lib/Buscador/Config.pm
trunk/buscador/lib/Buscador/Date.pm
trunk/buscador/lib/Buscador/Decorate.pm
trunk/buscador/lib/Buscador/Raw.pm
trunk/buscador/lib/Buscador/Recent.pm
trunk/buscador/lib/Buscador/Root.pm
trunk/buscador/lib/Buscador/Search.pm
trunk/buscador/lib/Buscador/Thread.pm
trunk/buscador/lib/Buscador/UTF8.pm
trunk/buscador/lib/Buscador/Vote.pm
trunk/buscador/lib/Email/
trunk/buscador/lib/Email/Store/
trunk/buscador/lib/Email/Store/Vote.pm
Log:
Split everything into various modules
Added: trunk/buscador/lib/Buscador/Addressing.pm
===================================================================
--- trunk/buscador/lib/Buscador/Addressing.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Addressing.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,221 @@
+package Buscador::Addressing;
+use strict;
+
+=head1 NAME
+
+Buscador::Addressing - A Buscador plugin to deal with presentin entities
+
+=head1 DESCRIPTION
+
+Email::Store has the concept of Entities. An Entity can have multiple
+names and multiple email addressess. This pluign allows you to do
+
+
+ ${base}/entity/view/<id>
+ ${base}/entity/view/<name>
+ ${base}/entity/view/<email>
+
+
+ ${base}/name/view/<id>
+ ${base}/name/view/<name>
+
+ ${base}/address/view/<id>
+ ${base}/address/view/<email>
+
+to get various relevant information.
+
+
+=head1 SEE ALSO
+
+"What is a person?"
+http://blog.simon-cozens.org/bryar.cgi/id_6744?comments=1
+
+=head1 AUTHOR(S)
+
+Simon Cozens, <simon@xxxx.xxx>
+
+with additional work from
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004, Simon Cozens
+
+=cut
+
+
+
+package Email::Store::Mail;
+
+__PACKAGE__->set_sql(mentioned_entity => qq{
+ SELECT DISTINCT mail.message_id
+ FROM named_entity, mail, mail_date
+ WHERE
+ description = ?
+ AND mail.message_id = mail_date.mail
+ AND thing = ?
+ AND mail.message_id = named_entity.mail
+ ORDER BY mail_date.date DESC
+});
+
+
+# This is an evil hack
+Email::Store::Entity::Name->set_sql(most_common => qq{
+ SELECT name id, count(*) total
+ FROM addressing
+ WHERE entity = ?
+ GROUP BY name
+ ORDER BY total
+ LIMIT 1
+});
+
+
+Email::Store::Entity::Address->set_sql(most_common => qq{
+ SELECT address id, count(*) total
+ FROM addressing
+ WHERE entity = ?
+ GROUP BY address
+ ORDER BY total
+ LIMIT 1
+});
+
+my $sorted = qq{
+ SELECT addressing.id
+ FROM addressing, mail_date
+ WHERE %s = ?
+ AND addressing.mail = mail_date.mail
+ ORDER BY mail_date.date DESC
+};
+
+Email::Store::Addressing->set_sql(name_sorted => sprintf($sorted, "name"));
+Email::Store::Addressing->set_sql(entity_sorted => sprintf($sorted, "entity"));
+Email::Store::Addressing->set_sql(address_sorted => sprintf($sorted, "address"));
+
+# TODO
+# the whole gumpf to retrieve the id if it's not a number
+# should be stuck somewhere as a subroutine
+
+package Email::Store::Entity::Name;
+use Email::Store::Entity;
+
+sub view :Exported {
+ my ($class, $r, $name) = @_;
+ my $pager = Email::Store::Addressing->do_pager($r);
+
+ my $id = $r->args->[0] || $name->id || 0;
+
+ if ($id !~ /^\d+$/) {
+ my ($tmp) = __PACKAGE__->search_like( name => $id );
+ $id = 0;
+ if (defined $tmp) {
+ $id = $tmp->id;
+ $name = $tmp;
+ }
+ }
+
+
+ $r->{template_args}{name} = $name;
+ $r->{template_args}{sorted_addressings} =
+ [ $pager->search_name_sorted($name->id) ];
+}
+
+sub mentioned_mails {
+ my $self = shift;
+ my %mails;
+ return unless $self->name;
+ for ($self->addressings) {
+ $mails{$_->mail->id} = {
+ mail => $_->mail,
+ role => $_->role
+ }
+ }
+ my @ment =
+ grep {!exists $mails{$_->id}}
+ Email::Store::Mail->search_mentioned_entity("person", $self->name);
+ #for (@ment) {
+ # $mails{$_->id} ||= {
+ # mail => $_,
+ # role => "mentioned"
+ # }
+ #}
+ #sort {$b->{mail}->date cmp $a->{mail}->date} values %mails;
+}
+
+
+
+package Email::Store::Entity::Address;
+sub view :Exported {
+ my ($class, $r, $self) = @_;
+ my $pager = Email::Store::Addressing->do_pager($r);
+
+ my $id = $r->args->[0] || $self->id || 0;
+
+ if ($id !~ /^\d+$/) {
+ my ($tmp) = __PACKAGE__->search( address => $id );
+ $id = 0;
+ if (defined $tmp) {
+ $id = $tmp->id;
+ $self = $tmp;
+ }
+ }
+
+
+
+ $r->{template_args}{address} = $self;
+ $r->{template_args}{sorted_addressings} =
+ [$pager->search_address_sorted($self->id) ];
+}
+
+package Email::Store::Entity;
+sub view :Exported {
+ my ($class, $r, $self) = @_;
+ my $pager = Email::Store::Addressing->do_pager($r);
+
+ my $id = $r->args->[0] || $self->id || 0;
+
+
+ goto END if $id =~ /^\d+$/;
+
+
+ my $field = 'name';
+ my $method = 'search_like';
+
+ if ($id =~ /@/) {
+ $field = 'address';
+ $method = 'search';
+ }
+
+ my $class = "Email::Store::Entity::".ucfirst($field);
+
+ my ($obj) = $class->$method( $field => $id );
+ goto END unless $obj;
+ my $tmp = $obj->addressings()->first->entity;
+
+ $id = 0;
+ if (defined $tmp) {
+ $id = $tmp->id;
+ $self = $tmp;
+ }
+
+ END:
+ $r->{template_args}{entity} = $self;
+ $r->{template_args}{sorted_addressings} =
+ [$pager->search_entity_sorted($id)];
+}
+
+sub most_common_name { Email::Store::Entity::Name->search_most_common(shift->id)->first }
+sub most_common_address { Email::Store::Entity::Address->search_most_common(shift->id)->first }
+
+
+package Email::Store::Addressing;
+use Class::DBI::Pager;
+sub do_pager {
+ my ($self, $r) = @_;
+ if ( my $rows = $r->config->{rows_per_page}) {
+ return $r->{template_args}{pager} = $self->pager($rows, $r->query->{page});
+ } else { return $self }
+}
+
+
+1;
Added: trunk/buscador/lib/Buscador/Atom.pm
===================================================================
--- trunk/buscador/lib/Buscador/Atom.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Atom.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,168 @@
+package Buscador::Atom;
+use strict;
+
+=head1 NAME
+
+Buscador::Atom - a plugin to provide atom feeds for Buscador
+
+=head1 DESCRIPTION
+
+This provides four different Atom feeds for a B<Buscador> system -
+
+Most recent mails in the whole system
+
+=head2 Available through
+
+ ${base}/atom.xml
+
+or
+
+ ${base}/mail/atom
+
+
+=head2 Most recent mails for a list
+
+ ${base}/list/atom/<id>
+
+=head2 Most recent mails for an entity
+
+ ${base}/entity/atom/<id>
+
+=head2 Most recent mails for a thread
+
+ ${base}/mail/thread/atom/<id>
+
+or
+
+ ${base}/mail/thread_atom/<id>
+
+Where C<id> is any message-id from that thread.
+
+
+=head1 SEE ALSO
+
+http://www.atomenabled.org/
+
+=head1 AUTHOR
+
+Simon Wistow <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004, Simon Wistow
+
+=cut
+
+
+sub parse_path_order { 13 }
+
+sub parse_path {
+ my ($self, $buscador) = @_;
+
+ $buscador->{path} =~ s!atom.xml$!mail/atom/!;
+ $buscador->{path} =~ s!mail/thread/atom/!mail/thread_atom/!;
+}
+
+package Email::Store::Mail;
+use Date::Parse qw( str2time );
+
+sub atom :Exported {
+ my ($self, $r) = @_;
+
+ my $pager = $self->do_pager($r);
+
+ $r->{content_type} = "application/xml";
+ $r->{objects} = [ $pager->search_recent ];
+ $r->{template_args}{link} = Buscador->config->{uri_base};
+ $r->{template_args}{title} = "Recent mails from ".Buscador->config->{uri_base};
+ $r->{template} = "custom/atom";
+}
+
+sub extract_time {
+ my $self = shift;
+ my $container = shift;
+
+ my $date = Mail::Thread->_get_hdr( $container->message, 'date' );
+ return str2time( $date );
+}
+
+
+sub thread_atom :Exported {
+ my ($self, $r) = @_;
+
+ my $base = Buscador->config->{uri_base};
+ my $mail = $r->objects->[0];
+ my $root = $mail->container->root;
+
+ # get all the mails in this thread
+ my @messages;
+ $root->iterate_down(
+ sub {
+ my ($c, $d) = @_;
+ push @messages, $c if $c->message;
+ } );
+
+ # okay, wander them in date order
+ @messages =
+ sort { $self->extract_time( $a ) <=>
+ $self->extract_time( $b ) } @messages;
+
+ my @return;
+ my $count = 0;
+ for (@messages) {
+ my $mess = Email::Store::Mail->retrieve($_->message->id);
+ next unless $mess;
+ push @return, $mess;
+ last if $count++ > Buscador->config->{rows_per_page};
+ }
+
+ $base =~ s!/\s*$!!;
+
+ $r->{content_type} = "application/xml";
+ $r->{objects} = [ @return ];
+ $r->{template_args}{link} = "$base/mail/thread/".$mail->id;
+ $r->{template_args}{title} = "Recent mails from $base/mail/thread/".$mail->id;
+ $r->{template} = "atom";
+}
+
+
+package Email::Store::List;
+
+sub atom :Exported {
+ my ($self, $r, $list) = @_;
+
+ my $pager = Email::Store::Mail->do_pager($r);
+
+ $r->{content_type} = "application/xml";
+ $r->{template_args}{link} = Buscador->config->{uri_base}."list/view/".$list->id;
+ $r->{template_args}{mails} = [ $pager->search_recent_posts($list->id) ];
+ $r->{template_args}{title} = "Recent mails from ".$list->name;
+ $r->{template} = "custom/atom";
+}
+
+package Email::Store::Entity;
+
+sub atom :Exported {
+ my ($self, $r, $name) = @_;
+
+ my $pager = Email::Store::Addressing->do_pager($r);
+ my @mails = $pager->search_name_sorted($name->id);
+
+ $r->{template_args}{mails} = [ map { $_->mail } @mails ];
+
+ # find the first name available to us
+ my $person;
+ foreach my $mail (@mails) {
+ $person = $mail->name->name;
+ last if $person && $person !~ /^\s*$/;
+ }
+
+ $r->{content_type} = "application/xml";
+ $r->{template_args}{link} = Buscador->config->{uri_base}."entity/view/".$name->id;
+ $r->{template_args}{title} = "Recent mails from $person";
+ $r->{template} = "custom/atom";
+
+}
+
+
+1;
Added: trunk/buscador/lib/Buscador/Attachment.pm
===================================================================
--- trunk/buscador/lib/Buscador/Attachment.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Attachment.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,48 @@
+package Buscador::Attachment;
+use strict;
+
+
+=head1 NAME
+
+Buscador::Attachment - Buscador plugin to access attachments
+
+=head1 DESCRIPTION
+
+This plugin allows you to do
+
+ ${base}/attachment/view/<id>
+
+And either download or view an attachment. It sets the
+filename correctly using B<Content-Disposition>.
+
+=head1 AUTHOR
+
+Simon Cozens, <simon@xxxx.xxx>
+
+with work from
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright 2004, Simon Cozens
+
+=cut
+
+
+
+package Email::Store::Attachment;
+use strict;
+
+sub view :Exported {
+ my ($self, $r, $att) = @_;
+
+
+ $r->ar->headers_out->set("Content-Disposition" => "inline; filename=".$att->filename) if $a;
+
+ $r->{content_type} = $att->content_type;
+ $r->{output} = $att->payload;
+}
+
+1;
+
Added: trunk/buscador/lib/Buscador/Build.pm
===================================================================
--- trunk/buscador/lib/Buscador/Build.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Build.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,97 @@
+use strict;
+package Buscador::Build;
+use Module::Build;
+use File::Find qw(find);
+use IO::File;
+use base 'Module::Build';
+use vars qw/$FAKE/;
+
+
+=head1 NAME
+
+Buscador::Build - utility routines for Build.PL
+
+=head1 AUTHOR
+
+Richard Clamp - we ripped this off Siesta::Build
+
+=cut
+
+# ripped off the Siesta build system
+
+sub create_build_script {
+ my $self = shift;
+ $self->SUPER::create_build_script;
+
+ # check for incompatible steps
+ my $module = $self->{properties}{module_name};
+ if (my $version = $self->check_installed_version($module, 0)) {
+ print "Upgrading from $module $version\n";
+ my $fh = IO::File->new('Changes');
+ my $chunk = '';
+ my $this;
+ while (<$fh>) {
+ if (/^(\S+)/) {
+ print "Incompatible change introduced in version $this:\n", $chunk
+ if $chunk =~ /INCOMPATIBLE/;
+ $this = $1;
+ last if $self->check_installed_version( $module, $this );
+ $chunk = '';
+ }
+ $chunk .= $_;
+ }
+ }
+}
+
+sub ACTION_install {
+ my $self = shift;
+ $self->SUPER::ACTION_install;
+ $self->ACTION_install_extras;
+}
+
+sub ACTION_fakeinstall {
+ my $self = shift;
+ $self->SUPER::ACTION_fakeinstall;
+ local $FAKE = 1;
+ $self->ACTION_install_extras;
+}
+
+sub ACTION_install_extras {
+ my $self = shift;
+ my $path = $self->{config}{__extras_destination};
+ my @files = $self->_find_extras;
+ print "installing extras to $path\n";
+ for (@files) {
+ $FAKE
+ ? print "$_ -> $path/$_ (FAKE)\n"
+ : $self->copy_if_modified($_, $path);
+ }
+}
+
+sub ACTION_cover {
+ my $self = shift;
+ $self->depends_on('build');
+ system qw( cover -delete );
+
+ # sometimes we get failing tests, which makes Test::Harness
+ # die. catch that
+ eval {
+ local $ENV{PERL5OPT} = "-MDevel::Cover=-summary,0";
+ $self->ACTION_test(@_);
+ };
+ system qw( cover -report html );
+}
+
+sub _find_extras {
+ my $self = shift;
+ my @files;
+ find(sub {
+ $File::Find::prune = 1 if -d && /^\.svn$/;
+ return if -d;
+ return if /~$/;
+ push @files, $File::Find::name;
+ }, @{ $self->{config}{__extras_from} });
+ return @files;
+}
+
+1;
Added: trunk/buscador/lib/Buscador/Config.pm
===================================================================
--- trunk/buscador/lib/Buscador/Config.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Config.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,104 @@
+package Buscador::Config;
+use strict;
+use vars qw(%config);
+
+use Apache;
+use Carp qw(croak);
+use Cwd;
+
+
+
+
+BEGIN {
+
+ my $home;
+
+ # h-h-h-ack!
+ eval {
+ my $r = Apache->request;
+
+ $home = $r->document_root.$r->location;
+ };
+
+ if ($@) {
+ $home = getcwd();
+ }
+
+
+ chdir $home;
+
+ $config{home} = $home;
+
+ open (CONF, "buscador.config") || die "Can't open config file: $!\n";
+ while (<CONF>) {
+ chomp;
+ next if /^\s*#/;
+ next if /^\s*$/;
+ s!(^\s*|\s*$)!!;
+ my ($key, $val) = split /\s*=\s*/, $_, 2;
+ $config{$key} = $val;
+ }
+
+ close CONF;
+}
+
+
+sub AUTOLOAD {
+ our ($AUTOLOAD);
+ no strict 'refs';
+ my $tag = $AUTOLOAD;
+ $tag =~s/.*:://;
+
+ my $joined = join ",", keys %config;
+ croak "No such method $tag try one of $joined" unless $config{$tag};
+
+ *$AUTOLOAD = sub {
+ my $self = shift;
+ if (@_) {
+ my $val = shift;
+ $config{$tag} = $val;
+ return $val;
+ }
+ return $config{$tag};
+ };
+
+ goto &$AUTOLOAD;
+
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Buscador::Config - provide config values
+
+=head1 SYNPOSIS
+
+ use Buscador::Config;
+
+ print Buscador::Config->dsn;
+
+=head1 DESCRIPTION
+
+This works out the current directory (dependent on whether
+the module is working under Apache or not), reads in a
+C<buscador.config> file and turns every C<key=value> pair
+into a subroutine C<Buscador::Config->key>.
+
+=head1 AUTHOR
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright 2004, Simon Wistow
+
+=cut
+
+
+
+
+
Added: trunk/buscador/lib/Buscador/Date.pm
===================================================================
--- trunk/buscador/lib/Buscador/Date.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Date.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,152 @@
+package Buscador::Date;
+use strict;
+
+
+=head1 NAME
+
+Buscador::Date - a plugin to provide date pages for Buscador
+
+=head1 DESCRIPTION
+
+This provides pages which "do the right thing" for
+
+ ${base}/date/view/<year>
+ ${base}/date/view/<year>/<month>
+ ${base}/date/view/<year>/<month>/<day>
+
+=head1 AUTHOR
+
+Simon Wistow <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004, Simon Wistow
+
+=cut
+
+
+# put path munging stuff here
+
+sub parse_path_order { 13 }
+
+sub parse_path {
+ my ($self, $buscador) = @_;
+
+ $buscador->{path} =~ s!date/!mail_date/!;
+}
+
+
+
+package Email::Store::Date;
+use strict;
+use Time::Piece;
+use Time::Seconds;
+use Lingua::EN::Numbers::Ordinate;
+
+sub view :Exported {
+ my $self = shift;
+ return $self->list(@_);
+}
+
+sub list :Exported {
+ my $self = shift;
+ my ($r) = @_;
+
+ my @objects = @{$r->args};
+
+ $r->{path} =~ s!mail_date/!date/!;
+ $r->{template_args}{ordinate} = sub { ordinate(shift) };
+
+ return if @objects==1 && $self->year($r, @objects);
+ return if @objects==2 && $self->month($r, @objects);
+ return $self->day($r, @objects);
+
+}
+
+sub day {
+ my ($self,$r, @objects) = @_;
+
+ $self = $self->do_pager($r);
+
+ my $deftime = localtime;
+ my $time;
+
+ my $s = sprintf "%.4d-%.2d-%.2d", $objects[0], $objects[1], $objects[2];
+ eval {
+ $time = Time::Piece->strptime($s, "%Y-%m-%d");
+ };
+ $time = undef if $@ || $s ne $time->strftime("%Y-%m-%d");
+
+ $time = $deftime unless defined $time;
+ my @mails = map { $_->mail }
+ $self->search( year => $time->year, month => $time->mon, day => $time->mday );
+ $r->{template} = "list";
+ $r->{template_args}{mails} = \@mails;
+ $r->{template_args}{date} = $time;
+ $r->{template_args}{tomorrow} = Time::Piece->new($time + ONE_DAY);
+ $r->{template_args}{yesterday} = Time::Piece->new($time - ONE_DAY);
+
+}
+
+
+sub month {
+ my ($self,$r, @objects) = @_;
+
+ my $year = $objects[0];
+ my $month = $objects[1];
+ my $s = sprintf "%.4d-%.2d-%.2d", $year, $month, 15;
+ my $date = Time::Piece->strptime($s, "%Y-%m-%d");
+
+
+
+ my @days;
+ for my $day (1..$date->month_last_day) {
+ $days[$day-1] = scalar Email::Store::Date->search( year => $year, month => $month, day => $day );
+ }
+
+
+
+ $r->{template} = "month";
+ $r->{template_args}{days} = \@days;
+ $r->{template_args}{date} = $date;
+ $r->{template_args}{next_month} = Time::Piece->new($date + ONE_MONTH);
+ $r->{template_args}{last_month} = Time::Piece->new($date - ONE_MONTH);
+
+
+ return 1;
+}
+
+
+sub year {
+ my ($self,$r, @objects) = @_;
+
+
+ my @months;
+ my $year = $objects[0];
+
+
+ for my $m (1..12) {
+ $months[ $m - 1 ] = scalar Email::Store::Date->search( year => $year, month => $m );
+ }
+
+ $r->{template} = "year";
+ $r->{template_args}{months} = \@months;
+ $r->{template_args}{year} = $objects[0];
+ $r->{template_args}{next} = Time::Piece->strptime($year+1, "%Y");
+ $r->{template_args}{prev} = Time::Piece->strptime($year-1, "%Y");
+
+
+ return 1;
+}
+
+use Class::DBI::Pager;
+sub do_pager {
+ my ($self, $r) = @_;
+ if ( my $rows = $r->config->{rows_per_page}) {
+ return $r->{template_args}{pager} = $self->pager($rows, $r->query->{page});
+ } else { return $self }
+}
+
+1;
+
+
Added: trunk/buscador/lib/Buscador/Decorate.pm
===================================================================
--- trunk/buscador/lib/Buscador/Decorate.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Decorate.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,145 @@
+package Buscador::Decorate;
+use strict;
+
+=head1 NAME
+
+Buscador::Decorate - mark a mail body up in HTML
+
+=head1 DESCRIPTION
+
+This provides a method C<format_body> for B<Email::Store::Mail>
+which marks up the body of a mail as HTML including making links
+clickable, highlighting quotes, and correctly providing links for
+names and addresses that we've seen before.
+
+
+=head1 AUTHOR
+
+Simon Cozens, <simon@xxxx.xxx>
+
+with work from
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright 2004, Simon Cozens
+
+=cut
+
+
+
+
+package Email::Store::Mail;
+use strict;
+use Text::Decorator;
+use Text::Autoformat;
+use HTML::Scrubber;
+
+sub format_body {
+ my $mail = shift;
+
+
+ my $html = ($mail->html)[0];
+
+ return $html->scrubbed if defined $html;
+
+
+ my $body = $mail->body || "";
+
+ my $decorator = Text::Decorator->new($body);
+
+ my %seen;
+ my @names =
+ grep {!$seen{$_->thing}++}
+ grep {$_->thing =~ / /}
+ grep {$_->score > 6}
+ $mail->named_entities(description => "person");
+
+ my @addresses = Email::Store::Entity::Address->retrieve_all;
+
+ $decorator->add_filter("Quoted", begin => '<div class="level%i">',
+ end => '</div>');
+
+
+ $decorator->add_filter("URIFind") unless $html;
+ $decorator->add_filter("TTBridge" => "html" => "html_entity") unless $html;
+
+ $decorator->add_filter("NamedEntity" => @names) if @names;
+ $decorator->add_filter("Addresses" => @addresses) if @addresses;
+
+ $decorator->format_as("html");
+
+}
+
+package Text::Decorator::Filter::NamedEntity;
+$INC{"Text/Decorator/Filter/NamedEntity.pm"}++; # for ->require
+use Text::Decorator::Group;
+use base 'Text::Decorator::Filter';
+use HTML::Entities;
+
+sub filter_node {
+ my ($class, $args, $node) = @_;
+ my (@entities) = @$args;
+ # Prepare it.
+ $node->{representations}{html} = $node->format_as("html");
+ my $test = join "|", map {quotemeta($_->thing)} @entities;
+ my $base = Buscador->config->{uri_base};
+ my $img = Buscador->config->{img_base};
+ return $node unless $node->{representations}{html} =~ m{\b($test)\b}ims;
+ for my $entity (@entities) {
+ my ($name) = Email::Store::Entity::Name->search(name => $entity->thing);
+ if ($name) {
+ my $nn = encode_entities($name->name);
+ my $id = $name->id;
+ $node->{representations}{html} =~ s{\b\Q$nn\E\b}
+ {<A HREF="${base}name/view/$id" class="personknown"> <SUP><IMG SRC="$img/personknown.gif"> </SUP>$nn</A>}gmsi;
+# } elsif ($entity->score >= 20) { # Have to be damned sure
+# my $nn = encode_entities($entity->thing);
+# $node->{representations}{html} =~ s{\b\Q$nn\E\b}
+# {<span class="personunknown"> <SUP><IMG SRC="$img/personunknown.gif"> </SUP>$nn</span>}gims;
+ }
+ }
+ return $node;
+}
+
+
+package Text::Decorator::Filter::Addresses;
+$INC{"Text/Decorator/Filter/Addresses.pm"}++; # for ->require
+use base 'Text::Decorator::Filter';
+use HTML::Entities;
+use Email::Find;
+
+sub filter_node {
+ my ($class, $args, $node) = @_;
+
+ my %addresses = map { $_->address => $_ } @$args;
+
+ $node->{representations}{html} = $node->format_as("html");
+
+
+ my $base = Buscador->config->{uri_base};
+ my $img = Buscador->config->{img_base};
+
+ my $finder = Email::Find->new(
+ sub {
+ my($email, $orig_email) = @_;
+ if ($addresses{$orig_email}) {
+ my $add = $addresses{$orig_email};
+ my $id = $add->id;
+ return "<A HREF='${base}address/view/$id' class='personknown'>".
+ " <SUP><IMG SRC='$img/personknown.gif'> </SUP>$orig_email</A>"
+ } else {
+ return "<SUP><IMG SRC='$img/personunknown.gif'> </SUP>$orig_email";
+ }
+
+ });
+ $finder->find(\$node->{representations}{html});
+
+
+
+ return $node;
+
+}
+
+1;
Added: trunk/buscador/lib/Buscador/Raw.pm
===================================================================
--- trunk/buscador/lib/Buscador/Raw.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Raw.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,58 @@
+package Buscador::Raw;
+use strict;
+
+# put path munging stuff here
+
+sub parse_path_order { 13 }
+
+sub parse_path {
+ my ($self, $buscador) = @_;
+
+ $buscador->{path} =~ s!raw/!mail_raw/!;
+}
+
+=head1 NAME
+
+Buscador::Raw - Buscador plugin to provide a raw version of a mail
+
+=head1 DESCRIPTION
+
+This prints out a raw message when you do
+
+ ${base}/mail/raw/<id>
+
+=head1 AUTHOR
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright 2004, Simon Wistow
+
+=cut
+
+
+package Email::Store::Mail;
+use strict;
+
+sub mail_raw :Exported {
+ my ($self,$r, $mail) = @_;
+
+
+ my $output;
+
+
+ if (defined $mail) {
+ $output = $mail->raw || $mail->message;
+ }
+
+ $output = "[ no content ]" unless defined $output;
+
+
+ $r->{content_type} = "text/plain";
+ $r->{output} = $output;
+}
+
+
+
+1;
Added: trunk/buscador/lib/Buscador/Recent.pm
===================================================================
--- trunk/buscador/lib/Buscador/Recent.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Recent.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,102 @@
+package Buscador::Recent;
+use strict;
+
+
+=head1 NAME
+
+Buscador::Recent - provide a list of recent mails for the system and lists
+
+=head1 DESCRIPTION
+
+This allows you to do
+
+
+ ${base}/mail/recent/
+
+which is also the default if there's no path parsed, e.g
+
+ ${base}
+
+and also
+
+ ${base}/list/recent/<id>
+
+=head1 AUTHOR
+
+Simon Cozens, <simon@xxxx.xxx>
+
+with work from
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright 2004, Simon Cozens
+
+=cut
+
+
+sub parse_path_order { 1 }
+
+sub parse_path {
+ my ($self, $buscador) = @_;
+
+ $buscador->{path} ||= "/mail/recent";
+}
+
+
+package Email::Store::Mail;
+use strict;
+
+sub recent :Exported {
+ my ($self, $r) = @_;
+ $self = $self->do_pager($r);
+ $r->{template_args}{mails} = [ $self->search_recent ];
+}
+
+
+__PACKAGE__->set_sql(recent_posts => qq{
+ SELECT mail.message_id
+ FROM list_post, mail_date, mail
+ WHERE
+ list_post.list = ?
+ AND mail.message_id = list_post.mail
+ AND mail.message_id = mail_date.mail
+ ORDER BY mail_date.date DESC
+});
+
+__PACKAGE__->set_sql(recent => qq{
+ SELECT mail.message_id
+ FROM mail_date, mail
+ WHERE mail.message_id = mail_date.mail
+ ORDER BY mail_date.date DESC
+});
+
+
+package Email::Store::List;
+
+sub view :Exported {
+ my ($self, $r, $tmp) = @_;
+ my $pager = Email::Store::Mail->do_pager($r);
+
+ my $id = $r->args->[0] || $tmp->id || 0;
+
+
+ if ($id !~ /^\d+$/) {
+ my ($list) = __PACKAGE__->search_like( name => $id );
+ $id = 0;
+ if (defined $list) {
+ $id = $list->id;
+ $self = $list;
+ $r->{template_args}{list} = $self;
+
+ }
+ }
+
+ $r->{template_args}{recent} = [ $pager->search_recent_posts($id) ];
+
+}
+
+
+
+1;
Added: trunk/buscador/lib/Buscador/Root.pm
===================================================================
--- trunk/buscador/lib/Buscador/Root.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Root.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,32 @@
+package Buscador::Root;
+
+use base qw(Exporter);
+our @EXPORT = qw($root);
+
+
+$root = '[A';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Buscador::Root - information about where default Buscador files are installed
+
+=head1 SYNOPIS
+
+
+ require Buscador::Root;
+
+ print $Buscador::Root::root; # prints [A
+
+
+=head1 CREATION
+
+This file is autogenerated from Root.pm.in when you run Build.PL
+
+=cut
+
Added: trunk/buscador/lib/Buscador/Search.pm
===================================================================
--- trunk/buscador/lib/Buscador/Search.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Search.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,74 @@
+package Buscador::Search;
+use strict;
+
+=head1 NAME
+
+Buscador::Search - allow searching from within Buscador
+
+=head1 DESCRIPTION
+
+Provides various methods so that you can do
+
+ ${base}/mail/search/[terms]
+
+=head1 AUTHOR
+
+Simon Cozens, <simon@xxxx.xxx>
+
+with work from
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright 2004, Simon Cozens
+
+=cut
+
+
+
+package Email::Store::Mail;
+use strict;
+use Text::Context;
+use HTML::Entities;
+
+
+sub search :Exported {
+ return shift->SUPER::search(@_) if caller ne "Maypole::Model::Base";
+ my ($self, $r) = @_;
+ $self = $self->do_pager($r);
+ $r->objects([ $self->plucene_search( $r->{query}{terms} ) ]);
+} # Don't you just love it when a plan comes together?
+
+sub _unlucene {
+ my ($asset_terms) = @_;
+ use Data::Dumper;
+ return map {
+ $_->{query} eq "SUBQUERY" ? _unlucene($_->{subquery})
+ : $_->{query} ne "PHRASE" ? $_->{term}
+ : (split /\s+/, $_->{term}) }
+ grep
+ { $_->{type} ne "PROHIBITED" and (!exists($_->{field}) or $_->{field} eq "text")}
+ @{$asset_terms};
+}
+
+sub parsed_query {
+ my ($q) = @_;
+ my $parser = Plucene::QueryParser->new({
+ analyzer => Plucene::Analysis::SimpleAnalyzer->new(),
+ default => "text",
+ });
+ $parser->parse($q, 1);
+}
+
+sub contextualize_result {
+ my ($mail, $terms) = @_;
+ my @terms = _unlucene(parsed_query($terms));
+ my $body = $mail->body;
+ Text::Context->new($body, @terms)->as_html( start=> "<b>", end => "</b>" )
+ || encode_entities($mail->original);
+
+}
+
+
+1;
Added: trunk/buscador/lib/Buscador/Thread.pm
===================================================================
--- trunk/buscador/lib/Buscador/Thread.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Thread.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,142 @@
+package Buscador::Thread;
+use strict;
+
+=head1 NAME
+
+Buscador::Thread - provide some thread views for Buscador
+
+=head1 DESCRIPTION
+
+This provides two different thread views for Buscador - traditional
+'JWZ' style view and a rather funky looking 'lurker' style. They can be
+accessed using
+
+
+ ${base}/mail/thread/<id>
+ ${base}/mail/lurker/<id>
+
+
+where C<id> can be the message-id of any message in the thread. neat, huh?
+
+
+=head1 SEE ALSO
+
+JWZ style message threading
+http://www.jwz.org/doc/threading.html
+
+Lurker style
+http://lurker.sourceforge.net
+
+=head1 AUTHOR
+
+Simon Wistow <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004, Simon Wistow
+
+=cut
+
+
+
+package Mail::Thread; # Fscking hack!
+
+no warnings 'redefine';
+
+sub _get_hdr {
+
+ my ($class, $msg, $hdr) = @_;
+ $msg->simple->header($hdr) || '';
+}
+
+
+package Email::Store::Mail;
+use strict;
+use Mail::Thread::Chronological;
+
+sub lurker :Exported {
+ my ($self,$r) = @_;
+ my $mail = $r->objects->[0];
+ my $root = $mail->container->root;
+
+ while (1) {
+ last if $root->message->date;
+ my @children = $root->children;
+ last if (@children>1);
+ $root = $children[0];
+ }
+
+ my $lurker = Mail::Thread::Chronological->new;
+ my @root = $lurker->arrange( $root );
+
+
+ $r->{template_args}{root} = \@root;
+
+}
+
+sub thread :Exported {
+ my ($self,$r) = @_;
+ my $mail = $r->objects->[0];
+ my $root = $mail->container->root;
+
+ while (1) {
+ last if $root->message->date;
+ my @children = $root->children;
+ last if (@children>1);
+ $root = $children[0];
+ }
+
+ $r->{template_args}{thread} = $root;
+}
+
+
+sub thread_as_html {
+ my $mail = shift;
+ my $cont = $mail->container;
+ my $orig = $cont;
+ my %crumbs;
+ # We can't use ->root here, because we want to keep track of the
+ # breadcrumbs, and this way is more efficient.
+ while (1) {
+ $crumbs{$cont}++;
+ if ($cont->parent) { $cont = $cont->parent } else { last }
+ }
+ while (1) {
+ last if $cont->message->date;
+ my @children = $cont->children;
+ last if (@children>1);
+ $cont = $children[0];
+ }
+ my $html = "<UL class=\"mktree\">\n";
+ my $add_me;
+ my $base = Buscador->config->{uri_base};
+ $add_me = sub {
+ my $c = shift;
+ $html .= "<li ".(exists $crumbs{$c} && "class=\"liOpen\"").">";
+
+ # Bypass has-a because we might not really have it!
+ my $mess = Email::Store::Mail->retrieve($c->message->id);
+ if (!$mess) { $html .= "<i>message not available</i>" }
+ elsif ($c == $orig) { $html .= "<b> this message </b>" }
+ else {
+ $html .= qq{<A HREF="${base}mail/view/}.$mess->id.q{">}.
+ $mess->subject."</A>\n";
+ $html .= "<BR>  <SMALL>".eval {$mess->addressings(role =>"From")->first->name->name}."</SMALL>\n";
+ }
+
+ if ($c->children) {
+ $html .="<ul>\n";
+ $add_me->($_) for $c->children;
+ $html .= "</ul>\n";
+ }
+ $html .= "</li>\n";
+ };
+ $add_me->($cont);
+ $html .="</ul>";
+ return $html;
+}
+
+1;
+
+
+
Added: trunk/buscador/lib/Buscador/UTF8.pm
===================================================================
--- trunk/buscador/lib/Buscador/UTF8.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/UTF8.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,57 @@
+package Buscador::UTF8;
+use utf8;
+
+=head1 NAME
+
+Buscador::UTF8 - Buscador plugin to encode the body of a message to UTF8
+
+=head1 DESCRIPTION
+
+This plugin provides a C<body> method to B<Email::Store::Mail>
+that returns a UTF-8 encoded body text.
+
+=head1 AUTHOR
+
+Simon Cozens, <simon@xxxx.xxx>
+
+with work from
+
+Simon Wistow, <simon@xxxxxxxxxx.xxx>
+
+=head1 COPYRIGHT
+
+Copyright 2004, Simon Cozens
+
+=cut
+
+
+package Email::Store::Mail;
+use strict;
+
+sub subject {
+ my $mail = shift;
+ my $mime = Email::MIME->new($mail->message);
+
+ my $subject = $mime->header('subject');
+
+ return $subject;
+}
+
+sub body {
+ my $mail = shift;
+ my $mime = Email::MIME->new($mail->message);
+
+ my $body = $mail->simple->body;
+
+ my $charset = $mime->{ct}->{attributes}{charset};
+ if ($charset and $charset !~ /utf-?8/i) {
+ eval {
+ require Encode;
+ $body = Encode::decode($charset, $body);
+ #Encode::_utf8_off($body);
+ };
+ }
+ $body;
+}
+
+1;
Added: trunk/buscador/lib/Buscador/Vote.pm
===================================================================
--- trunk/buscador/lib/Buscador/Vote.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador/Vote.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,40 @@
+package Buscador::Vote;
+
+
+package Email::Store::Mail;
+use strict;
+use Email::Store::Vote;
+
+sub vote :Exported {
+ my ($self, $r, $mail) = @_;
+ my $vote = Email::Store::Vote->create({ mail=>$mail->id });
+
+
+ my $loc = Buscador->config->{uri_base};
+
+ $loc =~ s!/+$!!;
+ $loc .= "/mail/view/".$mail->id;
+
+ $r->{template} = "view";
+ $r->location($loc);
+
+}
+
+sub popular :Exported {
+ my ($self, $r) = @_;
+
+ my $pager = Email::Store::Mail->do_pager($r);
+ $r->{objects} = [$pager->search_popular ];
+
+
+}
+
+__PACKAGE__->set_sql( popular => qq{
+ SELECT mail.message_id, count(vote.mail) AS votes
+ FROM mail, vote
+ WHERE mail.message_id = vote.mail
+ GROUP BY vote.mail
+ ORDER BY votes DESC
+});
+
+1;
Added: trunk/buscador/lib/Buscador.pm
===================================================================
--- trunk/buscador/lib/Buscador.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Buscador.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,218 @@
+package Buscador;
+use strict;
+use vars qw($VERSION);
+use base 'Maypole::Redirect';
+
+$VERSION = "0.7";
+
+# use Maypole::Cache;
+Buscador->config->{cache_options}{class} = "Cache::FileCache";
+
+use Buscador::Config;
+use Maypole::Constants;
+our $home;
+sub debug{0}
+
+BEGIN {
+ require Email::Store;
+
+ Email::Store->import(Buscador::Config->dsn, verbose => 1 );
+
+ use Module::Pluggable search_path => [ "Email::Store" ], sub_name => 'stores', require => 1;
+ use Module::Pluggable::Ordered search_path => [ "Buscador" ];
+
+ $home = Buscador::Config->home;
+ Buscador->config->{cache_options}{class} = "Cache::FileCache";
+ Buscador->config->{model} = "Maypole::Model::CDBI::Plain";
+
+
+ # this is a bit of an egregious hack
+ # perhaps plugins should specifically state whether they
+ # are capable of being set up or not
+ my @stores = sort grep { !/(DBI|Addressing)$/ }
+ grep { !/SUPER$/ }
+ grep { $_->can("table") }
+ Buscador->stores;
+
+ # not needed any more
+ # my @setup = sort qw/ Email::Store::Mail Email::Store::List Email::Store::Date
+ # Email::Store::Entity Email::Store::Entity::Name Email::Store::Attachment
+ # Email::Store::Entity::Address Email::Store::NamedEntity Email::Store::Vote /;
+
+
+ Buscador->setup([ @stores ]);
+};
+
+Buscador->config->{rows_per_page} = 10;
+Buscador->config->{template_root} = "$home/templates";
+Buscador->config->{uri_base} = Buscador::Config->uri;
+Buscador->config->{img_base} = Buscador::Config->image_uri;
+
+Buscador->config->{uri_base} .= "/" unless Buscador->config->{uri_base} =~ m!/$!;
+Buscador->config->{img_base} .= "/" unless Buscador->config->{img_base} =~ m!/$!;
+
+
+$Email::Store::Plucene::index_path = "$home/emailstore-index";
+$Plucene::QueryParser::DefaultOperator = "AND";
+
+
+
+sub parse_path {
+ my $self = shift;
+
+ Buscador->call_plugins("parse_path", $self);
+ $self->SUPER::parse_path();
+}
+1;
+
+__END__
+
+=head1 NAME
+
+Buscador - a mail archiver with a twise
+
+=head1 DESCRIPTION
+
+Buscador is web based mail archival and retrieval tool based
+around the concept of Intertwingle :
+
+ http://www.mozilla.org/blue-sky/misc/199805/intertwingle.html
+
+In essence it provides a variety of different views on the mail
+using a system of plugins. Plugins provided include ones to
+show thread views, date views, seperation into mailing lists,
+extraction of named entities and Atom feeds for recent mails,
+per thread, per list and per person and for handling mailing.
+
+
+=head1 INSTALL
+
+=head2 Install dependencies
+
+There's a C<Bundle::Buscador> available from
+
+ http://thegestalt.org/simon/perl/Bundle-Buscador-0.1.tar.gz
+
+however some people have had problems installing some of these.
+Namely
+
+ Apache::Request
+ Class::DBI::AsForm
+ Email::MIME
+ Email::MIME::Attachment::Stripper
+ Mail::ListDetector
+
+And, in particular C<SQL::Translator>. C<SQL::Translator>
+installs a lot of weird things such as C<GD>, C<Graphviz>
+and C<Spreadsheet::ParseExcel>.
+
+A cut down version of C<SQL::Translator> without these
+dependencies is available from
+
+ http://thegestalt.org/simon/perl/SQL-Translator-0.05-lite.tar.gz
+
+=head2 Create config file
+
+Make a directory in your web root, cd into it and do
+
+ % buscador-import -init
+
+this will copy some templates and some images into the directory and
+then generate a sample config file. You should edit the config file.
+
+You might want to move your chrome directory outside your new buscador
+directory and alter your config accordingly. That way Maypole (which
+Buscador is based on) doesn't try and first see if there's a table
+called 'chrome' before passing through to the actual chrome directory
+and also won't fill your logs with errors.
+
+
+=head2 Import some mails
+
+Run
+
+ % buscador-import -setup
+
+and then
+
+ % buscador-import /path/to/mail/folder
+
+
+=head2 Create Apache config
+
+Something like
+
+
+ <Location /buscador>
+ SetHandler perl-script
+ PerlHandler Buscador
+ </Location>
+
+but changed to whatever directory yu wnat to install it under.
+
+
+If you're using the default SQLite db remember to make sure that
+the web server has enough access to read it and get a lock.
+
+=head1 PLUGINS
+
+The plugin system is based around C<Module::Pluggable::Ordered>.
+Each plugin get the chance to influence the path being passed in.
+The order that they are called in is set by the B<parse_path_order>
+method, the lower the return value the higher the priority.
+For example:
+
+ package Buscador::Foo;
+
+ # we're middling important
+ sub parse_path_order { 13 }
+
+ sub parse_path {
+ my ($self, $buscador) = @_;
+
+ # buscador is an alias for search
+ $buscador->{path} =~ s!/buscador/!/search/!;
+
+ }
+
+ 1;
+
+however they don't have to touch the path at all and can simply
+install methods in other namespaces;
+
+
+ package Buscador::Bar;
+
+ # this is where path parsing methods would go
+
+ package Email::Store::Mail;
+ use Fortune;
+
+ sub bar :Exported {
+ my $fortune = Fortune ('fortunefile')->read_header()->get_random_fortune();
+ $r->{template_args}{fortune} = $fortune;
+ $r->{template} = "fortune";
+ }
+
+ 1;
+
+
+And now, if we write a 'fortune' template and go to
+
+ http://example.com/buscador/mail/bar
+
+we'll be presented with a fortune.
+
+
+=head1 AUTHOR
+
+Simon Cozens, E<lt>simon@xxxx.xxxx<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Simon Cozens
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Added: trunk/buscador/lib/Email/Store/Vote.pm
===================================================================
--- trunk/buscador/lib/Email/Store/Vote.pm 2005-02-08 12:53:01 UTC (rev 1840)
+++ trunk/buscador/lib/Email/Store/Vote.pm 2005-02-08 12:54:42 UTC (rev 1841)
@@ -0,0 +1,19 @@
+package Email::Store::Vote;
+use base "Email::Store::DBI";
+use strict;
+__PACKAGE__->table("vote");
+
+__PACKAGE__->columns( Primary => qw[ id ] );
+__PACKAGE__->columns( Other => qw[ mail ] );
+__PACKAGE__->has_a(mail => "Email::Store::Mail");
+Email::Store::Mail->has_many(votes => "Email::Store::Vote");
+
+
+
+__DATA__
+
+CREATE TABLE IF NOT EXISTS vote (
+ id integer NOT NULL PRIMARY KEY AUTO_INCREMENT,
+ mail varchar(255) NOT NULL
+);
+
Generated at 13:00 on 08 Feb 2005 by mariachi 0.52