diff --git a/docs/mail_commands_setup.pod b/docs/mail_commands_setup.pod deleted file mode 100644 index 10e0e1f..0000000 --- a/docs/mail_commands_setup.pod +++ /dev/null @@ -1,101 +0,0 @@ -=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 new file mode 100644 index 0000000..b6ee775 --- /dev/null +++ b/docs/postfix_configuration @@ -0,0 +1,17 @@ +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 b8200dc..f1d1dac 100644 --- a/docs/required_modules +++ b/docs/required_modules @@ -1,3 +1,3 @@ -Mail::DeliveryStatus::BounceParser (v 1.525) -Class::InsideOut (v 1.10) +Mail::DeliveryStatus::BounceParser +Class::InsideOut diff --git a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm index d0a234a..d35d745 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,15 +34,8 @@ 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 => 'newsletter_collection.gif', @@ -59,16 +52,12 @@ sub definition { sub getIssues { my $self = shift; - # 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 }; + my $issues = $self->getLineage( [ 'children' ], { + returnObjects => 1, + orderByClause => 'lineage desc', + } ); + + return $issues; } #---------------------------------------------------------------------------- @@ -99,8 +88,7 @@ sub getAssetContent { my $self = shift; my $asset = shift; - # Do not call prepareView on $asset here but rather do this in our own prepareView to prevent head tags being - # written to body. + $asset->prepareView; my $content = $asset->view; return $content; @@ -118,11 +106,6 @@ 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; } @@ -143,11 +126,11 @@ sub getViewVars { foreach my $issue ( @{ $issues } ) { my $issueVar = $issue->get; $issueVar->{ url } = $issue->getUrl; - - my $isRecent = defined $displayIssueId - ? $issue->getId eq $displayIssueId - : $recentCount < $maxRecent - ; + + my $isRecent = + ( !$displayIssueId && $recentCount < $maxRecent ) + || ( $issue->getId eq $displayIssueId ) + ; if ( $isRecent ) { $issueVar->{ content } = $self->getAssetContent( $issue ); @@ -174,7 +157,7 @@ sub view { my $self = shift; my $form = $self->session->form; - my $var = $self->getViewVars( { + my $var = $self->getViewVars( { displayIssue => $form->guid('displayIssue'), } ); @@ -182,3 +165,4 @@ sub view { } 1; + diff --git a/lib/WebGUI/AssetAspect/Mailable.pm b/lib/WebGUI/AssetAspect/Mailable.pm index 5efa6c7..90bc717 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,15 +115,13 @@ 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, ); @@ -131,13 +129,10 @@ 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 fed9da6..272e14a 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -2,19 +2,11 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; -use 5.010; -use Class::C3; +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; @@ -26,11 +18,6 @@ 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' ), @@ -46,7 +33,7 @@ sub definition { alwaysConfirmSubscription => { fieldType => 'yesNo', defaultValue => 0, - label => $i18n->get( 'require confirmation' ), + label => $i18n->get( 'require confirmation' ), tab => 'subscription', }, allowAnonymousSubscription => { @@ -88,13 +75,6 @@ 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 }, { @@ -136,7 +116,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" ) . '>', @@ -193,44 +173,6 @@ 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 || {}; @@ -238,41 +180,16 @@ 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 = ''; @@ -281,21 +198,19 @@ sub appendSubscriptionFormVars { $form .= $unsubscribeButton if $self->canUnsubscribe; } elsif ( $self->get('allowAnonymousSubscription') ) { - $form = $emailBox; + $form = $emailBox . $subscribeButton . $unsubscribeButton; } # Setup tmpl_vars - $var->{ subscriptionForm_form } = $form if $form; + $var->{ subscriptionForm_form } = "$formHeader $form $formFooter" if $form; $var->{ subscriptionForm_header } = $formHeader; $var->{ subscriptionForm_footer } = $formFooter; $var->{ subscriptionForm_subscribeButton } = $subscribeButton; $var->{ subscriptionForm_unsubscribeButton } = $unsubscribeButton; - $var->{ subscriptionForm_emailBox } = $emailBox; + $var->{ subscrittionForm_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; } @@ -304,8 +219,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 ; @@ -316,7 +231,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. @@ -348,45 +263,6 @@ 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; @@ -395,13 +271,7 @@ 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" ); @@ -410,18 +280,14 @@ sub sendSubscriptionConfirmation { $var->{ actionIsSubscribe } = $action eq 'subscribe'; my $mail = WebGUI::Mail::Send->create( $self->session, { - to => $user->get('email'), - subject => $self->get('confirmationEmailSubject'), - contentType => 'multipart/alternative', + to => $user->get('email'), + subject => $self->get('confirmationEmailSubject'), } ); my $templateId = $self->get('confirmationEmailTemplateId'); my $template = WebGUI::Asset::Template->new( $session, $templateId ); if ( $template ) { - my $content = $template->process( $var ); - - $mail->addHtml( $content ); - $mail->addText( $self->transformToText( $content ) ); + $mail->addHtml( $template->process( $var ) ); } else { $session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" ); @@ -440,29 +306,19 @@ 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'), - contentType => 'multipart/alternative', + to => $user->get('email'), + subject => $self->get('noMutationEmailSubject'), } ); my $templateId = $self->get('noMutationEmailTemplateId'); my $template = WebGUI::Asset::Template->new( $session, $templateId ); if ( $template ) { - my $content = $template->process( $var ); - - $mail->addHtml( $content ); - $mail->addText( $self->transformToText( $content ) ); + $mail->addHtml( $template->process( $var ) ); } else { $session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" ); @@ -476,18 +332,6 @@ 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; @@ -495,7 +339,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=?', [ @@ -519,7 +363,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=?', [ @@ -545,7 +389,6 @@ sub subscribe { my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); my $session = $self->session; - if ( $requireConfirm ) { if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) { $self->sendNoMutationEmail( $user, 'subscribe' ); @@ -571,7 +414,7 @@ sub unsubscribe { my $self = shift; my $user = shift || $self->session->user; my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); - + my $session = $self->session; if ( $requireConfirm ) { @@ -604,72 +447,29 @@ 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 ] ); - - $var->{ message } = sprintf $i18n->get( 'subscription successful'), $self->getUrl; - $var->{ isSuccess } = 1; + return $self->processStyle( sprintf $i18n->get( 'subscription successful'), $self->getUrl ); } elsif ( $type eq 'unsubscribe' ) { $self->getSubscriptionGroup->deleteUsers( [ $userId ] ); - - $var->{ message } = sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl; - $var->{ isSuccess } = 1; + return $self->processStyle( sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl ); } } - return $self->processStyle( $self->processTemplate( $var, $self->get('confirmMutationTemplateId') ) ); -} + return $self->processStyle( $i18n->get( 'wrong code' ) ); -#---------------------------------------------------------------------------- -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; } #---------------------------------------------------------------------------- @@ -682,12 +482,6 @@ 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; @@ -702,9 +496,18 @@ sub www_processSubscription { my $email = $form->email( 'email' ); return 'Error: no email address passed' unless $email; - given ( $action ) { - when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); } - when ( 'subscribe' ) { $self->subscribeAnonymous( $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 ); } } else { @@ -742,3 +545,4 @@ sub www_unsubscribe { } 1; + diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm deleted file mode 100644 index a37aca1..0000000 --- a/lib/WebGUI/MailCommand.pm +++ /dev/null @@ -1,56 +0,0 @@ -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 deleted file mode 100644 index 752195b..0000000 --- a/lib/WebGUI/MailCommand/Bounce.pm +++ /dev/null @@ -1,40 +0,0 @@ -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 deleted file mode 100644 index 2244b1b..0000000 --- a/lib/WebGUI/MailCommand/Subscribe.pm +++ /dev/null @@ -1,28 +0,0 @@ -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 deleted file mode 100644 index e7ca1ca..0000000 --- a/lib/WebGUI/MailCommand/Unsubscribe.pm +++ /dev/null @@ -1,27 +0,0 @@ -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 93d8124..31ced29 100644 --- a/lib/WebGUI/Mailing.pm +++ b/lib/WebGUI/Mailing.pm @@ -40,7 +40,7 @@ sub cancel { ); }; - $self->update( { + $self->update( { state => 'idle', sendDate => undef, } ); @@ -65,7 +65,7 @@ sub crud_definition { assetId => { fieldType => 'guid', }, - + issueId => { fieldType => 'guid', }, @@ -83,7 +83,7 @@ sub crud_definition { }, ); - $definition->{ properties } = { + $definition->{ properties } = { %{ $definition->{ properties } || {} }, %properties, }; @@ -94,7 +94,7 @@ sub crud_definition { #---------------------------------------------------------------------------- sub delete { my $self = shift; - + $self->deleteQueuedEmails; return $self->SUPER::delete; @@ -103,12 +103,12 @@ 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; @@ -180,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, ], @@ -260,7 +260,7 @@ sub queue { $state, ); }; - + $self->queueEmails( $self->getAsset->getRecipients ); $self->update( { @@ -285,7 +285,7 @@ sub queueEmails { recipientEmail => undef, isTest => 0, } ); - + } return; @@ -334,7 +334,7 @@ sub send { $state, ); }; - + $self->update( { state => 'sending' } ); my $complete = $self->sendQueuedEmails( $timeLimit ); @@ -361,7 +361,7 @@ sub sendQueuedEmails { $email->send; } - + return 1; } @@ -380,7 +380,7 @@ sub www_cancel { $i18n->get('cancel mailing success'), $i18n->get('cancel mailing'), ); - } + } else { return $self->renderInConsole( $i18n->get('cancel mailing failure'), @@ -415,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 = $self->getEditForm; + my $f = WebGUI::HTMLForm->new( $session ); $f->hidden( name => 'newsletter', value => 'mailing', @@ -435,16 +435,6 @@ 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 ) { @@ -454,7 +444,7 @@ sub getEditForm { my $formField = WebGUI::Form::DynamicField->new( $session, %{ $properties } ); 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 @@ -468,12 +458,12 @@ sub getEditForm { $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 $f; + return $self->renderInConsole( $f->print, $i18n->get('configure mailing') ); } #---------------------------------------------------------------------------- @@ -496,7 +486,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; @@ -504,7 +494,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.

@@ -526,11 +516,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 9445285..7598656 100644 --- a/lib/WebGUI/Mailing/Email.pm +++ b/lib/WebGUI/Mailing/Email.pm @@ -54,7 +54,7 @@ sub crud_definition { }, ); - $definition->{ properties } = { + $definition->{ properties } = { %{ $definition->{ properties } || {} }, %properties, }; @@ -128,19 +128,20 @@ 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]+:// | \# | mailto: ) }xmsi ) { - my $new = + + if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) { + my $new = ( $uri =~ m{ ^ / }xmsi ) # Is url absolute? ? $siteUrl . $uri : $siteUrl . $pageUrl . '/' . $uri ; - + # replace attribute $element->attr( $attr, $new ); } - } + } return $tb->as_HTML; } @@ -166,7 +167,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; } @@ -192,7 +193,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", @@ -227,14 +228,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 index 997d8b8..deff855 100644 --- a/lib/WebGUI/Registration/Step/MailingSubscribe.pm +++ b/lib/WebGUI/Registration/Step/MailingSubscribe.pm @@ -15,15 +15,12 @@ sub getAvailableMailings { my $self = shift; my $session = $self->session; - my $mailingIds = $self->get( 'includeMailings' ); + my $availableMailings = WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], { + returnObjects => 1, + isa => 'WebGUI::Asset::Wobject::NewsletterCollection', + } ); - my @mailings = - grep { defined $_ } - map { WebGUI::Asset->newByDynamicClass( $session, $_ ) } - ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds - ; - - return \@mailings; + return $availableMailings; } #------------------------------------------------------------------- @@ -34,7 +31,7 @@ sub apply { my $subscribeTo = { map { $_ => 1 } @{ $self->getConfigurationData->{ subscribeMailings } || [] } }; - + my $availableMailings = $self->getAvailableMailings; my $sendNotification = 0; @@ -52,32 +49,22 @@ sub apply { 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 crud_definition { +# my $class = shift; +# my $session = shift; +# my $definition = $class->SUPER::crud_definition( $session ); +# my $i18n = WebGUI::International->new( $session, 'Registration_Step_Homepage' ); +# +# +# $definition->{ dynamic }->{ urlStorageField } = { +# fieldType => 'selectBox', +# label => 'Store homepage url in field', +# options => \%profileFields, +# }; +# +# return $definition; +#} #------------------------------------------------------------------- sub getSummaryTemplateVars { @@ -90,7 +77,7 @@ sub getSummaryTemplateVars { # Fetch preferred homepage url my $mailings = $self->getConfigurationData->{ subscribeMailings }; - my @assets = + my @assets = grep { defined $_ } map { WebGUI::Asset->newByDynamicClass( $session, $_ ) } @{ $mailings }; @@ -102,12 +89,12 @@ sub getSummaryTemplateVars { # Setup tmpl_var my $var = { - field_loop => \@fields, + field_loop => \@fields, category_label => $self->get('title'), category_edit_url => $self->changeStepDataUrl, }; - return ( $var ); + return ( $var ); } #------------------------------------------------------------------- @@ -132,7 +119,7 @@ sub getViewVars { } else { # The step hasn't been done yet. - @subscribeMailings = map { $_->getId } grep { $_->isSubscribed( $user ) } @{ $availableMailings }; + @subscribeMailings = grep { $_->isSubscribed( $user ) } @{ $availableMailings }; } # Create lookup table @@ -184,7 +171,10 @@ sub updateFromFormPost { my $self = shift; my $session = $self->session; - return $self->SUPER::updateFromFormPost; + $self->SUPER::updateFromFormPost; + +# $self->update( { +# } ); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm b/lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm index e6e8995..ee759a2 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,19 +52,16 @@ 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.', + message => 'Uw inschrijving is geslaagd. Terug naar de site', }, 'unsubscription successful' => { - message => 'Uw uitschrijving is geslaagd.', + message => 'Uw uitschrijving is geslaagd. Terug naar de site', }, '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 e4b8137..3fd5aa0 100644 --- a/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm +++ b/lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm @@ -6,26 +6,14 @@ our $I18N = { assetName => { message => 'Nieuwsbrief collectie', }, - 'subscribe' => { - message => 'inschrijven', - }, - 'unsubscribe' => { - message => 'uitschrijven', - }, 'template' => { message => 'Sjabloon', }, 'number of recent issues' => { - message => 'Aantal recente nieuwsbrieven', + message => 'Aantal recente uitgaven', }, - '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 31892b7..4dc165b 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,14 +100,6 @@ 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 index 05a0d19..957d7f1 100644 --- a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm +++ b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm @@ -4,13 +4,10 @@ use strict; our $I18N = { 'Subscribe to mailings' => { - message => 'Ontvang deze nieuwsbrief', + message => 'Abonneren op nieuwsbrieven', }, 'Subscribe to this mailing' => { - message => 'Ontvang deze nieuwsbrief', - }, - 'Include newsletters' => { - message => 'Selecteerbare nieuwsbrieven', + message => 'Abonneer op deze nieuwsbrief', }, }; diff --git a/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm b/lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm index cc5b9e5..f330260 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,6 +34,7 @@ our $I18N = { message => 'Subscription', }, + 'subscribe' => { message => 'Subscribe', }, @@ -51,20 +52,17 @@ our $I18N = { 'anonnymous not allowed' => { message => 'Anonymous subscription is not allowed. Please log in to (un)subscribe', }, - + 'subscription successful' => { - message => 'You are succesfully subscribed.', + message => 'You are succesfully subscribed. Back to site', }, 'unsubscription successful' => { - message => 'You are succesfully unsubscribed.', + message => 'You are succesfully unsubscribed. Back to site', }, '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 ad946b2..45d9bcb 100644 --- a/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm +++ b/lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm @@ -18,14 +18,7 @@ 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 e8aebca..51798f1 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,14 +100,6 @@ 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 index 71534e4..9b6df53 100644 --- a/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm +++ b/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm @@ -9,9 +9,6 @@ our $I18N = { '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 ff20fb1..91a0158 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, $existingUsersGroupId ); +our ($webguiRoot, $configFile, $state, $emailFile, $groupId ); BEGIN { $webguiRoot = ".."; @@ -15,16 +15,12 @@ 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, - 'existingUsersGroupId=s' => \$existingUsersGroupId, - 'state=s' => \$state, - 'emailFile=s' => \$emailFile, + 'configFile=s' => \$configFile, + 'groupId=s' => \$groupId, + 'state=s' => \$state, + 'emailFile=s' => \$emailFile, ); my $session = start( $webguiRoot, $configFile ); @@ -44,24 +40,18 @@ 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"; @@ -130,22 +120,6 @@ 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 @@ -158,7 +132,7 @@ Shows this document =head1 AUTHOR -Copyright 2010-2011 United Knowledge B.V. +Copyright 2001-2009 Plain Black Corporation. =cut diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 0d782bb..89aa378 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 none }; +use List::MoreUtils qw{ insert_after_string }; # Get parameters here, including $help GetOptions( @@ -32,75 +32,10 @@ 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; @@ -125,21 +60,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' @@ -203,7 +137,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, @@ -262,7 +196,7 @@ sub installNewsletterInAdminConsole { sub installNewsletterSettings { my $session = shift; my $setting = $session->setting; - + print "\tInstalling newsletter setting slots..."; my %settings = ( @@ -287,11 +221,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; @@ -303,7 +237,7 @@ sub addPluginsToConfigFile { push @workflows, 'WebGUI::Workflow::Activity::SendQueuedMailings'; $session->config->set( 'workflowActivities/None', \@workflows ); } - + print "Done.\n"; } @@ -345,63 +279,43 @@ 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 cc1fac9..044e54e 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -1,102 +1,60 @@ -#!/usr/bin/perl +#!/data/wre/prereqs/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 WebGUI::MailCommand; +use Mail::DeliveryStatus::BounceParser; +use WebGUI::Mailing::Email; 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', +); + #--------------------------------------------------------------- -# Startup -{ - my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials(); +my ( $domain, $user ) = @ARGV; +my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i; - if ( WebGUI::MailCommand::isValidCommand( $command ) ) { - my $session = openSession( $webguiRoot, $configFile ); - no warnings 'once'; - *{ WebGUI::Session::Env::getIp } = sub { - return $senderIp || '127.0.0.1'; - }; - - WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); - - closeSession( $session ); - } - else { - warn "Not a valid command [$command]."; - exit( $NO_SUCH_USER ); - #die "Not a valid command [$command]."; - } +my $configFile = $configs{ $domain }; +my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm }; +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; -#----------------------------------------------------------------------------- -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->log->warn( 'about to register as bounced' ); + $email->registerBounced( $reason, $message ); + } + else { + $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" ); + } $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 new file mode 100644 index 0000000..a96e715 Binary files /dev/null and b/sbin/packages/root_import_personalnewsletter.wgpkg differ diff --git a/sbin/packages/root_import_webgui_newsletter.wgpkg b/sbin/packages/root_import_webgui_newsletter.wgpkg deleted file mode 100644 index f9b6678..0000000 Binary files a/sbin/packages/root_import_webgui_newsletter.wgpkg and /dev/null differ