From 573813f5eecbb64ffba2c7a56886ac7e49acae1c Mon Sep 17 00:00:00 2001
From: Martin Kamerbeek <martin@martintwee.oqapi.nl>
Date: Thu, 27 May 2010 10:33:14 +0200
Subject: [PATCH] Adding basic list header support.

---
 lib/WebGUI/AssetAspect/Subscriber.pm | 19 +++++++++++++++++++
 lib/WebGUI/Mailing/Email.pm          |  8 ++++++++
 2 files changed, 27 insertions(+)

diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm
index a51b347..338aee8 100644
--- a/lib/WebGUI/AssetAspect/Subscriber.pm
+++ b/lib/WebGUI/AssetAspect/Subscriber.pm
@@ -105,6 +105,25 @@ sub getEditTabs {
     return ( $self->next::method, [ 'subscription', 'Subscription', 9 ] );
 }
 
+#----------------------------------------------------------------------------
+sub getListHeaders {
+    my $self    = shift;
+    my $email   = shift || return {};
+
+    my $site    = $self->session->url->getSiteURL;
+
+    my $headers = {
+        'List-Unsubscribe'  => 
+            '<' . $site . $self->getUrl( "func=processSubscription&action=unsubscribe&email=$email" ) . '>',
+        'List-Subscribe'    =>
+            '<' . $site . $self->getUrl( "func=processSubscription&action=subscribe&email=$email" ) . '>',
+        'List-Archives'     =>
+            '<' . $site . $self->getUrl . '>',
+    };
+
+    return $headers;
+}
+
 #----------------------------------------------------------------------------
 sub canSubscribe {
     my $self = shift;
diff --git a/lib/WebGUI/Mailing/Email.pm b/lib/WebGUI/Mailing/Email.pm
index bf1503e..db626a9 100644
--- a/lib/WebGUI/Mailing/Email.pm
+++ b/lib/WebGUI/Mailing/Email.pm
@@ -191,6 +191,14 @@ sub send {
     } );
     $mail->addHtml( $body );
 
+    if ( $asset->can( 'getListHeaders' ) ) {
+        my $listHeaders = $asset->getListHeaders( $self->user->get('email') );
+
+        while ( my ($header, $value) = each %{ $listHeaders } ) {
+            $mail->addHeaderField( $header, $value );
+        }
+    }
+
     # And send it.  
     my $success = $mail->send;