diff --git a/docs/mail_commands_setup.pod b/docs/mail_commands_setup.pod new file mode 100644 index 0000000..10e0e1f --- /dev/null +++ b/docs/mail_commands_setup.pod @@ -0,0 +1,101 @@ +=head1 Configuring WebGUI mail commands + +This document discusses the steps required to tie WebGUI mal command into +postfix. + +=head2 Setting up WebGUI + +The mappings between To adress in the incoming emails and WebGUI instances is +defined in /data/WebGUI/etc/mailing_dispatch.config. This is a JSON file +containing a hash with domain to instance config file mappings: + + { + "mailing.domain1.com" : "www_domain1_com.conf", + "newsletter.foo.com" : "www_foo_com.conf" + } + +Note that any domain can be tied to any config file: domains don't have to +match. The only requirement is that the server can receive mail on the given +domain. Eg. the following is a valid mapping + + { + "newsletter.bar.com" : "www_xyzzy_com.conf" + } + +It is also possible to map multiple domains to a single config file, eg. + + { + "mailing.example.com" : "example_com.conf", + "mailing.foobar.org" : "example_com.conf" + } + +However it is not allowed to map a single domain to multiple config files. If +you do the instance that is used, is not defined. Eg. the following is NOT +allowed. + + { + "mailing.example.com" : "example_com.conf", + "mailing.example.com" : "foobar_org.conf" + } + + +=head2 Setting up Postfix + +The newsletter-transport.pl script in the webgui_newsletter sbin directory +acts as a bridge between postfix and WebGUI. It is intended to be invoked +by postfix's pipe command. + +=head3 Configuring master.cf + +We need a queue that processes mail intended for WebGUI. To do so add the +following to /etc/postfix/master.cf: + + wgml unix - n n - - pipe + flags=FR user=webgui argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl \ + --domain=${domain} --user=${user} --sender=${sender} --senderIp=${client_address} + +This creates a queue called wgml that pipes all mail in it through the +newsletter-transport.pl script. Make sure that the user parameter is set correctly and argv +contains the full path to the newsletter-transport.pl script. + + +=head3 Setup a transport map + +In order to determine which emails should go to the wgml queue, create a +mapping in /etc/postfix/wg_mailer_transport. There are more ways to do this. + +If you use a dedicated maildomain used solely for receiving WebGUI mail +commands add a line like the following for each mail domain in your +/date/WebGUI/etc/mailing_dispatch.config: + + /@mailing.foo.com$/ wgml: + /@newsletter.example.com$/ wgml: + +If you use a domain that is not solely dedicated to receiving WebGUI mail +commands, you can match on individual commands: + + /^[a-zA-Z0-9_-]+-bounce@/ wgml: + /^[a-zA-Z0-9_-]+-subscribe@/ wgml: + + +Afterwards complile the mapping into a postfix lookup table + + postmap /etc/postfix/wg_mailer_transport + +You have to do this everytime you change the mapping. + +=head3 Configuring main.cf + +Now we need to tell postfix to use the mapping, and how to use the wgml +queue. To do this add the following to /etc/postfix/main.cf: + + smtpd_reject_unlisted_recipient = no + transport_maps = regexp:/etc/postfix/wg_mailer_transport + wgml_destination_recipient_limit = 1 + +Make sure you add the domains in your mailing_dispatch.config to the +mydestination directlive in main.cf: + + mydestination = mailing.foo.com, newsletter.example.org, some.other.domain + +Finally restart postfix. diff --git a/docs/postfix_configuration b/docs/postfix_configuration deleted file mode 100644 index b6ee775..0000000 --- a/docs/postfix_configuration +++ /dev/null @@ -1,17 +0,0 @@ -Add to /etc/postfix/main.cf: - smtpd_reject_unlisted_recipient = no - transport_maps = regexp:/etc/postfix/wg_mailer_transport - wgml_destination_recipient_limit = 1 - -Add to /etc/postfix/master.cf: - wgml unix - n n - - pipe - flags=FR user=martin argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl ${domain} ${user} - - -Create /etc/postfix/wg_mailer_transport: - /^[a-zA-Z0-9]+-bounce@/ wgml: - -And run: - postmap /etc/postfix/wg_mailer_transport - -Finally restart postfix. diff --git a/docs/required_modules b/docs/required_modules index f1d1dac..b8200dc 100644 --- a/docs/required_modules +++ b/docs/required_modules @@ -1,3 +1,3 @@ -Mail::DeliveryStatus::BounceParser -Class::InsideOut +Mail::DeliveryStatus::BounceParser (v 1.525) +Class::InsideOut (v 1.10) diff --git a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm index 85a42d1..d0a234a 100644 --- a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm +++ b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm @@ -8,7 +8,7 @@ use Class::C3; use WebGUI::User::SpecialState; use base qw{ - WebGUI::AssetAspect::Mailable + WebGUI::AssetAspect::Mailable WebGUI::AssetAspect::Subscriber WebGUI::Asset::Wobject }; @@ -34,11 +34,18 @@ sub definition { tab => 'display', defaultValue => 1, }, + useHoneypot => { + fieldType => 'yesNo', + label => $i18n->get('useHoneypot label'), + hoverHelp => $i18n->get('useHoneypot description'), + tab => 'security', + defaultValue => 1, + }, ); - + push @{ $definition }, { assetName => $i18n->get('assetName'), - icon => 'newWobject.gif', + icon => 'newsletter_collection.gif', autoGenerateForms => 1, tableName => 'NewsletterCollection', className => 'WebGUI::Asset::Wobject::NewsletterCollection', @@ -52,12 +59,16 @@ sub definition { sub getIssues { my $self = shift; - my $issues = $self->getLineage( [ 'children' ], { - returnObjects => 1, - orderByClause => 'lineage desc', - } ); - - return $issues; + # Caching of instanciated assets is not for speed, but is requied since prepareView is called on them, and we + # need them again in that state in getViewVars. + unless ( $self->{ _issues } ) { + $self->{ _issues } = $self->getLineage( [ 'children' ], { + returnObjects => 1, + orderByClause => 'lineage desc', + } ); + } + + return $self->{ _issues }; } #---------------------------------------------------------------------------- @@ -88,7 +99,8 @@ sub getAssetContent { my $self = shift; my $asset = shift; - $asset->prepareView; + # Do not call prepareView on $asset here but rather do this in our own prepareView to prevent head tags being + # written to body. my $content = $asset->view; return $content; @@ -106,6 +118,11 @@ sub prepareView { $self->{ _viewTemplate } = $template; + # Call prepareview on issues here, to prevent head tags ending up in the body. + foreach my $issue ( @{ $self->getIssues } ) { + $issue->prepareView; + } + return; } @@ -126,11 +143,11 @@ sub getViewVars { foreach my $issue ( @{ $issues } ) { my $issueVar = $issue->get; $issueVar->{ url } = $issue->getUrl; - - my $isRecent = - ( !$displayIssueId && $recentCount < $maxRecent ) - || ( $issue->getId eq $displayIssueId ) - ; + + my $isRecent = defined $displayIssueId + ? $issue->getId eq $displayIssueId + : $recentCount < $maxRecent + ; if ( $isRecent ) { $issueVar->{ content } = $self->getAssetContent( $issue ); @@ -157,7 +174,7 @@ sub view { my $self = shift; my $form = $self->session->form; - my $var = $self->getViewVars( { + my $var = $self->getViewVars( { displayIssue => $form->guid('displayIssue'), } ); @@ -165,4 +182,3 @@ sub view { } 1; - diff --git a/lib/WebGUI/AssetAspect/Mailable.pm b/lib/WebGUI/AssetAspect/Mailable.pm index 90bc717..5efa6c7 100644 --- a/lib/WebGUI/AssetAspect/Mailable.pm +++ b/lib/WebGUI/AssetAspect/Mailable.pm @@ -2,7 +2,7 @@ package WebGUI::AssetAspect::Mailable; use strict; use warnings; -use Class::C3; +use Class::C3; use WebGUI::Macro; use Tie::IxHash; @@ -115,13 +115,15 @@ sub processContentAsUser { $session->user( { userId => $userId } ); $session->log->preventDebugOutput; - my $styleTemplateId = - $configuration->{ styleTemplateId } - || $self->get('mailStyleTemplateId') + my $styleTemplateId = + $configuration->{ styleTemplateId } + || $self->get('mailStyleTemplateId') || $self->get('styleTemplateId'); + $session->stow->set( 'mailing_rendering' => 1 ); + # Generate email body for this user - my $content = $session->style->process( + my $content = $session->style->process( $self->generateEmailContent( $issueId, $configuration ), $styleTemplateId, ); @@ -129,10 +131,13 @@ sub processContentAsUser { # Process macros WebGUI::Macro::process( $session, \$content ); + $session->stow->delete( 'mailing_rendering' ); + # Become ourselves again. $session->user( { userId => $currentUser->getId } ); $var->switchAdminOn if $adminOn; + return $content; } diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 272e14a..fed9da6 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -2,11 +2,19 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; -use Class::C3; +use 5.010; +use Class::C3; use Carp; use WebGUI::Asset::Template; use WebGUI::Macro; +use WebGUI::Mail::Send; +use WebGUI::Group; +use WebGUI::Asset; +use WebGUI::Form; +use WebGUI::Form::Honeypot; +use WebGUI::User::SpecialState; +use WebGUI::International; use Tie::IxHash; use URI; @@ -18,6 +26,11 @@ sub definition { my $i18n = WebGUI::International->new( $session,'AssetAspect_Subscriber' ); tie my %properties, 'Tie::IxHash', ( + listName => { + fieldType => 'text', + label => $i18n->echo("List name"), + tab => 'subscription', + }, subscriptionGroupId => { fieldType => 'subscriptionGroup', label => $i18n->get( 'Subscription group' ), @@ -33,7 +46,7 @@ sub definition { alwaysConfirmSubscription => { fieldType => 'yesNo', defaultValue => 0, - label => $i18n->get( 'require confirmation' ), + label => $i18n->get( 'require confirmation' ), tab => 'subscription', }, allowAnonymousSubscription => { @@ -75,6 +88,13 @@ sub definition { namespace => 'Subscriber/NoMutationEmail', tab => 'subscription', }, + confirmMutationTemplateId => { + fieldType => 'template', + defaultValue => 'WUk-wEhGiF8dcEogrJfrfg', + label => $i18n->get( 'confirm mutation template' ), + namespace => 'Subscriber/MutationConfirmation', + tab => 'subscription', + } ); push( @{ $definition }, { @@ -116,7 +136,7 @@ sub getListHeaders { my $site = $self->session->url->getSiteURL; my $headers = { - 'List-Unsubscribe' => + 'List-Unsubscribe' => '<' . $site . $self->getUrl( "func=processSubscription&action=unsubscribe&email=$email" ) . '>', 'List-Subscribe' => '<' . $site . $self->getUrl( "func=processSubscription&action=subscribe&email=$email" ) . '>', @@ -173,6 +193,44 @@ sub isSubscribed { } #---------------------------------------------------------------------------- +=head2 appendSubscriptionFormVars + +=head3 honeyPot +Part of the form vars are the honeyPot variables. This is a form plugin that +is used in NewsletterCollection.pm to activate the use of a honeypot or not, +in this module, AssetAspect/Subscriber.pm, to check the honeypot and to +display the form values and in i18n. + +There are the following form vars: + +=head4 subscriptionForm_emailBox +This renders both the emailbox, subscribe/unsubscribe radio buttons and the +honeypot form inputs: + +
+ + +
+ + + +You can easily make the honeypot input field invisible with some css for +class honeypot. + +=head4 form_honeypot +Renders these fields: + + + +=head4 form_honeypot_id +Gives you the id for the honeypot input. This makes it easy to create a label: + + +=cut sub appendSubscriptionFormVars { my $self = shift; my $var = shift || {}; @@ -180,16 +238,41 @@ sub appendSubscriptionFormVars { my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); # Setup form controls - my $formHeader = + my $formHeader = WebGUI::Form::formHeader( $session, { action => $self->getUrl } ) . WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } ) ; - my $subscribeButton = - sprintf '', $i18n->get('subscribe'); - my $unsubscribeButton = - sprintf '', $i18n->get('unsubscribe'); - my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } ); my $formFooter = WebGUI::Form::formFooter( $session ); + my $subscribeButton = + $formHeader + . WebGUI::Form::hidden( $session, { name => 'action', value => 'subscribe' } ) + . WebGUI::Form::submit( $session, { value => $i18n->get('subscribe') } ) + . $formFooter + ; + my $unsubscribeButton = + $formHeader + . WebGUI::Form::hidden( $session, { name => 'action', value => 'unsubscribe' } ) + . WebGUI::Form::submit( $session, { value => $i18n->get('unsubscribe') } ) + . $formFooter + ; + # honeypot is connected to the emailbox, that is displayed on anonymous subscription + # and only if set to useHoneyPot in definition/display + my $honeypot = WebGUI::Form::Honeypot->new( $self->session, { name => 'hp' } ); + my $honeypot_form = $self->get('useHoneypot') ? $honeypot->toHtml : ''; + my $emailBox = + $formHeader + . WebGUI::Form::email( $session, { name => 'email', value => '' } ) + . WebGUI::Form::radioList( $session, { + name => 'action', + options => { + subscribe => $i18n->get('subscribe'), + unsubscribe => $i18n->get('unsubscribe'), + } + } ) + . $honeypot_form + . WebGUI::Form::submit( $session ) + . $formFooter + ; # Compose default subscription form for current user my $form = ''; @@ -198,19 +281,21 @@ sub appendSubscriptionFormVars { $form .= $unsubscribeButton if $self->canUnsubscribe; } elsif ( $self->get('allowAnonymousSubscription') ) { - $form = $emailBox . $subscribeButton . $unsubscribeButton; + $form = $emailBox; } # Setup tmpl_vars - $var->{ subscriptionForm_form } = "$formHeader $form $formFooter" if $form; + $var->{ subscriptionForm_form } = $form if $form; $var->{ subscriptionForm_header } = $formHeader; $var->{ subscriptionForm_footer } = $formFooter; $var->{ subscriptionForm_subscribeButton } = $subscribeButton; $var->{ subscriptionForm_unsubscribeButton } = $unsubscribeButton; - $var->{ subscrittionForm_emailBox } = $emailBox; + $var->{ subscriptionForm_emailBox } = $emailBox; $var->{ user_canSubscribe } = $self->canSubscribe; $var->{ user_canUnsubscribe } = $self->canUnsubscribe; $var->{ user_isRegistered } = $session->user->isRegistered; + $var->{ form_honeypot } = $honeypot->toHtml; + $var->{ form_honeypot_id } = $honeypot->get('id'); return $var; } @@ -219,8 +304,8 @@ sub appendSubscriptionFormVars { sub getSubscriptionGroup { my $self = shift; my $groupId = $self->get( "subscriptionGroupId" ); - my $group = $groupId - ? WebGUI::Group->new( $self->session, $groupId ) + my $group = $groupId + ? WebGUI::Group->new( $self->session, $groupId ) : $self->createSubscriptionGroup ; @@ -231,7 +316,7 @@ sub getSubscriptionGroup { sub getReturnUrl { my $self = shift; my $referer = $self->session->env->get('HTTP_REFERER'); - + return unless $referer; # Get path and strip leading and trailing slash if it exists. @@ -263,6 +348,45 @@ sub getEmailVars { return $var; } +#---------------------------------------------------------------------------- +sub getAssetByListName { + my $class = shift; + my $session = shift; + my $listName = shift || return; + my $db = $session->db; + + my $assetId = $db->quickScalar( 'select assetId from assetAspectSubscriber where listName=? limit 1', [ + $listName + ] ); + + return unless $assetId; + + my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + + return $asset; +} + +#---------------------------------------------------------------------------- +sub processPropertiesFromFormPost { + my $self = shift; + my $session = $self->session; + my $form = $session->form; + + my $listName = $form->get('listName'); + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); + + my $errors = $self->next::method; + + if ( $asset && $asset->getId ne $self->getId ) { + return [ + @{ $errors || [] }, + "List name $listName is already taken." + ]; + } + + return $errors; +} + #---------------------------------------------------------------------------- sub sendSubscriptionConfirmation { my $self = shift; @@ -271,7 +395,13 @@ sub sendSubscriptionConfirmation { my $action = shift || 'subscribe'; my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); - +=pod + my $honeypot = $session->form->honeypot( 'hp' ); + if ( $self->get('useHoneypot') && $honeypot ) { + $session->log->warn( "Honeypot triggered: $honeypot" ); + return; + } +=cut my $var = $self->getEmailVars( $user ); my $url = $session->url->getSiteURL . $self->getUrl( "func=confirmMutation;code=$code" ); @@ -280,14 +410,18 @@ sub sendSubscriptionConfirmation { $var->{ actionIsSubscribe } = $action eq 'subscribe'; my $mail = WebGUI::Mail::Send->create( $self->session, { - to => $user->get('email'), - subject => $self->get('confirmationEmailSubject'), + to => $user->get('email'), + subject => $self->get('confirmationEmailSubject'), + contentType => 'multipart/alternative', } ); my $templateId = $self->get('confirmationEmailTemplateId'); my $template = WebGUI::Asset::Template->new( $session, $templateId ); if ( $template ) { - $mail->addHtml( $template->process( $var ) ); + my $content = $template->process( $var ); + + $mail->addHtml( $content ); + $mail->addText( $self->transformToText( $content ) ); } else { $session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" ); @@ -306,19 +440,29 @@ sub sendNoMutationEmail { my $action = shift || 'subscribe'; my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); - +=pod + my $honeypot = $session->form->honeypot( 'hp' ); + if ( $self->get('useHoneypot') && $honeypot ) { + $session->log->warn( "Honeypot triggered: $honeypot" ); + return; + } +=cut my $var = $self->getEmailVars( $user ); $var->{ actionIsSubscribe } = $action eq 'subscribe'; my $mail = WebGUI::Mail::Send->create( $self->session, { - to => $user->get('email'), - subject => $self->get('noMutationEmailSubject'), + to => $user->get('email'), + subject => $self->get('noMutationEmailSubject'), + contentType => 'multipart/alternative', } ); my $templateId = $self->get('noMutationEmailTemplateId'); my $template = WebGUI::Asset::Template->new( $session, $templateId ); if ( $template ) { - $mail->addHtml( $template->process( $var ) ); + my $content = $template->process( $var ); + + $mail->addHtml( $content ); + $mail->addText( $self->transformToText( $content ) ); } else { $session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" ); @@ -332,6 +476,18 @@ sub sendNoMutationEmail { return; } +sub transformToText { + my $self = shift; + my $html = shift; + + my $text = $html; + #HTML::Entities::decode($text); + $text =~ s/(.+?)<\/a>/$2 ($1)/g; + $text = WebGUI::HTML::html2text($text); + + return $text; +} + #---------------------------------------------------------------------------- sub logConfirmation { my $self = shift; @@ -339,7 +495,7 @@ sub logConfirmation { my $session = $self->session; my $db = $session->db; - $db->write( + $db->write( ' update assetAspectSubscriber_log set ' .' confirmationIp=?, confirmationDate=?, confirmed=? where code=? and assetId=?', [ @@ -363,7 +519,7 @@ sub logRequest { my $session = $self->session; my $db = $session->db; - $db->write( + $db->write( ' insert into assetAspectSubscriber_log set ' .' assetId=?, requestIp=?, requestDate=?, code=?, confirmed=?, anonymous=?, type=?, userId=?, email=?', [ @@ -389,6 +545,7 @@ sub subscribe { my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); my $session = $self->session; + if ( $requireConfirm ) { if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) { $self->sendNoMutationEmail( $user, 'subscribe' ); @@ -414,7 +571,7 @@ sub unsubscribe { my $self = shift; my $user = shift || $self->session->user; my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); - + my $session = $self->session; if ( $requireConfirm ) { @@ -447,29 +604,72 @@ sub www_confirmMutation { my $code = $form->get('code'); return unless $code; - my ($userId, $type) = $db->quickArray( - 'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?', + my ($userId, $type) = $db->quickArray( + 'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?', [ 0, $code, ] ); + my $var = { + message => $i18n->get( 'wrong code' ), + returnUrl => $self->getUrl, + isSuccess => 0, + "is$type" => 1, + }; if ( $userId ) { $self->logConfirmation( $code ); if ( $type eq 'subscribe' ) { $self->getSubscriptionGroup->addUsers( [ $userId ] ); - return $self->processStyle( sprintf $i18n->get( 'subscription successful'), $self->getUrl ); + + $var->{ message } = sprintf $i18n->get( 'subscription successful'), $self->getUrl; + $var->{ isSuccess } = 1; } elsif ( $type eq 'unsubscribe' ) { $self->getSubscriptionGroup->deleteUsers( [ $userId ] ); - return $self->processStyle( sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl ); + + $var->{ message } = sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl; + $var->{ isSuccess } = 1; } } - return $self->processStyle( $i18n->get( 'wrong code' ) ); + return $self->processStyle( $self->processTemplate( $var, $self->get('confirmMutationTemplateId') ) ); +} +#---------------------------------------------------------------------------- +sub subscribeAnonymous { + my $self = shift; + my $email = shift; # TODO || return ? + my $session = $self->session; + + my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); + + # If email address doesn't have an account, create one. + if ( !defined $emailUser ) { + $emailUser = WebGUI::User::SpecialState->create( $session ); + $emailUser->update( { email => $email } ); + } + $emailUser->addSpecialState( 'Subscriber', $self->getId ); + + $self->subscribe( $emailUser, 1 ); + + return; +} + +#---------------------------------------------------------------------------- +sub unsubscribeAnonymous { + my $self = shift; + my $email = shift; + my $session = $self->session; + + my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); + if ( defined $emailUser ) { + $self->unsubscribe( $emailUser, 1 ); + } + + return; } #---------------------------------------------------------------------------- @@ -482,6 +682,12 @@ sub www_processSubscription { my $action = $form->get( 'action' ); return unless $action eq 'subscribe' || $action eq 'unsubscribe'; + my $honeypot = $session->form->honeypot( 'hp' ); + if ( $self->get('useHoneypot') && $honeypot ) { + $session->log->warn( "Honeypot triggered: $honeypot" ); + return; + } + if ( $session->user->isRegistered ) { if ( $action eq 'subscribe' && $self->canSubscribe ) { $self->subscribe; @@ -496,18 +702,9 @@ sub www_processSubscription { my $email = $form->email( 'email' ); return 'Error: no email address passed' unless $email; - my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); - if ( $action eq 'unsubscribe' && defined $emailUser ) { - $self->unsubscribe( $emailUser, 1 ); - } - if ( $action eq 'subscribe' ) { - if ( !defined $emailUser ) { - $emailUser = WebGUI::User::SpecialState->create( $session ); - $emailUser->update( { email => $email } ); - } - $emailUser->addSpecialState( 'Subscriber', $self->getId ); - - $self->subscribe( $emailUser, 1 ); + given ( $action ) { + when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); } + when ( 'subscribe' ) { $self->subscribeAnonymous( $email ); } } } else { @@ -545,4 +742,3 @@ sub www_unsubscribe { } 1; - diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm new file mode 100644 index 0000000..a37aca1 --- /dev/null +++ b/lib/WebGUI/MailCommand.pm @@ -0,0 +1,56 @@ +package WebGUI::MailCommand; + +use strict; +use warnings; + +sub isValidCommand { + my $command = shift; + + return defined resolveCommandClass( $command ); +} + +sub new { + my $class = shift; + my $session = shift || die "Need a session"; + + bless { _session => $session }, $class; +} + +sub process { + WebGUI::Error::OverrideMe->throw; +} + +sub processCommand { + my $session = shift; + my $command = shift; + my $parameter = shift; + my $sender = shift; + + my $commandClass = resolveCommandClass( $command ) + || return; + + my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] ); + + return $commandObject->process( $parameter, $sender ); +} + +sub session { + return (shift)->{ _session }; +} + +sub resolveCommandClass { + my $command = shift; + + # TODO: Do not hard code. + my %commands = ( + unsubscribe => 'WebGUI::MailCommand::Unsubscribe', + subscribe => 'WebGUI::MailCommand::Subscribe', + bounce => 'WebGUI::MailCommand::Bounce', + ); + + return $commands{ $command } if exists $commands{ $command }; + return; +} + +1; + diff --git a/lib/WebGUI/MailCommand/Bounce.pm b/lib/WebGUI/MailCommand/Bounce.pm new file mode 100644 index 0000000..752195b --- /dev/null +++ b/lib/WebGUI/MailCommand/Bounce.pm @@ -0,0 +1,40 @@ +package WebGUI::MailCommand::Bounce; + +use strict; +use warnings; + +use WebGUI::Mailing::Email; +use Mail::DeliveryStatus::BounceParser; + +use base 'WebGUI::MailCommand'; + +#----------------------------------------------------------------------------- +sub process { + my $self = shift; + my $hexId = shift; + my $session = $self->session; + my $log = $session->log; + my $id = $session->id->fromHex( $hexId ); + + my $email = WebGUI::Mailing::Email->new( $session, $id ); + + if ($email) { + my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN ); + + my $report = ( $dsr->reports )[0]; + my $reason = $report->get( 'std_reason' ); + my $message = $report->get( 'reason' ); + $message =~ s{\s+}{ }g; + + $log->warn( "Registering email [$id] as bounced." ); + $email->registerBounced( $reason, $message ); + } + else { + $log->error( "Cannot process bounced email [$id] because it cannot be located in the db." ); + } + + return; +} + +1; + diff --git a/lib/WebGUI/MailCommand/Subscribe.pm b/lib/WebGUI/MailCommand/Subscribe.pm new file mode 100644 index 0000000..2244b1b --- /dev/null +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -0,0 +1,28 @@ +package WebGUI::MailCommand::Subscribe; + +use strict; +use warnings; + +use WebGUI::AssetAspect::Subscriber; + +use base 'WebGUI::MailCommand'; + +#----------------------------------------------------------------------------- +sub process { + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + my $log = $session->log; + + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->subscribeAnonymous( $fromAddress ); + + return; +} + +1; + diff --git a/lib/WebGUI/MailCommand/Unsubscribe.pm b/lib/WebGUI/MailCommand/Unsubscribe.pm new file mode 100644 index 0000000..e7ca1ca --- /dev/null +++ b/lib/WebGUI/MailCommand/Unsubscribe.pm @@ -0,0 +1,27 @@ +package WebGUI::MailCommand::Unsubscribe; + +use strict; +use warnings; + +use WebGUI::AssetAspect::Subscriber; + +use base 'WebGUI::MailCommand'; + +#----------------------------------------------------------------------------- +sub process { + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->unsubscribeAnonymous( $fromAddress ); + + return; +} + +1; + diff --git a/lib/WebGUI/Mailing.pm b/lib/WebGUI/Mailing.pm index 14a2f0a..93d8124 100644 --- a/lib/WebGUI/Mailing.pm +++ b/lib/WebGUI/Mailing.pm @@ -5,6 +5,8 @@ use warnings; use Carp; use WebGUI::Mailing::Admin; +use WebGUI::Mailing::Email; + use JSON qw{ to_json }; use base 'WebGUI::Crud'; @@ -38,7 +40,7 @@ sub cancel { ); }; - $self->update( { + $self->update( { state => 'idle', sendDate => undef, } ); @@ -63,7 +65,7 @@ sub crud_definition { assetId => { fieldType => 'guid', }, - + issueId => { fieldType => 'guid', }, @@ -81,7 +83,7 @@ sub crud_definition { }, ); - $definition->{ properties } = { + $definition->{ properties } = { %{ $definition->{ properties } || {} }, %properties, }; @@ -92,7 +94,7 @@ sub crud_definition { #---------------------------------------------------------------------------- sub delete { my $self = shift; - + $self->deleteQueuedEmails; return $self->SUPER::delete; @@ -101,12 +103,17 @@ sub delete { #---------------------------------------------------------------------------- sub deleteQueuedEmails { my $self = shift; - + my $it = $self->getQueuedEmailIterator; while ( my $email = $it->() ) { $email->delete; } + $it = $self->getQueuedTestEmailIterator; + while ( my $email = $it->() ) { + $email->delete; + } + return; } @@ -144,6 +151,14 @@ sub getQueuedEmailIterator { return WebGUI::Mailing::Email->getQueued( $session, $self->getId ); } +#---------------------------------------------------------------------------- +sub getQueuedTestEmailIterator { + my $self = shift; + my $session = $self->session; + + return WebGUI::Mailing::Email->getQueuedTestEmails( $session, $self->getId ); +} + #---------------------------------------------------------------------------- sub getNextInSendQueue { my $class = shift; @@ -165,8 +180,8 @@ sub getStatusLine { my $self = shift; my $db = $self->session->db; - my $sth = $db->read( - 'select status, isTest, count( status ) as cnt from Mailing_email where mailingId=? group by status,isTest', + my $sth = $db->read( + 'select status, isTest, count( status ) as cnt from Mailing_email where mailingId=? group by status,isTest', [ $self->getId, ], @@ -245,7 +260,7 @@ sub queue { $state, ); }; - + $self->queueEmails( $self->getAsset->getRecipients ); $self->update( { @@ -270,7 +285,7 @@ sub queueEmails { recipientEmail => undef, isTest => 0, } ); - + } return; @@ -319,7 +334,7 @@ sub send { $state, ); }; - + $self->update( { state => 'sending' } ); my $complete = $self->sendQueuedEmails( $timeLimit ); @@ -346,7 +361,7 @@ sub sendQueuedEmails { $email->send; } - + return 1; } @@ -365,7 +380,7 @@ sub www_cancel { $i18n->get('cancel mailing success'), $i18n->get('cancel mailing'), ); - } + } else { return $self->renderInConsole( $i18n->get('cancel mailing failure'), @@ -400,13 +415,13 @@ sub www_delete { #---------------------------------------------------------------------------- sub www_edit { - my $self = shift; - my $session = $self->session; - my $i18n = WebGUI::International->new( $session, 'MailingManager' ); + my $self = shift; + my $session = $self->session; + my $i18n = WebGUI::International->new( $session, 'MailingManager' ); return $session->privilege->insufficient unless $self->admin->canManage; - my $f = WebGUI::HTMLForm->new( $session ); + my $f = $self->getEditForm; $f->hidden( name => 'newsletter', value => 'mailing', @@ -420,16 +435,29 @@ sub www_edit { value => $self->getId, ); + return $self->renderInConsole( $f->print, $i18n->get('configure mailing') ); +} + +#---------------------------------------------------------------------------- +sub getEditForm { + my $self = shift; + my $session = $self->session; + my $i18n = WebGUI::International->new( $session, 'MailingManager' ); + my $f = WebGUI::HTMLForm->new( $session ); + my %fields = %{ $self->getAsset->getMailingProperties( $self ) }; my $configuration = $self->get('configuration') || {}; while ( my( $name, $properties ) = each %fields ) { $properties->{ name } = $name; - $properties->{ value } = $configuration->{ $name } if exists $properties->{ value }; + $properties->{ value } = $configuration->{ $name } if exists $configuration->{ $name }; my $formField = WebGUI::Form::DynamicField->new( $session, %{ $properties } ); - my $html = $self->admin->canOverride - ? $formField->toHtml - : $formField->getValueAsHtml + my $element = $formField->toHtml; # Works around a bug in WG::Form::Template in < 7.9.8 + my $readonly = $formField->getValueAsHtml; # where getValueAsHtml wouldn't set the correct options hashref + + my $html = $self->admin->canOverride || $properties->{ managerCanEdit } + ? $element + : $readonly ; $f->readOnly( @@ -440,12 +468,12 @@ sub www_edit { $f->submit( value => $i18n->get( 'generate mailing' ) ); my $cancelUrl = $session->url->page( 'newsletter=manage' ); - $f->button( + $f->button( value => $i18n->get( 'cancel' ), extras => qq{onclick="window.location='$cancelUrl'" class="backwardButton"}, ); - return $self->renderInConsole( $f->print, $i18n->get('configure mailing') ); + return $f; } #---------------------------------------------------------------------------- @@ -468,7 +496,7 @@ sub www_previewEmail { my $session = $self->session; my ( $form, $url ) = $session->quick( 'form', 'url' ); my $i18n = WebGUI::International->new( $session, 'MailingManager' ); - + return $session->privilege->insufficient unless $self->admin->canManage; my $asset = $self->getAsset; @@ -476,7 +504,7 @@ sub www_previewEmail { my $manageUrl = $url->page('newsletter=manage'); my $subject = $asset->getSubject( $self->get('configuration') ); - my $userSelection = + my $userSelection = qq{

Terug naar de mailing manager.

@@ -498,11 +526,11 @@ sub www_previewEmail { } - - - - - + + + + + +EOJS + + $style->setLink( $url->extras('yui/build/datatable/assets/skins/sam/datatable.css'), { type => 'text/css', rel => 'stylesheet' } ); + $style->setScript( $url->extras('yui/build/yahoo-dom-event/yahoo-dom-event.js'), { type => 'text/javascript' } ); + $style->setScript( $url->extras('yui/build/element/element-min.js'), { type => 'text/javascript' } ); + $style->setScript( $url->extras('yui/build/datasource/datasource-min.js'), { type => 'text/javascript' } ); + $style->setScript( $url->extras('yui/build/datatable/datatable-min.js'), { type => 'text/javascript' } ); + $style->setRawHeadTags( $js ); + + return; +} + + 1; diff --git a/lib/WebGUI/Mailing/Email.pm b/lib/WebGUI/Mailing/Email.pm index c925fdb..9445285 100644 --- a/lib/WebGUI/Mailing/Email.pm +++ b/lib/WebGUI/Mailing/Email.pm @@ -5,6 +5,7 @@ use warnings; use HTML::TreeBuilder; use WebGUI::HTML; +use WebGUI::Mailing::Bounce; use base 'WebGUI::Crud'; @@ -53,7 +54,7 @@ sub crud_definition { }, ); - $definition->{ properties } = { + $definition->{ properties } = { %{ $definition->{ properties } || {} }, %properties, }; @@ -66,6 +67,7 @@ sub getMailing { my $self = shift; my $session = $self->session; + require WebGUI::Mailing; my $mailing = WebGUI::Mailing->new( $session, $self->get('mailingId') ); #### TODO: error checking; return $mailing; @@ -126,20 +128,19 @@ sub absolutifyURIs { my $tb = HTML::TreeBuilder->new; my $root = $tb->parse( $content ); - foreach my $link ( @{ $root->extract_links } ) { + foreach my $link ( @{ $root->extract_links } ) { my ($uri, $element, $attr, $tag) = @{ $link }; - - if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) { - my $new = + if ( $uri !~ m{ ^ (?: [a-z]+:// | \# | mailto: ) }xmsi ) { + my $new = ( $uri =~ m{ ^ / }xmsi ) # Is url absolute? ? $siteUrl . $uri : $siteUrl . $pageUrl . '/' . $uri ; - + # replace attribute $element->attr( $attr, $new ); } - } + } return $tb->as_HTML; } @@ -148,13 +149,11 @@ sub transformToText { my $self = shift; my $html = shift; -# my $text = $html; -# #HTML::Entities::decode($text); -# $text =~ s/(.+?)<\/a>/$2 ($1)/g; -# $text = WebGUI::HTML::html2text($text); + my $text = $html; + #HTML::Entities::decode($text); + $text =~ s/(.+?)<\/a>/$2 ($1)/g; + $text = WebGUI::HTML::html2text($text); - use HTML::FormatText::WithLinks::AndTables; - my $text = HTML::FormatText::WithLinks::AndTables->convert( $html ); return $text; } @@ -167,7 +166,7 @@ sub send { #### TODO: Error checking my $mailing = $self->getMailing; unless ( $mailing ) { - $session->log->error( 'Cannot send because getMailing doesn\'t return one.' ); + $session->log->error( 'Cannot send because getMailing doesn\'t return one.' ); return; } @@ -193,7 +192,7 @@ sub send { # Check bounce score my $bounceScoreOk = WebGUI::Mailing::Bounce->new( $session )->bounceScoreOk( $to ); if ( !$self->get( 'isTest' ) && !$bounceScoreOk ) { - $self->update( { + $self->update( { status => 'skipped', sendDate => time, errorMessage => "Bounce score for $to too high", @@ -228,14 +227,14 @@ sub send { } } - # And send it. + # And send it. my $success = $mail->send; if ( $success ne '1' ) { $self->error( "Mail couldn't be sent by WebGUI::Mail::Send" ); } else { - $self->update( { + $self->update( { status => 'sent', sendDate => time, sentTo => $to, diff --git a/lib/WebGUI/Registration/Step/MailingSubscribe.pm b/lib/WebGUI/Registration/Step/MailingSubscribe.pm new file mode 100644 index 0000000..997d8b8 --- /dev/null +++ b/lib/WebGUI/Registration/Step/MailingSubscribe.pm @@ -0,0 +1,201 @@ +package WebGUI::Registration::Step::MailingSubscribe; + +use strict; +use warnings; + +use Tie::IxHash; +use List::MoreUtils qw{ uniq }; + +use WebGUI::Form::Checkbox; + +use base qw{ WebGUI::Registration::Step }; + +#------------------------------------------------------------------- +sub getAvailableMailings { + my $self = shift; + my $session = $self->session; + + my $mailingIds = $self->get( 'includeMailings' ); + + my @mailings = + grep { defined $_ } + map { WebGUI::Asset->newByDynamicClass( $session, $_ ) } + ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds + ; + + return \@mailings; +} + +#------------------------------------------------------------------- +sub apply { + my $self = shift; + my $user = $self->registration->instance->user; + + my $subscribeTo = { + map { $_ => 1 } @{ $self->getConfigurationData->{ subscribeMailings } || [] } + }; + + my $availableMailings = $self->getAvailableMailings; + + my $sendNotification = 0; + foreach my $mailing ( @{ $availableMailings } ) { + next unless $mailing->isa( 'WebGUI::AssetAspect::Subscriber' ); + + if ( $subscribeTo->{ $mailing->getId } ) { + $mailing->subscribe( $user, $sendNotification ) unless $mailing->isSubscribed( $user ); + } + else { + $mailing->unsubscribe( $user, $sendNotification ) if $mailing->isSubscribed( $user ); + } + } + + return; +} + +#------------------------------------------------------------------- +sub crud_definition { + my $class = shift; + my $session = shift; + my $definition = $class->SUPER::crud_definition( $session ); + my $i18n = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' ); + + tie my %mailings, 'Tie::IxHash', ( + map { $_->getId => $_->getTitle } + @{ + WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], { + returnObjects => 1, + isa => 'WebGUI::Asset::Wobject::NewsletterCollection', + } ) + } + ); + + $definition->{ dynamic }->{ includeMailings } = { + fieldType => 'checkList', + label => $i18n->get('Include newsletters'), + options => \%mailings, + vertical => 1, + }; + + return $definition; +} + +#------------------------------------------------------------------- +sub getSummaryTemplateVars { + my $self = shift; + my $includeAdminControls = shift; + my $session = $self->session; + my $i18n = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' ); + my @fields; + + # Fetch preferred homepage url + my $mailings = $self->getConfigurationData->{ subscribeMailings }; + + my @assets = + grep { defined $_ } + map { WebGUI::Asset->newByDynamicClass( $session, $_ ) } + @{ $mailings }; + + push @fields, { + field_label => $i18n->get( 'Subscribe to mailings' ), + field_value => join( ', ', map { $_->getTitle } @assets ), + }; + + # Setup tmpl_var + my $var = { + field_loop => \@fields, + category_label => $self->get('title'), + category_edit_url => $self->changeStepDataUrl, + }; + + return ( $var ); +} + +#------------------------------------------------------------------- +sub getViewVars { + my $self = shift; + my $session = $self->session; + my $form = $session->form; + my $user = $self->registration->instance->user; + my $i18n = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' ); + + my $availableMailings = $self->getAvailableMailings; + + # Figure out what mailings to check in the form + my @subscribeMailings; + if ( $form->checkList( 'subscribeMailings' ) ) { + # The user just posted but made an error + @subscribeMailings = $form->checkList( 'subscribeMailings' ); + } + elsif ( exists $self->getConfigurationData->{'subscribeMailings'} ) { + # The step is being changed + @subscribeMailings = @{ $self->getConfigurationData->{'subscribeMailings'} || [] }; + } + else { + # The step hasn't been done yet. + @subscribeMailings = map { $_->getId } grep { $_->isSubscribed( $user ) } @{ $availableMailings }; + } + + # Create lookup table + my %isSubscribed = map { $_ => 1 } @subscribeMailings; + + my $var = $self->SUPER::getViewVars; + + # Add form elems in alphabetic order. + foreach my $mailing ( sort { $a->getTitle cmp $b->getTitle } @{ $availableMailings } ) { + my $id = $mailing->getId; + + push @{ $var->{ field_loop } }, ( + { + field_label => $mailing->getTitle, + field_formElement => + WebGUI::Form::checkbox( $session, { + name => 'subscribeMailings', + value => $id, + checked => $isSubscribed{ $id }, + label => $i18n->get( 'Subscribe to this mailing' ), + }), + } + ); + } + + return $var; +} + +#------------------------------------------------------------------- +sub isComplete { + my $self = shift; + + return defined $self->getConfigurationData->{subscribeMailings}; +} + +#------------------------------------------------------------------- +sub onDeleteAccount { + my $self = shift; + my $doit = shift; + my $session = $self->session; + + $self->SUPER::onDeleteAccount( $doit ); + + return; +} + +#------------------------------------------------------------------- +sub updateFromFormPost { + my $self = shift; + my $session = $self->session; + + return $self->SUPER::updateFromFormPost; +} + +#------------------------------------------------------------------- +sub processStepFormData { + my $self = shift; + my $session = $self->session; + + my @subscribeMailings = $session->form->checkList( 'subscribeMailings' ); + + $self->setConfigurationData( subscribeMailings => \@subscribeMailings ); + return []; +} + +1; diff --git a/lib/WebGUI/Workflow/Activity/SendQueuedMailings.pm b/lib/WebGUI/Workflow/Activity/SendQueuedMailings.pm index 1b1a4c7..98b1c66 100644 --- a/lib/WebGUI/Workflow/Activity/SendQueuedMailings.pm +++ b/lib/WebGUI/Workflow/Activity/SendQueuedMailings.pm @@ -1,5 +1,8 @@ package WebGUI::Workflow::Activity::SendQueuedMailings; +use WebGUI::Mailing; +use WebGUI::Mailing::Email; + use base 'WebGUI::Workflow::Activity'; #------------------------------------------------------------------- diff --git a/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm b/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm index ee759a2..e6e8995 100644 --- a/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm +++ b/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm @@ -3,7 +3,7 @@ package WebGUI::i18n::Dutch::AssetAspect_Subscriber; use strict; our $I18N = { - 'Subscription group' => { + 'Subscription group' => { message => 'Abonnee groep', }, 'Enable subscription' => { @@ -24,7 +24,7 @@ our $I18N = { 'confirmation email template' => { message => 'Verificatie email: sjabloon', }, - 'no mutation subject' => { + 'no mutation subject' => { message => 'Geen wijziging email: onderwerp', }, 'no mutation template' => { @@ -52,16 +52,19 @@ our $I18N = { 'anonnymous not allowed' => { message => 'Anonieme inschrijvingen zijn niet toegestaan. Log in om in- of uit te schrijven.', }, - + 'subscription successful' => { - message => 'Uw inschrijving is geslaagd. Terug naar de site', + message => 'Uw inschrijving is geslaagd.', }, 'unsubscription successful' => { - message => 'Uw uitschrijving is geslaagd. Terug naar de site', + message => 'Uw uitschrijving is geslaagd.', }, 'wrong code' => { message => 'De verificatiecode in de link is onbekend, al gebruikt of verlopen. Als u zich wilt in- of uitschrijven probeer dit dan opnieuw of neem contact op met de websitebeheerders.', }, + 'confirm mutation template' => { + message => 'Mutatie bevestigings template', + }, }; 1; diff --git a/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm b/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm index 3fd5aa0..e4b8137 100644 --- a/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm +++ b/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm @@ -6,14 +6,26 @@ our $I18N = { assetName => { message => 'Nieuwsbrief collectie', }, + 'subscribe' => { + message => 'inschrijven', + }, + 'unsubscribe' => { + message => 'uitschrijven', + }, 'template' => { message => 'Sjabloon', }, 'number of recent issues' => { - message => 'Aantal recente uitgaven', + message => 'Aantal recente nieuwsbrieven', }, - + 'useHoneypot label' => { + message => q|Gebruik honeypot|, + lastUpdated => 0, + }, + 'useHoneypot description' => { + message => q|Gebruik honeypot om spam te voorkomen.|, + lastUpdated => 0, + }, }; 1; - diff --git a/lib/WebGUI/i18n/Dutch/MailingManager.pm b/lib/WebGUI/i18n/Dutch/MailingManager.pm index 4dc165b..31892b7 100644 --- a/lib/WebGUI/i18n/Dutch/MailingManager.pm +++ b/lib/WebGUI/i18n/Dutch/MailingManager.pm @@ -26,7 +26,7 @@ our $I18N = { 'bounce score' => { message => 'Bounce score', }, - + 'cannot cancel' => { message => 'Mailing \'%s\' kan niet worden afgebroken.', }, @@ -100,6 +100,14 @@ our $I18N = { 'generate mailing' => { message => 'Genereer mailing', }, + + 'bounce reason' => { + message => 'Laatste bounce oorzaak', + }, + + 'bounce message' => { + message => 'Laatste bounce omschrijving', + }, }; 1; diff --git a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm new file mode 100644 index 0000000..05a0d19 --- /dev/null +++ b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm @@ -0,0 +1,18 @@ +package WebGUI::i18n::Dutch::RegistrationStep_MailingSubscribe; + +use strict; + +our $I18N = { + 'Subscribe to mailings' => { + message => 'Ontvang deze nieuwsbrief', + }, + 'Subscribe to this mailing' => { + message => 'Ontvang deze nieuwsbrief', + }, + 'Include newsletters' => { + message => 'Selecteerbare nieuwsbrieven', + }, +}; + +1; + diff --git a/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm b/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm index f330260..cc5b9e5 100644 --- a/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm +++ b/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm @@ -3,7 +3,7 @@ package WebGUI::i18n::English::AssetAspect_Subscriber; use strict; our $I18N = { - 'Subscription group' => { + 'Subscription group' => { message => 'Subscription group', }, 'Enable subscription' => { @@ -24,7 +24,7 @@ our $I18N = { 'confirmation email template' => { message => 'Confirmation email template', }, - 'no mutation subject' => { + 'no mutation subject' => { message => 'No mutation email subject', }, 'no mutation template' => { @@ -34,7 +34,6 @@ our $I18N = { message => 'Subscription', }, - 'subscribe' => { message => 'Subscribe', }, @@ -52,17 +51,20 @@ our $I18N = { 'anonnymous not allowed' => { message => 'Anonymous subscription is not allowed. Please log in to (un)subscribe', }, - + 'subscription successful' => { - message => 'You are succesfully subscribed. Back to site', + message => 'You are succesfully subscribed.', }, 'unsubscription successful' => { - message => 'You are succesfully unsubscribed. Back to site', + message => 'You are succesfully unsubscribed.', }, 'wrong code' => { message => 'The verification code you supplied is either unknown, already used or expired. Please try again to (un)subscribe or contact the site administrators.', }, + 'confirm mutation template' => { + message => 'Mutation confirmation template', + }, }; 1; diff --git a/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm b/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm index 45d9bcb..ad946b2 100644 --- a/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm +++ b/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm @@ -18,7 +18,14 @@ our $I18N = { 'number of recent issues' => { message => 'Number of recent issues', }, - + 'useHoneypot label' => { + message => q|Use honeypot|, + lastUpdated => 0, + }, + 'useHoneypot description' => { + message => q|Use honeypot to verify humanity.|, + lastUpdated => 0, + }, }; 1; diff --git a/lib/WebGUI/i18n/English/MailingManager.pm b/lib/WebGUI/i18n/English/MailingManager.pm index 51798f1..e8aebca 100644 --- a/lib/WebGUI/i18n/English/MailingManager.pm +++ b/lib/WebGUI/i18n/English/MailingManager.pm @@ -26,7 +26,7 @@ our $I18N = { 'bounce score' => { message => 'Bounce score', }, - + 'error' => { message => 'An error occurred', }, @@ -100,6 +100,14 @@ our $I18N = { 'generate mailing' => { message => 'Generate mailing', }, + + 'bounce reason' => { + message => 'Latest bounce reason', + }, + + 'bounce message' => { + message => 'Latest bounce message', + }, }; 1; diff --git a/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm b/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm new file mode 100644 index 0000000..71534e4 --- /dev/null +++ b/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm @@ -0,0 +1,18 @@ +package WebGUI::i18n::English::RegistrationStep_MailingSubscribe; + +use strict; + +our $I18N = { + 'Subscribe to mailings' => { + message => 'Subscribe to mailings', + }, + 'Subscribe to this mailing' => { + message => 'Subscribe to this mailing', + }, + 'Include newsletters' => { + message => 'Include newsletters', + }, +}; + +1; + diff --git a/sbin/importSpecialState.pl b/sbin/importSpecialState.pl index 91a0158..ff20fb1 100644 --- a/sbin/importSpecialState.pl +++ b/sbin/importSpecialState.pl @@ -1,7 +1,7 @@ #!/usr/bin/env perl $|++; # disable output buffering -our ($webguiRoot, $configFile, $state, $emailFile, $groupId ); +our ($webguiRoot, $configFile, $state, $emailFile, $groupId, $existingUsersGroupId ); BEGIN { $webguiRoot = ".."; @@ -15,12 +15,16 @@ use WebGUI::Session; use WebGUI::User; use WebGUI::User::SpecialState; +# Set default value +$existingUsersGroupId = ''; + # Get parameters here, including $help GetOptions( - 'configFile=s' => \$configFile, - 'groupId=s' => \$groupId, - 'state=s' => \$state, - 'emailFile=s' => \$emailFile, + 'configFile=s' => \$configFile, + 'groupId=s' => \$groupId, + 'existingUsersGroupId=s' => \$existingUsersGroupId, + 'state=s' => \$state, + 'emailFile=s' => \$emailFile, ); my $session = start( $webguiRoot, $configFile ); @@ -40,18 +44,24 @@ while ( my $email = <$fh> ) { my $user = WebGUI::User->newByEmail( $session, $email ); if ( $user ) { print "\tEmail already has account. Skipping.\n"; + if ( $existingUsersGroupId ) { + print "\tAdding user to group $existingUsersGroupId\n"; + $user->addToGroups( [ $existingUsersGroupId ] ); + } + else { + print "\tAdding user to group $groupId\n"; + $user->addToGroups( [ $groupId ] ); + } } else { print "\tEmail has no account, creating special state $state.\n"; $user = WebGUI::User::SpecialState->create( $session ); $user->update( { email => $email } ); $user->addSpecialState( $state ); + print "\tAdding user to group $groupId\n"; + $user->addToGroups( [ $groupId ] ); } - print "\tAdding user to group $groupId\n"; - - $user->addToGroups( [ $groupId ] ); - } print "Done\n\n"; @@ -120,6 +130,22 @@ The WebGUI config file to use. Only the file name needs to be specified, since it will be looked up inside WebGUI's configuration directory. This parameter is required. +=item B<--groupId> + +Add users to this group. If no existingUsersGroupId is given, all users, both new and existing users, are added to this group. If the --existingUsersGroupId is given, new users are added to this group, existing users are added to the existingUsersGroupId. + +=item B<--existingUsersGroupId> + +Add existing users to this group. + +=item B<--state> + +Set the so called specialState for this user. For all users disabeled accounts are created. SpecialState accounts can be transformed into regular accounts using the webgui_registration content handler. The special states are crm or Subscriber, for a user added via the crm or a newsletter subscription respectively. + +=item B<--emailFile> + +A text file with an emailadress on every line. + =item B<--help> Shows a short summary and usage @@ -132,7 +158,7 @@ Shows this document =head1 AUTHOR -Copyright 2001-2009 Plain Black Corporation. +Copyright 2010-2011 United Knowledge B.V. =cut diff --git a/sbin/install_icons.pl b/sbin/install_icons.pl new file mode 100644 index 0000000..c36bae9 --- /dev/null +++ b/sbin/install_icons.pl @@ -0,0 +1,69 @@ +use strict; +use warnings; +use 5.010; + +use Getopt::Long; + +my ( $customRoot, $webguiRoot ); + +GetOptions( + 'customRoot=s' => \$customRoot, + 'webguiRoot=s' => \$webguiRoot, +); + + +die 'No custom root, use --customRoot' unless $customRoot; + +$webguiRoot ||= '/data/WebGUI'; + +for ( qw{ assets adminConsole } ) { + my $largeDest = "$webguiRoot/www/extras/$_"; + my $smallDest = "$webguiRoot/www/extras/$_/small"; + my $largeOrig = "$customRoot/www/extras/$_"; + my $smallOrig = "$customRoot/www/extras/$_/small"; + + say "Proccesing $_ icons..."; + + die "Cannot find large icon directory $largeDest" unless -d $largeDest; + die "Cannot find small icon directory $smallDest" unless -d $smallDest; + + next unless -d $largeOrig && -d $smallOrig; + + my ( %large, %small ); + opendir my $largeDir, "$largeOrig"; + while ( my $file = readdir $largeDir ) { + next unless $file =~ m{ \.gif $ }xmsi; + + say "\tFound large icon $file."; + + $large{ $file } = 1; + }; + closedir $largeDir; + + opendir my $smallDir, "$smallOrig" || next; + while ( my $file = readdir $smallDir ) { + next unless $file =~ m{ \.gif $ }xmsi; + + say "\tFound small icon $file."; + + $small{ $file } = 1; + }; + closedir $smallDir; + + foreach my $file ( keys %large ) { + if ( !exists $small{ $file } ) { + say "\tLarge icon $file has no small equivalent. Skipping."; + next; + } + + print "\tInstalling large icon $file..."; + symlink "$largeOrig/$file", "$largeDest/$file"; + say -l "$largeDest/$file" ? "Ok" : "Failed"; + + print "\tInstalling small icon $file..."; + symlink "$smallOrig/$file", "$smallDest/$file"; + say -l "$smallDest/$file" ? "Ok" : "Failed"; + } +} + +say "Done."; diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 5a75065..0d782bb 100644 --- a/sbin/install_newsletter.pl +++ b/sbin/install_newsletter.pl @@ -12,7 +12,7 @@ use strict; use Pod::Usage; use Getopt::Long; use WebGUI::Session; -use List::MoreUtils qw{ insert_after_string }; +use List::MoreUtils qw{ insert_after_string none }; # Get parameters here, including $help GetOptions( @@ -32,9 +32,75 @@ addTemplateColumnToNewsletterCollection( $session ); addRecentColumnToNewsletterCollection( $session ); renamespaceTemplates( $session ); addSpecialStateTable( $session ); +addListNameColumn( $session ); +addRegistrationSteps( $session ); +addConfirmationTemplateColumn( $session ); +addSentToIndex( $session ); +addUseHoneypotColumn( $session ); finish($session); +#------------------------------------------------------------------------------- +sub addConfirmationTemplateColumn { + my $session = shift; + my $db = $session->db; + + print "\tAdding column for mutation confirmation template..."; + + my $hasColumn = $db->quickScalar( 'show columns from assetAspectSubscriber where Field = ?', [ + 'confirmMutationTemplateId', + ] ); + + unless ( $hasColumn ) { + $db->write( + 'alter table assetAspectSubscriber add column confirmMutationTemplateId char(22) binary not null default ?', + [ + 'WUk-wEhGiF8dcEogrJfrfg', + ] + ); + + $db->write( + 'update assetAspectSubscriber set confirmMutationTemplateId=? where confirmMutationTemplateId is null', + [ + 'WUk-wEhGiF8dcEogrJfrfg', + ] + ); + } + + print "Done.\n"; +} + +#---------------------------------------------------------------------------- +sub addSentToIndex { + my $session = shift; + my $db = $session->db; + + print "\tAdding index to column Mailing_email.sentTo..."; + + my @indexes = $db->buildArray('show indexes from Mailing_email where Column_name=?',['sentTo']); + + if ( @indexes == 0 ) { + $db->write('alter table Mailing_email add index(sentTo)'); + } + + print "Done.\n"; +} + +#---------------------------------------------------------------------------- +sub addListNameColumn { + my $session = shift; + my $db = $session->db; + print "\tAdding list name column for subscribers..."; + + my @columns = $db->buildArray( 'desc assetAspectSubscriber' ); + + if ( none { $_ eq 'listName' } @columns ) { + $db->write( 'alter table assetAspectSubscriber add column listName varchar(255)' ); + } + + print "Done.\n"; +} + #---------------------------------------------------------------------------- sub installMailableAspectTable { my $session = shift; @@ -59,21 +125,21 @@ sub installSubscriberAspectTable { $session->db->write(<db->write(<quickScalar( 'show columns from NewsletterCollection where Field=?', [ 'viewTemplateId' ] ); - + unless ( $hasColumn ) { $db->write( 'alter table NewsletterCollection add column viewTemplateId char(22) binary not null default ?', [ 'aYVYFpofaYvmRYoHwl3x4w' @@ -136,7 +203,7 @@ sub addRecentColumnToNewsletterCollection { print "\tAdding recent issues column to NewletterCollection..."; my $hasColumn = $db->quickScalar( 'show columns from NewsletterCollection where Field=?', [ 'recentIssueCount' ] ); - + unless ( $hasColumn ) { $db->write( 'alter table NewsletterCollection add column recentIssueCount int(3) not null default ?', [ 1, @@ -195,7 +262,7 @@ sub installNewsletterInAdminConsole { sub installNewsletterSettings { my $session = shift; my $setting = $session->setting; - + print "\tInstalling newsletter setting slots..."; my %settings = ( @@ -220,11 +287,11 @@ sub addPluginsToConfigFile { my $config = $session->config; print "\tAdding plugins to config file..."; - + $config->set( 'assets/WebGUI::Asset::Wobject::NewsletterCollection', { category => 'basic', } ); - + my @handlers = @{ $session->config->get('contentHandlers') }; if ( !scalar grep { $_ eq 'WebGUI::Content::NewsletterManager' } @handlers ) { insert_after_string 'WebGUI::Content::Shop', 'WebGUI::Content::NewsletterManager', @handlers; @@ -236,7 +303,7 @@ sub addPluginsToConfigFile { push @workflows, 'WebGUI::Workflow::Activity::SendQueuedMailings'; $session->config->set( 'workflowActivities/None', \@workflows ); } - + print "Done.\n"; } @@ -273,33 +340,68 @@ EOSQL print "Done.\n"; } +#---------------------------------------------------------------------------- +sub addRegistrationSteps { + my $session = shift; + + print "\tAdding MailingSubscribe Registration Step to config..."; + + my %steps = map { $_ => 1 } @{ $session->config->get( 'registrationSteps' ) || [] }; + $steps{ 'WebGUI::Registration::Step::MailingSubscribe' } = 1; + + $session->config->set( 'registrationSteps', [ keys %steps ] ); + + print "Done.\n"; + +} +#---------------------------------------------------------------------------- +sub addUseHoneypotColumn { + my $session = shift; + + my $db = $session->db; + + print "\tAdding useHoneypot column..."; + + my @columns = $db->buildArray( 'show columns from NewsletterCollection' ); + + if ( ! grep { $_ eq 'useHoneypot' } @columns ) { + $db->write( 'alter table NewsletterCollection add column useHoneypot tinyint(1) default 0' ); + $db->write( 'update NewsletterCollection set useHoneypot = 0 where useHoneypot is null' ); + + print "Done\n"; + + } + else { + print "Skipping\n"; + } +} #---------------------------------------------------------------------------- sub start { my $webguiRoot = shift; my $configFile = shift; my $session = WebGUI::Session->open($webguiRoot,$configFile); $session->user({userId=>3}); - + ## If your script is adding or changing content you need these lines, otherwise leave them commented # # my $versionTag = WebGUI::VersionTag->getWorking($session); # $versionTag->set({name => 'Name Your Tag'}); # ## - + return $session; } #---------------------------------------------------------------------------- sub finish { my $session = shift; - + ## If your script is adding or changing content you need these lines, otherwise leave them commented # # my $versionTag = WebGUI::VersionTag->getWorking($session); # $versionTag->commit; ## - + $session->var->end; $session->close; } diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 044e54e..cc1fac9 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -1,60 +1,102 @@ -#!/data/wre/prereqs/bin/perl +#!/usr/bin/perl BEGIN { unshift @INC, qw( /data/custom/webgui_newsletter/lib /data/WebGUI/lib + /data/custom/customlib_honeypot/lib ); } use strict; +use warnings; +use 5.010; -use Mail::DeliveryStatus::BounceParser; -use WebGUI::Mailing::Email; +use WebGUI::MailCommand; use List::MoreUtils qw{ any }; +use WebGUI::Config; +use Getopt::Long; +use Readonly; + +Readonly my $WRONG_USAGE => 64; +Readonly my $DATA_ERROR => 65; +Readonly my $NO_SUCH_USER => 67; +Readonly my $UNKNOWN_HOST => 68; +Readonly my $CONFIG_ERROR => 78; -my $NO_SUCH_USER = 67; my $webguiRoot = '/data/WebGUI'; -my %configs = ( - 'lom.lom.st.unitedknowledge.org' => 'www.lomcongres.nl.conf', -); - #--------------------------------------------------------------- -my ( $domain, $user ) = @ARGV; -my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i; +# Startup +{ + my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials(); -my $configFile = $configs{ $domain }; -my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm }; + if ( WebGUI::MailCommand::isValidCommand( $command ) ) { + my $session = openSession( $webguiRoot, $configFile ); + no warnings 'once'; + *{ WebGUI::Session::Env::getIp } = sub { + return $senderIp || '127.0.0.1'; + }; -unless ( $configFile && $validCommand ) { -# system "/usr/sbin/sendmail -G -i $user\@$domain"; - exit(0); -} -else { - my $session = WebGUI::Session->open($webguiRoot,$configFile); - $session->log->warn( 'valid bounce address' ); - my $email = WebGUI::Mailing::Email->new( $session, $session->id->fromHex( $mailId ) ); - - if ($email) { - $session->log->warn( 'found email' ); - my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN ); - - my $report = ( $dsr->reports )[0]; - my $reason = $report->get( 'std_reason' ); - my $message = $report->get( 'reason' ); - $message =~ s{\s+}{ }g; + WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); - $session->log->warn( 'about to register as bounced' ); - $email->registerBounced( $reason, $message ); + closeSession( $session ); } else { - $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" ); + warn "Not a valid command [$command]."; + exit( $NO_SUCH_USER ); + #die "Not a valid command [$command]."; } + exit(0); +} + +#----------------------------------------------------------------------------- +sub getCredentials { + my ( $domain, $user, $sender, $senderIp ); + + GetOptions( + 'domain=s' => \$domain, + 'user=s' => \$user, + 'sender=s' => \$sender, + 'senderIp=s'=> \$senderIp, + ); + warn "--domain parameter is required" && exit( $WRONG_USAGE ) unless $domain; + warn "--user parameter is required" && exit( $WRONG_USAGE ) unless $user; + warn "--sender parameter is required" && exit( $WRONG_USAGE ) unless $sender; + #warn "--senderIp parameter is required" && exit( $WRONG_USAGE ) unless $senderIp; + + my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) + || warn "Cannot open $webguiRoot/etc/mailing_dispatch.config" && exit( $CONFIG_ERROR ); + + my $configFile = $dispatch->get( $domain ) + || warn "Received mail for domain [$domain] which is not configured!" && exit( $UNKNOWN_HOST ); + + # Format is mailId-command + my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; + + print "Received mail addressed to [$user\@$domain] which contains no id" && exit( $NO_SUCH_USER ) unless $id; + print "Received mail addressed to [$user\@$domain] which contains no command" && exit( $NO_SUCH_USER ) unless $command; + + return ( $configFile, $command, $id, $sender, $senderIp ); +} + +#----------------------------------------------------------------------------- +sub openSession { + my $webguiRoot = shift; + my $configFile = shift; + + # Require WebGUI:Session rather than use it to save compilation of it when invalid commands are passed. + require WebGUI::Session; + + my $session = WebGUI::Session->open( $webguiRoot, $configFile ); + + return $session; +} + +#----------------------------------------------------------------------------- +sub closeSession { + my $session = shift; + $session->close; - exit (0); -} - -exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm }; - +} diff --git a/sbin/packages/root_import_personalnewsletter.wgpkg b/sbin/packages/root_import_personalnewsletter.wgpkg deleted file mode 100644 index a96e715..0000000 Binary files a/sbin/packages/root_import_personalnewsletter.wgpkg and /dev/null differ diff --git a/sbin/packages/root_import_webgui_newsletter.wgpkg b/sbin/packages/root_import_webgui_newsletter.wgpkg new file mode 100644 index 0000000..f9b6678 Binary files /dev/null and b/sbin/packages/root_import_webgui_newsletter.wgpkg differ diff --git a/www/extras/adminConsole/newsletter.gif b/www/extras/adminConsole/newsletter.gif new file mode 100644 index 0000000..869f862 Binary files /dev/null and b/www/extras/adminConsole/newsletter.gif differ diff --git a/www/extras/adminConsole/small/newsletter.gif b/www/extras/adminConsole/small/newsletter.gif new file mode 100644 index 0000000..2987916 Binary files /dev/null and b/www/extras/adminConsole/small/newsletter.gif differ diff --git a/www/extras/assets/newsletter_collection.gif b/www/extras/assets/newsletter_collection.gif new file mode 100644 index 0000000..869f862 Binary files /dev/null and b/www/extras/assets/newsletter_collection.gif differ diff --git a/www/extras/assets/small/newsletter_collection.gif b/www/extras/assets/small/newsletter_collection.gif new file mode 100644 index 0000000..2987916 Binary files /dev/null and b/www/extras/assets/small/newsletter_collection.gif differ