[prev] [thread] [next] [lurker] [Date index for 2005/02/15]
Author: simon
Date: 2005-02-15 12:12:16 +0000 (Tue, 15 Feb 2005)
New Revision: 1881
Modified:
trunk/buscador/lib/Buscador/Thread.pm
Log:
Add arcs
Modified: trunk/buscador/lib/Buscador/Thread.pm
===================================================================
--- trunk/buscador/lib/Buscador/Thread.pm 2005-02-15 12:08:27 UTC (rev 1880)
+++ trunk/buscador/lib/Buscador/Thread.pm 2005-02-15 12:12:16 UTC (rev 1881)
@@ -8,14 +8,15 @@
=head1 DESCRIPTION
This provides two different thread views for Buscador - traditional
-'JWZ' style view and a rather funky looking 'lurker' style. They can be
+'JWZ' style view, a rather funky looking 'lurker' style and a thread
+arc style cribbed from the IBM ReMail research project. They can be
accessed using
${base}/mail/thread/<id>
${base}/mail/lurker/<id>
+ ${base}/mail/arc/<id>
-
where C<id> can be the message-id of any message in the thread. neat, huh?
@@ -27,6 +28,9 @@
Lurker style
http://lurker.sourceforge.net
+ReMail Arc style
+http://www.research.ibm.com/remail/
+
=head1 AUTHOR
Simon Wistow <simon@xxxxxxxxxx.xxx>
@@ -49,11 +53,47 @@
$msg->simple->header($hdr) || '';
}
+package Email::Store::Thread::Arc::Link;
+use base qw(Mail::Thread::Arc);
+
+sub make_link {
+ my ($self,$message) = @_;
+
+ # check to see if we actually have this on the system
+ # if not, return undef
+ my $id = $message->messageid;
+ my $m = Email::Store::Mail->retrieve($id);
+ return undef unless $m && $m->message;
+
+ my $url = Buscador->config->{uri_base}; $url =~ s!/+$!!;
+ return "$url/message/view/$id";
+}
+
package Email::Store::Mail;
use strict;
use Mail::Thread::Chronological;
+
+sub arc :Exported {
+ my ($self,$r) = @_;
+ my $mail = $r->objects->[0];
+ my $root = $mail->container->root;
+ my $arc = Email::Store::Thread::Arc::Link->new;
+ while (1) {
+ last if $root->message->date;
+ my @children = $root->children;
+ last if (@children>1);
+ $root = $children[0];
+ }
+ my $svg = $arc->selected_message( undef )->render( $root);
+
+ $r->{content_type} = 'image/svg+xml';
+ $r->{output} = $svg->xmlify;
+}
+
+
+
sub lurker :Exported {
my ($self,$r) = @_;
my $mail = $r->objects->[0];
Generated at 13:00 on 15 Feb 2005 by mariachi 0.52