[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