rev 1881 - trunk/buscador/lib/Buscador

[prev] [thread] [next] [lurker] [Date index for 2005/02/15]

From: simon
Subject: rev 1881 - trunk/buscador/lib/Buscador
Date: 12:12 on 15 Feb 2005
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