[prev] [thread] [next] [lurker] [Date index for 2005/02/08]
Author: simon
Date: 2005-02-08 13:00:10 +0000 (Tue, 08 Feb 2005)
New Revision: 1849
Removed:
trunk/buscador/Buscador.pm
Log:
No longer needed
Deleted: trunk/buscador/Buscador.pm
===================================================================
--- trunk/buscador/Buscador.pm 2005-02-08 12:59:37 UTC (rev 1848)
+++ trunk/buscador/Buscador.pm 2005-02-08 13:00:10 UTC (rev 1849)
@@ -1,350 +0,0 @@
-package Buscador;
-use strict;
-use base 'Apache::MVC';
-use Maypole::Cache;
-Buscador->config->{cache_options}{class} = "Cache::FileCache";
-use Buscador::Config;
-use Maypole::Constants;
-our $home;
-sub debug{1}
-
-BEGIN {
-require Email::Store;
-$home = Buscador::Config->home;
-Email::Store->import(Buscador::Config->dsn);
-Buscador->config->{cache_options}{class} = "Cache::FileCache";
-Buscador->config->{model} = "Maypole::Model::CDBI::Plain";
-Buscador->setup([ qw/ Email::Store::Mail Email::Store::List
-Email::Store::Entity Email::Store::Entity::Name Email::Store::Attachment
-Email::Store::Entity::Address Email::Store::NamedEntity / ]);
-};
-
-Buscador->config->{rows_per_page} = 10;
-Buscador->config->{template_root} = "$home/templates";
-Buscador->config->{uri_base} = Buscador::Config->uri;
-$Email::Store::Plucene::index_path = "$home/emailstore-index";
-$Plucene::QueryParser::DefaultOperator = "AND";
-
-sub parse_path {
- my $self = shift;
- $self->{path} ||= "/mail/recent";
- $self->SUPER::parse_path();
-}
-
-package Mail::Thread; # Fscking hack!
-
-sub _get_hdr {
-
- my ($class, $msg, $hdr) = @_;
- $msg->simple->header($hdr) || '';
-}
-
-package Email::Store::Mail;
-use Text::Decorator;
-use Text::Context;
-use HTML::Entities;
-use Mail::Thread::Chronological;
-
-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/) {
- eval {
- require Encode;
- $body = Encode::decode($charset, $body);
- Encode::_utf8_off($body);
- };
- }
- $body;
-}
-
-sub lurker :Exported {
- my ($self,$r) = @_;
- my $mail = $r->objects->[0];
- my $root = $mail->container->root;
- 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;
- $r->{template_args}{thread} = $root;
-}
-
-sub recent :Exported {
- my ($self, $r) = @_;
- $self = $self->do_pager($r);
- $r->{objects} = [ $self->search_recent ];
-}
-
-sub format_body {
- my $mail = shift;
- my $decorator = Text::Decorator->new($mail->body);
- my %seen;
- my @names =
- grep {!$seen{$_->thing}++}
- grep {$_->thing =~ / /}
- grep {$_->score > 6}
- $mail->named_entities(description => "person");
- $decorator->add_filter("Quoted", begin => '<div class="level%i">',
- end => '</div>');
- $decorator->add_filter("URIFind");
- $decorator->add_filter("TTBridge" => "html" => "html_entity");
- $decorator->add_filter("NamedEntity" => @names) if @names;
- $decorator->format_as("html");
-}
-
-sub _min { $_[0] < $_[1] ? $_[0] : $_[1] }
-sub _max { $_[0] > $_[1] ? $_[0] : $_[1] }
-
-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 }
- }
- 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;
-}
-
-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);
-
-}
-
-package Email::Store::Mail;
-__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__->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
-});
-
-package Email::Store::List;
-
-sub view :Exported {
- my ($self, $r, $list) = @_;
- my $pager = Email::Store::Mail->do_pager($r);
- $r->{template_args}{recent} = [ $pager->search_recent_posts($list->id) ];
-
-}
-
-# 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"));
-
-
-package Email::Store::Entity::Name;
-sub view :Exported {
- my ($class, $r, $name) = @_;
- my $pager = Email::Store::Addressing->do_pager($r);
- $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);
- $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);
- $r->{template_args}{sorted_addressings} =
- [$pager->search_entity_sorted($self->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 }
-
-1;
-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 }
-}
-
-package Email::Store::Attachment;
-sub view :Exported {
- my ($self, $r, $att) = @_;
- $r->{content_type} = $att->content_type;
- $r->{output} = $att->payload;
-}
-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};
- 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="/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="/personunknown.gif"> </SUP>$nn</span>}gims;
- }
- }
- return $node;
-}
-
-1;
Generated at 14:00 on 08 Feb 2005 by mariachi 0.52