From a0f3443436330aa8b2b018841d8dafda2c02c3fa Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:31:52 +0200 Subject: [PATCH 01/48] Refactoring postfix transport script to allow pluggable commands. --- lib/WebGUI/MailCommand.pm | 53 +++++++++++++++ lib/WebGUI/MailCommand/Bounce.pm | 40 ++++++++++++ lib/WebGUI/MailCommand/Subscribe.pm | 27 ++++++++ sbin/newsletter-transport.pl | 99 +++++++++++++++++++---------- 4 files changed, 184 insertions(+), 35 deletions(-) create mode 100644 lib/WebGUI/MailCommand.pm create mode 100644 lib/WebGUI/MailCommand/Bounce.pm create mode 100644 lib/WebGUI/MailCommand/Subscribe.pm diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm new file mode 100644 index 0000000..e81f90f --- /dev/null +++ b/lib/WebGUI/MailCommand.pm @@ -0,0 +1,53 @@ +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 $commandClass = resolveCommandClass( $command ) + || return; + + my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] ); + + return $commandObject->process( $parameter ); +} + +sub session { + return (shift)->{ _session }; +} + +sub resolveCommandClass { + my $command = shift; + + # TODO: Do not hard code. + my %commands = ( + 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..c4057db --- /dev/null +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -0,0 +1,27 @@ +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 $session = $self->session; + my $log = $session->log; + + my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->subscribeThroughEmail( $fromAddress ); + + return; +} + +1; + diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 044e54e..8ec705b 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -8,53 +8,82 @@ BEGIN { } use strict; +use warnings; -use Mail::DeliveryStatus::BounceParser; -use WebGUI::Mailing::Email; +#use Mail::DeliveryStatus::BounceParser; +#use WebGUI::Mailing::Email; +use WebGUI::MailCommand; use List::MoreUtils qw{ any }; +use WebGUI::Config; +use Getopt::Long; + +use 5.010; 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 ) = getCredentials(); -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 ); + if ( WebGUI::MailCommand::isValidCommand( $command ) ) { + my $session = openSession( $webguiRoot, $configFile ); - my $report = ( $dsr->reports )[0]; - my $reason = $report->get( 'std_reason' ); - my $message = $report->get( 'reason' ); - $message =~ s{\s+}{ }g; - - $session->log->warn( 'about to register as bounced' ); - $email->registerBounced( $reason, $message ); + WebGUI::MailCommand::processCommand( $session, $command, $id ); + + closeSession( $session ); } else { - $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" ); + # TODO: log something } + exit(0); +} + +#----------------------------------------------------------------------------- +sub getCredentials { + my ( $domain, $user ); + + GetOptions( + 'domain=s' => \$domain, + 'user=s' => \$user, + ); + die "--domain parameter is required" unless $domain; + die "--user paramere is required" unless $user; + + my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) + || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; + + my $configFile = $dispatch->get( $domain ) + || die "Received mail for domain [$domain] which is not configured!"; + + # Format is mailId-command + my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; + + die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; + die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; + + return ( $configFile, $command, $id ); +} + +#----------------------------------------------------------------------------- +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 }; +} From 4cebd9c26f0dd4b065431381bfcdff73796fe6b5 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:33:33 +0200 Subject: [PATCH 02/48] Began refactoring Subscriber aspect to allow (un)subscription by email. --- lib/WebGUI/AssetAspect/Subscriber.pm | 32 ++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 272e14a..e143871 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -389,6 +389,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' ); @@ -472,6 +473,24 @@ sub www_confirmMutation { } +sub subscribeAnonymous { + my $self = shift; + my $email = shift; # TODO || return ? + my $session = $self->session; + + my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); + + if ( !defined $emailUser ) { + $emailUser = WebGUI::User::SpecialState->create( $session ); + $emailUser->update( { email => $email } ); + } + $emailUser->addSpecialState( 'Subscriber', $self->getId ); + + $self->subscribe( $emailUser, 1 ); + + return; +} + #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; @@ -501,13 +520,14 @@ sub www_processSubscription { $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->subscribeAnonymous( $email ); + #if ( !defined $emailUser ) { + # $emailUser = WebGUI::User::SpecialState->create( $session ); + # $emailUser->update( { email => $email } ); + #} + #$emailUser->addSpecialState( 'Subscriber', $self->getId ); - $self->subscribe( $emailUser, 1 ); + #$self->subscribe( $emailUser, 1 ); } } else { From e3932e2ca40935cc8867a2fb6a73e64dbed55ccd Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 15:16:06 +0200 Subject: [PATCH 03/48] Finsished breaking out anonymous (un)subscribe functions. --- lib/WebGUI/AssetAspect/Subscriber.pm | 33 +++++++++++++++++----------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index e143871..9f50beb 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -2,6 +2,7 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; +use 5.010; use Class::C3; use Carp; @@ -473,6 +474,7 @@ sub www_confirmMutation { } +#---------------------------------------------------------------------------- sub subscribeAnonymous { my $self = shift; my $email = shift; # TODO || return ? @@ -480,6 +482,7 @@ sub subscribeAnonymous { 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 } ); @@ -491,6 +494,20 @@ sub subscribeAnonymous { 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; +} + #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; @@ -515,19 +532,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' ) { - $self->subscribeAnonymous( $email ); - #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 { From 2cd069d0be512bc2831128307dfbb03915753df2 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 16:29:29 +0200 Subject: [PATCH 04/48] Add listname property. --- lib/WebGUI/AssetAspect/Subscriber.pm | 44 ++++++++++++++++++++++++++++ sbin/install_newsletter.pl | 19 +++++++++++- 2 files changed, 62 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 9f50beb..1e5d32f 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -19,6 +19,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' ), @@ -264,6 +269,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; diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 5a75065..90b30c7 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,26 @@ addTemplateColumnToNewsletterCollection( $session ); addRecentColumnToNewsletterCollection( $session ); renamespaceTemplates( $session ); addSpecialStateTable( $session ); +addListNameColumn( $session ); finish($session); + +#---------------------------------------------------------------------------- +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; From ae59627228b31712db20700ae9d671b71c984fb8 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:53:35 +0200 Subject: [PATCH 05/48] Add missing use clauses; --- lib/WebGUI/AssetAspect/Subscriber.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 1e5d32f..64dcd65 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -8,6 +8,12 @@ use Carp; use WebGUI::Asset::Template; use WebGUI::Macro; +use WebGUI::Mail::Send; +use WebGUI::Group; +use WebGUI::Asset; +use WebGUI::Form; +use WebGUI::User::SpecialState; +use WebGUI::International; use Tie::IxHash; use URI; From ec4834090ddfc962a85fe36304d5cc1cd9ecd502 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:55:27 +0200 Subject: [PATCH 06/48] Add (us)subscribe commands and pass sender address along. --- lib/WebGUI/MailCommand.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm index e81f90f..a37aca1 100644 --- a/lib/WebGUI/MailCommand.pm +++ b/lib/WebGUI/MailCommand.pm @@ -24,13 +24,14 @@ 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 ); + return $commandObject->process( $parameter, $sender ); } sub session { @@ -42,7 +43,9 @@ sub resolveCommandClass { # TODO: Do not hard code. my %commands = ( - bounce => 'WebGUI::MailCommand::Bounce', + unsubscribe => 'WebGUI::MailCommand::Unsubscribe', + subscribe => 'WebGUI::MailCommand::Subscribe', + bounce => 'WebGUI::MailCommand::Bounce', ); return $commands{ $command } if exists $commands{ $command }; From 781f05f4f091b3ac0bfc8127bf78c83b813e0220 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:57:02 +0200 Subject: [PATCH 07/48] Fixup Subscribe command prototype. --- lib/WebGUI/MailCommand/Subscribe.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/MailCommand/Subscribe.pm b/lib/WebGUI/MailCommand/Subscribe.pm index c4057db..2244b1b 100644 --- a/lib/WebGUI/MailCommand/Subscribe.pm +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -9,16 +9,17 @@ use base 'WebGUI::MailCommand'; #----------------------------------------------------------------------------- sub process { - my $self = shift; - my $listName= shift; - my $session = $self->session; - my $log = $session->log; + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + my $log = $session->log; - my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); die "Invalid list name [$listName]" unless $asset; - $asset->subscribeThroughEmail( $fromAddress ); + $asset->subscribeAnonymous( $fromAddress ); return; } From 66774431f24f9d8716ce998e4a625c1c37624bec Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:59:35 +0200 Subject: [PATCH 08/48] Set env ip to that of sender. --- sbin/newsletter-transport.pl | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 8ec705b..d26eaf8 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -25,17 +25,23 @@ my $webguiRoot = '/data/WebGUI'; #--------------------------------------------------------------- # Startup { - my ( $configFile, $command, $id ) = getCredentials(); + my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials(); if ( WebGUI::MailCommand::isValidCommand( $command ) ) { my $session = openSession( $webguiRoot, $configFile ); - - WebGUI::MailCommand::processCommand( $session, $command, $id ); - + no warnings 'once'; + *{ WebGUI::Session::Env::getIp } = sub { + return $senderIp; + }; + + $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]"); + + WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); + closeSession( $session ); } else { - # TODO: log something + die "Not a valid command [$command]."; } exit(0); @@ -43,14 +49,18 @@ my $webguiRoot = '/data/WebGUI'; #----------------------------------------------------------------------------- sub getCredentials { - my ( $domain, $user ); + my ( $domain, $user, $sender, $senderIp ); GetOptions( 'domain=s' => \$domain, 'user=s' => \$user, + 'sender=s' => \$sender, + 'senderIp=s'=> \$senderIp, ); die "--domain parameter is required" unless $domain; - die "--user paramere is required" unless $user; + die "--user parameter is required" unless $user; + die "--sender parameter is required" unless $sender; + die "--senderIp parameter is required" unless $senderIp; my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; @@ -64,7 +74,8 @@ sub getCredentials { die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; - return ( $configFile, $command, $id ); + + return ( $configFile, $command, $id, $sender, $senderIp ); } #----------------------------------------------------------------------------- From d56e463a581f6b3fc78b4b713be2753782c473af Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 18:03:39 +0200 Subject: [PATCH 09/48] Adding Unsubscribe command. --- lib/WebGUI/MailCommand/Unsubscribe.pm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 lib/WebGUI/MailCommand/Unsubscribe.pm 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; + From 37120bafa884110e9459c19db02b0a652e1ff931 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:31:52 +0200 Subject: [PATCH 10/48] Refactoring postfix transport script to allow pluggable commands. --- lib/WebGUI/MailCommand.pm | 53 +++++++++++++++ lib/WebGUI/MailCommand/Bounce.pm | 40 ++++++++++++ lib/WebGUI/MailCommand/Subscribe.pm | 27 ++++++++ sbin/newsletter-transport.pl | 99 +++++++++++++++++++---------- 4 files changed, 184 insertions(+), 35 deletions(-) create mode 100644 lib/WebGUI/MailCommand.pm create mode 100644 lib/WebGUI/MailCommand/Bounce.pm create mode 100644 lib/WebGUI/MailCommand/Subscribe.pm diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm new file mode 100644 index 0000000..e81f90f --- /dev/null +++ b/lib/WebGUI/MailCommand.pm @@ -0,0 +1,53 @@ +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 $commandClass = resolveCommandClass( $command ) + || return; + + my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] ); + + return $commandObject->process( $parameter ); +} + +sub session { + return (shift)->{ _session }; +} + +sub resolveCommandClass { + my $command = shift; + + # TODO: Do not hard code. + my %commands = ( + 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..c4057db --- /dev/null +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -0,0 +1,27 @@ +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 $session = $self->session; + my $log = $session->log; + + my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->subscribeThroughEmail( $fromAddress ); + + return; +} + +1; + diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 044e54e..8ec705b 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -8,53 +8,82 @@ BEGIN { } use strict; +use warnings; -use Mail::DeliveryStatus::BounceParser; -use WebGUI::Mailing::Email; +#use Mail::DeliveryStatus::BounceParser; +#use WebGUI::Mailing::Email; +use WebGUI::MailCommand; use List::MoreUtils qw{ any }; +use WebGUI::Config; +use Getopt::Long; + +use 5.010; 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 ) = getCredentials(); -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 ); + if ( WebGUI::MailCommand::isValidCommand( $command ) ) { + my $session = openSession( $webguiRoot, $configFile ); - my $report = ( $dsr->reports )[0]; - my $reason = $report->get( 'std_reason' ); - my $message = $report->get( 'reason' ); - $message =~ s{\s+}{ }g; - - $session->log->warn( 'about to register as bounced' ); - $email->registerBounced( $reason, $message ); + WebGUI::MailCommand::processCommand( $session, $command, $id ); + + closeSession( $session ); } else { - $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" ); + # TODO: log something } + exit(0); +} + +#----------------------------------------------------------------------------- +sub getCredentials { + my ( $domain, $user ); + + GetOptions( + 'domain=s' => \$domain, + 'user=s' => \$user, + ); + die "--domain parameter is required" unless $domain; + die "--user paramere is required" unless $user; + + my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) + || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; + + my $configFile = $dispatch->get( $domain ) + || die "Received mail for domain [$domain] which is not configured!"; + + # Format is mailId-command + my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; + + die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; + die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; + + return ( $configFile, $command, $id ); +} + +#----------------------------------------------------------------------------- +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 }; +} From 28e49e3dab88fc89cb3d29b65ed7382105e1fdc5 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:33:33 +0200 Subject: [PATCH 11/48] Began refactoring Subscriber aspect to allow (un)subscription by email. --- lib/WebGUI/AssetAspect/Subscriber.pm | 32 ++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 272e14a..e143871 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -389,6 +389,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' ); @@ -472,6 +473,24 @@ sub www_confirmMutation { } +sub subscribeAnonymous { + my $self = shift; + my $email = shift; # TODO || return ? + my $session = $self->session; + + my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); + + if ( !defined $emailUser ) { + $emailUser = WebGUI::User::SpecialState->create( $session ); + $emailUser->update( { email => $email } ); + } + $emailUser->addSpecialState( 'Subscriber', $self->getId ); + + $self->subscribe( $emailUser, 1 ); + + return; +} + #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; @@ -501,13 +520,14 @@ sub www_processSubscription { $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->subscribeAnonymous( $email ); + #if ( !defined $emailUser ) { + # $emailUser = WebGUI::User::SpecialState->create( $session ); + # $emailUser->update( { email => $email } ); + #} + #$emailUser->addSpecialState( 'Subscriber', $self->getId ); - $self->subscribe( $emailUser, 1 ); + #$self->subscribe( $emailUser, 1 ); } } else { From 66209f41027342d70c5023390d67c46e8727fc83 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 15:16:06 +0200 Subject: [PATCH 12/48] Finsished breaking out anonymous (un)subscribe functions. --- lib/WebGUI/AssetAspect/Subscriber.pm | 33 +++++++++++++++++----------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index e143871..9f50beb 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -2,6 +2,7 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; +use 5.010; use Class::C3; use Carp; @@ -473,6 +474,7 @@ sub www_confirmMutation { } +#---------------------------------------------------------------------------- sub subscribeAnonymous { my $self = shift; my $email = shift; # TODO || return ? @@ -480,6 +482,7 @@ sub subscribeAnonymous { 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 } ); @@ -491,6 +494,20 @@ sub subscribeAnonymous { 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; +} + #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; @@ -515,19 +532,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' ) { - $self->subscribeAnonymous( $email ); - #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 { From 9422d7cd8487f1fbc8f7a63cf3495dec2a5c1006 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 16:29:29 +0200 Subject: [PATCH 13/48] Add listname property. --- lib/WebGUI/AssetAspect/Subscriber.pm | 44 ++++++++++++++++++++++++++++ sbin/install_newsletter.pl | 19 +++++++++++- 2 files changed, 62 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 9f50beb..1e5d32f 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -19,6 +19,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' ), @@ -264,6 +269,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; diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 5a75065..90b30c7 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,26 @@ addTemplateColumnToNewsletterCollection( $session ); addRecentColumnToNewsletterCollection( $session ); renamespaceTemplates( $session ); addSpecialStateTable( $session ); +addListNameColumn( $session ); finish($session); + +#---------------------------------------------------------------------------- +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; From 98ce48f82740fc4094f28b0977cc28e5fda8e923 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:53:35 +0200 Subject: [PATCH 14/48] Add missing use clauses; --- lib/WebGUI/AssetAspect/Subscriber.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 1e5d32f..64dcd65 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -8,6 +8,12 @@ use Carp; use WebGUI::Asset::Template; use WebGUI::Macro; +use WebGUI::Mail::Send; +use WebGUI::Group; +use WebGUI::Asset; +use WebGUI::Form; +use WebGUI::User::SpecialState; +use WebGUI::International; use Tie::IxHash; use URI; From 831f3ef17a980a1ea113b64dde450eb016ce390c Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:55:27 +0200 Subject: [PATCH 15/48] Add (us)subscribe commands and pass sender address along. --- lib/WebGUI/MailCommand.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm index e81f90f..a37aca1 100644 --- a/lib/WebGUI/MailCommand.pm +++ b/lib/WebGUI/MailCommand.pm @@ -24,13 +24,14 @@ 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 ); + return $commandObject->process( $parameter, $sender ); } sub session { @@ -42,7 +43,9 @@ sub resolveCommandClass { # TODO: Do not hard code. my %commands = ( - bounce => 'WebGUI::MailCommand::Bounce', + unsubscribe => 'WebGUI::MailCommand::Unsubscribe', + subscribe => 'WebGUI::MailCommand::Subscribe', + bounce => 'WebGUI::MailCommand::Bounce', ); return $commands{ $command } if exists $commands{ $command }; From 72f1e99bb893910ecce001b4d2ea85e5d761de0f Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:57:02 +0200 Subject: [PATCH 16/48] Fixup Subscribe command prototype. --- lib/WebGUI/MailCommand/Subscribe.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/MailCommand/Subscribe.pm b/lib/WebGUI/MailCommand/Subscribe.pm index c4057db..2244b1b 100644 --- a/lib/WebGUI/MailCommand/Subscribe.pm +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -9,16 +9,17 @@ use base 'WebGUI::MailCommand'; #----------------------------------------------------------------------------- sub process { - my $self = shift; - my $listName= shift; - my $session = $self->session; - my $log = $session->log; + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + my $log = $session->log; - my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); die "Invalid list name [$listName]" unless $asset; - $asset->subscribeThroughEmail( $fromAddress ); + $asset->subscribeAnonymous( $fromAddress ); return; } From 176becbfcee0578f6ac925aaa38c58a07b34a305 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:59:35 +0200 Subject: [PATCH 17/48] Set env ip to that of sender. --- sbin/newsletter-transport.pl | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 8ec705b..d26eaf8 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -25,17 +25,23 @@ my $webguiRoot = '/data/WebGUI'; #--------------------------------------------------------------- # Startup { - my ( $configFile, $command, $id ) = getCredentials(); + my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials(); if ( WebGUI::MailCommand::isValidCommand( $command ) ) { my $session = openSession( $webguiRoot, $configFile ); - - WebGUI::MailCommand::processCommand( $session, $command, $id ); - + no warnings 'once'; + *{ WebGUI::Session::Env::getIp } = sub { + return $senderIp; + }; + + $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]"); + + WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); + closeSession( $session ); } else { - # TODO: log something + die "Not a valid command [$command]."; } exit(0); @@ -43,14 +49,18 @@ my $webguiRoot = '/data/WebGUI'; #----------------------------------------------------------------------------- sub getCredentials { - my ( $domain, $user ); + my ( $domain, $user, $sender, $senderIp ); GetOptions( 'domain=s' => \$domain, 'user=s' => \$user, + 'sender=s' => \$sender, + 'senderIp=s'=> \$senderIp, ); die "--domain parameter is required" unless $domain; - die "--user paramere is required" unless $user; + die "--user parameter is required" unless $user; + die "--sender parameter is required" unless $sender; + die "--senderIp parameter is required" unless $senderIp; my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; @@ -64,7 +74,8 @@ sub getCredentials { die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; - return ( $configFile, $command, $id ); + + return ( $configFile, $command, $id, $sender, $senderIp ); } #----------------------------------------------------------------------------- From 14a1a03ba6e998cc4284e6b5917272c259d9f2e1 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 18:03:39 +0200 Subject: [PATCH 18/48] Adding Unsubscribe command. --- lib/WebGUI/MailCommand/Unsubscribe.pm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 lib/WebGUI/MailCommand/Unsubscribe.pm 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; + From de511529500363172ffef452ea8ad541413b67df Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Thu, 28 Oct 2010 15:10:09 +0200 Subject: [PATCH 19/48] Don't die on error but exit with correct code. --- sbin/newsletter-transport.pl | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index d26eaf8..8b59b0a 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -9,17 +9,20 @@ BEGIN { 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; -use 5.010; +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'; #--------------------------------------------------------------- @@ -41,7 +44,9 @@ my $webguiRoot = '/data/WebGUI'; closeSession( $session ); } else { - die "Not a valid command [$command]."; + warn "Not a valid command [$command]."; + exit( $NO_SUCH_USER ); + #die "Not a valid command [$command]."; } exit(0); @@ -57,22 +62,22 @@ sub getCredentials { 'sender=s' => \$sender, 'senderIp=s'=> \$senderIp, ); - die "--domain parameter is required" unless $domain; - die "--user parameter is required" unless $user; - die "--sender parameter is required" unless $sender; - die "--senderIp parameter is required" unless $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' ) - || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; + || warn "Cannot open $webguiRoot/etc/mailing_dispatch.config" && exit( $CONFIG_ERROR ); my $configFile = $dispatch->get( $domain ) - || die "Received mail for domain [$domain] which is not configured!"; + || warn "Received mail for domain [$domain] which is not configured!" && exit( $UNKNOWN_HOST ); # Format is mailId-command my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; - die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; - die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; + 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 ); From d08136669d400c6b8a36b1be7882dcfa96a25648 Mon Sep 17 00:00:00 2001 From: Arjan Widlak Date: Wed, 3 Nov 2010 18:16:20 +0100 Subject: [PATCH 20/48] updated required_modules --- docs/required_modules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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) From f66cc5f73f1d8796646b3e1e036ef388609e0957 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Fri, 5 Nov 2010 11:28:34 +0100 Subject: [PATCH 21/48] Rewrite mail commands documentation. --- docs/mail_commands_setup.pod | 101 +++++++++++++++++++++++++++++++++++ docs/postfix_configuration | 17 ------ 2 files changed, 101 insertions(+), 17 deletions(-) create mode 100644 docs/mail_commands_setup.pod delete mode 100644 docs/postfix_configuration 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. From 63b0a9edf14e715e7784a9eb8aae3c8d4d0d64eb Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 10 Nov 2010 15:04:17 +0100 Subject: [PATCH 22/48] Add text/plain part to confirmation and notifiocation mails. --- lib/WebGUI/AssetAspect/Subscriber.pm | 62 ++++++++++++++++++---------- 1 file changed, 41 insertions(+), 21 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 64dcd65..204ffbd 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -3,7 +3,7 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; use 5.010; -use Class::C3; +use Class::C3; use Carp; use WebGUI::Asset::Template; @@ -45,7 +45,7 @@ sub definition { alwaysConfirmSubscription => { fieldType => 'yesNo', defaultValue => 0, - label => $i18n->get( 'require confirmation' ), + label => $i18n->get( 'require confirmation' ), tab => 'subscription', }, allowAnonymousSubscription => { @@ -128,7 +128,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" ) . '>', @@ -192,13 +192,13 @@ 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 = + my $subscribeButton = sprintf '', $i18n->get('subscribe'); - my $unsubscribeButton = + my $unsubscribeButton = sprintf '', $i18n->get('unsubscribe'); my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } ); my $formFooter = WebGUI::Form::formFooter( $session ); @@ -231,8 +231,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 ; @@ -243,7 +243,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. @@ -331,14 +331,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]" ); @@ -362,14 +366,18 @@ sub sendNoMutationEmail { $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]" ); @@ -383,6 +391,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; @@ -390,7 +410,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=?', [ @@ -414,7 +434,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=?', [ @@ -440,7 +460,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' ); @@ -466,7 +486,7 @@ sub unsubscribe { my $self = shift; my $user = shift || $self->session->user; my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); - + my $session = $self->session; if ( $requireConfirm ) { @@ -499,8 +519,8 @@ 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, From 745addd5d167ade07ca2ae212cefd6842c4c19af Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Thu, 18 Nov 2010 15:21:44 +0100 Subject: [PATCH 23/48] Template confirm mutation screen. --- lib/WebGUI/AssetAspect/Subscriber.pm | 24 +++++++++++--- .../i18n/Dutch/AssetAspect_Subscriber.pm | 13 +++++--- .../i18n/English/AssetAspect_Subscriber.pm | 14 ++++---- sbin/install_newsletter.pl | 30 ++++++++++++++++++ .../root_import_personalnewsletter.wgpkg | Bin 3699 -> 4068 bytes 5 files changed, 66 insertions(+), 15 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 204ffbd..e02f616 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -87,6 +87,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 }, { @@ -527,21 +534,30 @@ sub www_confirmMutation { ] ); + 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->processTemplate( $var, $self->get('confirmMutationTemplateId') ); } #---------------------------------------------------------------------------- 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/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/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 2d07aea..ced5510 100644 --- a/sbin/install_newsletter.pl +++ b/sbin/install_newsletter.pl @@ -34,9 +34,39 @@ renamespaceTemplates( $session ); addSpecialStateTable( $session ); addListNameColumn( $session ); addRegistrationSteps( $session ); +addConfirmationTemplateColumn( $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 addListNameColumn { diff --git a/sbin/packages/root_import_personalnewsletter.wgpkg b/sbin/packages/root_import_personalnewsletter.wgpkg index a96e715f939d9a3ebf384ee7753971a2b5f75cb5..badf6e3a000fa7dd735bb4ed6c0a7daf484507d6 100644 GIT binary patch literal 4068 zcmVg&twHj{_G z4Y0Mri=5E5ITcpirx?1iHXj(NQlk_Xz$y$l{gM~PShw{Z|)TCwoJ4DF!Ycbx&DLx+;rw&I`H$ zOn~bZ-UrS;3A&{xLYxKL)8m$ zMwpTS>h4f?d~8yfTD(V%`#ww>|Ii$ZVO`?hyNkWGwGAekwY76OH5EylI9N``Qp#`% zQ?{yV^NF=JGM!=8v}4otz_rMLh?!HW)jQQ{yHl@fb5lz3Bf(+<8j5;A0$Z^CR_GdS z30M zfpr|7&%vQ*Qkd>sJvmxfTiZQ9*iY+(`1>wfePUrJ)*tbuXr|S!YlfF~I!33{GU}R4 zD83^;teCfvb;!~WEDV@~@sv>734JV#LS!ORER5XAp0nf9u@Ipqa|h<5@0ooe^Ruw$ z_bKVYqK*_R6+N|}vD2pyUT~bjO|;;Yozj+6wCvE_>rD+eFo)8V?AM&5;nv5`+qXxj zC!?eD5A{8IlrSY{4?gfSEf1K2+;(S8LavHP!@4o#Ha)E)!>Dx>Z!ooBD95HvV1zkd&=-V1LFCBJ&&j* z-S)=Wmgyxh84Npi2qsD=*@!o zEX=&A$FcAC<0@*M{Iod4B0*fA(Mcwh=)Sln8cfnR!i|-0Q7Xx&VlFB0)9T8iy&6PRMjaCu&v>!&FIphzQR48hW5yW?*}2jZkuAbGFQ5-T8PfT`+DoE9=%XP2SF0IDV+#K@ zApy9=e+y9mo0rc2{_js=z=HhVQ}9s7bUWvR!_nnl`@{RA$^PTc zh25f`u;w3T%oVD%VR>vikUpSgnLbpmCNIrb02_ zRP@Je4TW_(FbRYkLn+%KhHV0jA#*MsXVViSAcLq@QnZX!_Q_FhZ(VljuXQUuF1%@e zyCKXKSb0~0pv0CBlQ*B>lCxx=T1}fwwT)<;@$B-Nq{X%exSd{KneIMn5D%01XApH- zp^eq_iYn=UKVtfb9m|3&_IM5b_w7HgO20g!Up`-zepO2Mp$5wUum6i%7rnjyJzLp* z)9GVdD$5-7D89i?wvr-Za;}mA7fbY1|ErDjB*bC!NBF#|rKx;6yniA$4erTRKqXW4j<4)l>+oM?5u+a<~je3S6Bl+|6zM_`w zEKE~HDKo`hR%WTyG}_IMmR#Y^jiWJ@HbMsi4WeilElznAw6aeU^KslunD&(ZWVDU5se_=pbuvZ!^Q5`5gAL6pM*`6a5@qrFwbKK|bxK)gD8m9_R z0uCh!L=i)snzRx)vkSf>7eB_`=s0m+pp-Y*e84BQ0Na zPoajHb^sb1pW5w%+jk$0`_GpbjnU@qz!_`D6<`i$o~Fn>F;R5PBI7g#&+m6uwL?vb z{Qgs$im~(I$fBCe-RIYpt~%)4e;4TZJ}^26YHd4u`RfAXVZWr}Y@LiJ;MdN$dr1t;NM`N%$=3?EmI zo&El8d9Bj^Zw(2Y>BQ*Hb?J=@yUOT}o&R;v1fH1=3XwZT z;RJ~Tt(aBq;X4R@2~=7^Z%sH%?_xB%fs!IB*&u3my`v z0Y4);kYMu>q}gs((1z_p3swh`wKq1o3DCr)R=_xzkS~v92$hiqybkf5i>bBJt%xix zQ)t)A%q}L*u%2TY4h3r#<|kQ!1WPdrGMe~jh%)Dm44)1=n~H%aLfG_iR%5klwBZPY zB2f@GssJ=P&MJ>C^Qnu{Q}?NGGCvSaMuwfb7FriZl*uCwGqU+(gqkT$<%XKEOV5iZ z3u4h^sHq)n)ep3uri@e(Qj$lsl>sinqWcS(l0Rue)Y4NYbay^Jc&Dp}wP3e;anSkv zxihFf!2O0exs!(}i=bmJ-ps<3&1S0scdk^AFNY}?09%$_ypRNP@PA{W_`h0Dur5(yzdQ%&CL^4_f@e! z&yqmi51<9TCjKcNhPEj-Wi|oWV{H$ZSAh#{e!wnmtxuP*5Re!A%HcOBjBQ`+Ail$J z8X2hV!j5_60N=p{wTY-Fc75b75o>ud5g~(VQS2k)Bh!{$0h=bA?r@zwKgKWX5Cg!e zVz{ez2iv=<(~tz(^F${sx

V9d*b=8w=OWwa7j5{qAIRILk5TmyZNA7(ag`04~4Q zXllX4T#p`4nSFBS#p=hB}M1r)IOV?+Qc4J|eTICP`SZQCrBuM|8d_|LH= z&$c7la?Z3LDhK?kHe(KZp+u)3|KV0+cjI8gT=m-f`);}1Dmw>whBWd^LjL6XUqb#u zZ1i_1%)$TlMdE*W^G6E**O&NzA=7V({}+J&^(1Oh0MIn|@pyPZ&v!=e8u)hDGQMni z%K#t_09*f0X!RN=b{2KeoiXQ}|}nUnT;1ZKE|uR5Gu@$~-(*WU17mRAJBV z`T65y_w3XDhqB>KYQYEp%kINscRC=fZfeGB8TKe>nS=jZ3&j7ctMF35)cfC>%lyC6 z((8R&;{R8~|LX8FyaLX);l&k@vrb>@)b{|)Pai++c<#XbbT>ZzV!LLPcgiI(C%yaNn2m!RRbMvqI2-xko0+q2e64iMb2Jt@{+Fd1~282JTbm`Xhs z2+}oF^X`%F+QdRX8;0>4@=VKueIY2QdiS{kW>X^~EG{fX5){9rHg%cm7m?UCOKsaK zo=N--HR;iUtd7{bYoq{`@U*K_f=01OV(n;RVf?ZWJA0pXrB>b;5aji#%+9*0yIyj6 zXnJHcr>+nRlN|yDOD8fJz=O6|L55?V3il z=n_`)$lQ#4{ulvkN>vL8Sd{>ko|Pu%+$v*MOuP}{|B*C zh|OTap)%j0nrV(StD$ml>)hIBJ55DS^M_#0m<^w%n(z4pmDr{#50&lhBw=YGUPh%GKJS_R(7Sxxz9v@P-26Cvf7=)&a_HHYbzW|lwQaQOwO6^U^Lk<6 WlJZglO9}i9CGbE0%_3m{WB>qmg!I4w literal 3699 zcmV-(4vg_1iwFP!00000|Lt6RbK*D>pTGB0=-Aq-yQ(EXFpy-qR3(|oBr|zGCO5O$ zOBpOciLo8Yh9q0_-LLhqC4)^M6PTM_n3{lXsnzP1x_{l0yz*xLpK`g}sMX%QDVHma zT3LUiG5AdFg-U1%mnxRsQ@5 zv`}E7Pwg%)pbhlGSTE zKvFPiY!{eiE)GLXH7T1h94a#O;oaW*{_ghe!ch!)2-m`5B!B7#J>vB+CE+D?cd6e$u_^W>VWW(LS(}m| zB);fRN;Pd5M(oJ$O9@=z*89u-jg2iX#f^nf$HG ziLtiRv%PNCNaQ2<(053O$T3r>tTrm^R&}khrb#G)eIi(n$%cLuCez|XjfkU+5z+Ts z#Kq??kS)6-!I2*Ve{DM!Ucr!SAA6CWnv;0oa)`v-DcAwb^?^C(#E?BFPf`WdT21$m zumhjZC^?H$iZewk#@YIMV|~5WSTz`=m=8+ddmGRAECItTfLWVpQ#T$lEa!7PyG1hw z`SAInYHAXDZTc95CmBtJc2|w}_v=r^tJCB5S>t5SYrng5+1bbaQ_U2gfLm_Rvs*X> zwYaXdZw6O{oj)>QZIoNWq_wnL@Wnh0B$4{z99yK)8oU%V!#xP%Yk~+;Y4AZUl{|IG#o7UZ4bN*EjqYkM{cOy zhp^4cQtw`Lj(S)7Yac%x4-cMpFWnmbj15=w0(dwH-NjlLeQye^hdA{7_jMrz$(GuT zT^BaFP=5AY)d3Vb=udtN8~_^d00CTH(RNAK1N<5K!EgNGSN^A25+nryaV?w-A`Z|` z=&1%cwPr{~S^k@UnqhDAh~Q|*T9n{Uvjo?1%gOVo-^Vob(N-IRm(&xu&@D7MioJ1t zKR{Yd;yP($oFNBMf5-ycgDyw{1DhhkScG@{$O|`(?ub5!Zt#Y9Ie`v0n=Oh;NgGKi z8}%ser07DV!3qA3TKJCK-l0F5C3}YI7!W<6@R-C9Q$->r#8T)a%os8eeHs-9??~ji zm@#y7v%7zGesObSRHjH^cj$u{)Mx(C5C;ffS5GQQJvy7sjP4u!YgsE9azU7!$8^lD z@q53cEXqo-QmkC4=#S|t$`JO@CJ=6Pm2A5hLPd-z>dV{N^kff6CoYv1EoYT~a>hn$ zQ#Hvpnx&Qy-YCD#2ow#I?mCo|`1DBzxZ*6`rcu%*BXwgM=ORkjP_+0M79f9fWwiOY zLefpZybyIdk&E^4iVK zG3%SZvz6Vpy*750vg}Ta;yVnsDNE@wF*R06M~Ef9YknL3JdJRa-${`2kKe_8$Hlp# z;9|*^yn`VZf|cau#bmkXlQL`p|EbAbhy0(ZnrvPI9#G+-Vn!KM%qNCP%cK+k&ZftQ zZ9o}FSnf4J}M`m`?-Z$=i^gM268%C^k7DQ{nr`qllOl&?~wR|i3bTtuHj^M9s6 z{04{cUt{Rr%z^A28E3(BaZf{XeyL%&nB>yxWWsJqbQ*}QO_zd$0#Z+cdRZ7cv%KMG zcpVLz5wH(9Rf8%6A%R(sp`9j~8SwOc@bf4yGUjv$rae{NARSv3)Eubj@^ z=j4B_#pQpIRjG`w|65jdx&EJ%v3=d!%lxn0Cm`kq&uZvN_RV_$N-Eh~Z2Mk^(7sr* zEmC|R5jwWqs#3sCB|MD=#bftm*nO&>cn9tKVsA?`HP;kyuzB1^eFFK`h}=Oaiw3?= z?|gvvXu$V}cxVXsY!5}q@1tml`VoYV1oNUTJb=)bK%o`%)`rbgK1My~6CEsX5^wiUsa`)3?a8^I6gnQ-7!}Tv; z);r}#*yEP$XPWz-5zDGoE0(c$>Gd$>>mrmTwRuV)2me@QLwklcf8 z0lgvY40j{fmWwjm0PL}`1}us|K*K`5O?Pwj318|E4}KN!TM))BlPietG3+k_YJ0F^ zUOL1B*nB*c<>ac5S|#E&FNZQ@upNpSY_dSMtC|8fZP?x6d;2WGFPjhpz^-E0L@|Kn zUEOFzLgRj_5gy$j!26!wWMcG1Xy!&Hm{&MI{J)`$?-B_ZFn;z(09<~hY8k=AOp$=+ zt8mX(p`4b*t3?6kzVsJF0TWpKF(QC54J|eTIPwogK<|6+c)ngMct-G_V@qCaM~vy5 zX+LzLcdj;L2794Jry>8*PIYhVaLcX-YX=8@u~;j5hj@``{{`TGGl@DW0I=)>-0vRJi{0M)D!%X58n-*aG5|;d06*wr zNb$oe0W3d25W!ag;6lQK#RmoGBdkRrSd-uj84wNGHhhaU3(g;Guu89sY{WrC)|O;7 zMAUl3cCwhlmm%VM8dQ9r&2Gk-v6loNR&9OF$T!Xue3&yxMul1!uN8e%D%Ev^>NhSz zjKujrO8haRq{YS`<_g4LCIXqa(V8JDnblxr?vR^gsr2;GVb9*h#nW)_{PV%bVj~z< z!jJ5B?{Tp!9T50fhVfd4JsMi(;Q!hJ@qfK;HOBJ)wdykeueCJ4UrYQyNBpl37Qz-F z*M%2XK+byd5m5W{r_Z~A-?2Xr`e&d0y`fuuuu|4?<~M{Wpv8Cmi(O9Umj3h+P=^fE z@yz6{6*~#v5@qvEmuk&o4?n=!LKL6*)1B3IAiFM(yQ*`59LNIr<(u8%kRWl!NOF4O zd}#JF*pQ>qaDw_7oJRz?t^jK*w$mrxv6mc7(Jg@63aRfh@kl2OV{DyJGhc9{$@Hpf zTQKjx+H_umo1#alMFnvuPJkNkInlJZlw+Y81&p(j;+Tz~!J9M6Xd?e87GZl?@)nh1 zQ9mj{0}~nJM48<8Azs14PbA!Q;E$-KJD@hS%Z=`BdA^lv5c+-O%TuomJz_ZTl$M0r z**+#(ira9o92S@0xa^HVPxMqA2{885^V(Vt5Zv)KDPCVP88*2X#Q|d&N-Z7;(hXDz z9uV_g;-H`54N||Mz;+y17lH@n;2~GQd}zdk=6l`rSuZs`3_Wt1 zBge9mvtH@R)D*){1HtbTsv3u?W)D?sa44&>KI=M}apY;-0BU)>Rr z53e63EcWjR@GMiS?$Z9!rNQx28; z4qYv_KKy3lM0G{&-Zq7`&vu%coZ%0F9=GA6RP#Nbq>|WF?V+;0og%C(WWsWWhm+4n zO?gry@oF#fXOax>RqVsY`fXV4QE7lv9rsbZzhnMs`vrX>f7+>|eRss9-fYl?S% zo=gvt5ig_D4PW-{b`)Gay}KdKs=fWG`{BOYN#)Szd|1a?Yt&XNb2+Rtzc6q~c`1RV R1pbB+_#d*wNwxr5000dFG(P|U From 4fdc8b1798279f5cc0d005fd9629e704181e945e Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Fri, 19 Nov 2010 13:11:42 +0100 Subject: [PATCH 24/48] Allow empty senderIp and default to 127.0.0.1. --- sbin/newsletter-transport.pl | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index beedd33..db49696 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -34,11 +34,9 @@ my $webguiRoot = '/data/WebGUI'; my $session = openSession( $webguiRoot, $configFile ); no warnings 'once'; *{ WebGUI::Session::Env::getIp } = sub { - return $senderIp; + return $senderIp || '127.0.0.1'; }; - $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]"); - WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); closeSession( $session ); @@ -65,7 +63,7 @@ sub getCredentials { 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; + #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 ); From 80e1f1e0ea14badfd4bbe86c781f40b6f70547e9 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 24 Nov 2010 10:32:00 +0100 Subject: [PATCH 25/48] Don't absolutify # and mailto hrefs --- lib/WebGUI/Mailing/Email.pm | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/lib/WebGUI/Mailing/Email.pm b/lib/WebGUI/Mailing/Email.pm index 7598656..9445285 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,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; } @@ -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, From 0843bec5e0a59eff7374eb2d256efaf48eaabed2 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 24 Nov 2010 10:37:42 +0100 Subject: [PATCH 26/48] www_confirmMutaton dd not process style template. --- lib/WebGUI/AssetAspect/Subscriber.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index e02f616..13d2d08 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -557,7 +557,7 @@ sub www_confirmMutation { } } - return $self->processTemplate( $var, $self->get('confirmMutationTemplateId') ); + return $self->processStyle( $self->processTemplate( $var, $self->get('confirmMutationTemplateId') ) ); } #---------------------------------------------------------------------------- From d325e7a3014949d625523288991fec84994456cb Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Fri, 12 Nov 2010 18:02:50 +0100 Subject: [PATCH 27/48] Unslow bounce report generation and add some extra info as a bonus! --- lib/WebGUI/Mailing/Bounce.pm | 44 +++++++++++++++++++---- lib/WebGUI/i18n/Dutch/MailingManager.pm | 10 +++++- lib/WebGUI/i18n/English/MailingManager.pm | 10 +++++- sbin/install_newsletter.pl | 12 +++++++ 4 files changed, 68 insertions(+), 8 deletions(-) diff --git a/lib/WebGUI/Mailing/Bounce.pm b/lib/WebGUI/Mailing/Bounce.pm index 7a4fe33..c76b572 100644 --- a/lib/WebGUI/Mailing/Bounce.pm +++ b/lib/WebGUI/Mailing/Bounce.pm @@ -57,13 +57,45 @@ sub session { sub www_bounceReport { my $self = shift; my $session = $self->session; + my $db = $session->db; my $i18n = WebGUI::International->new( $session, 'MailingManager' ); - my $sth = $session->db->read( 'select distinct sentTo from Mailing_email where sentTo is not null' ); - - my $output = ''; - while ( my ($email) = $sth->array ) { - my $score = $self->getBounceScore( $email ); - $output .= ""; + + my $windowSize = 10; + + my $sql = <read( $sql, [ $windowSize, $windowSize - 1 ] ); + + my $output = '
'.$i18n->get('email').''.$i18n->get('bounce score').'
$email$score
'; + while ( my $values = $sth->arrayRef ) { + $output .= ''; } $output .= '
' + . join( '', + $i18n->get('email'), + $i18n->get('bounce score'), + $i18n->get('bounce reason'), + $i18n->get('bounce message') + ) + . '
'. join( '', @$values ) . '
'; 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/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/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index ced5510..c044a0f 100644 --- a/sbin/install_newsletter.pl +++ b/sbin/install_newsletter.pl @@ -35,6 +35,7 @@ addSpecialStateTable( $session ); addListNameColumn( $session ); addRegistrationSteps( $session ); addConfirmationTemplateColumn( $session ); +addSentToIndex( $session ); finish($session); @@ -63,6 +64,17 @@ sub addConfirmationTemplateColumn { 'WUk-wEhGiF8dcEogrJfrfg', ] ); + +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"; From fffdb9d1a0af58c5fb1122cc95c242c2f73cb54e Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 24 Nov 2010 13:23:26 +0100 Subject: [PATCH 28/48] Call prepareView on child assets in the prepareView phase to prevent their head tags showing up in our body. --- .../Asset/Wobject/NewsletterCollection.pm | 32 ++++++++++++------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm index d35d745..cce6d01 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 }; @@ -35,7 +35,7 @@ sub definition { defaultValue => 1, }, ); - + push @{ $definition }, { assetName => $i18n->get('assetName'), icon => 'newsletter_collection.gif', @@ -52,12 +52,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 +92,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 +111,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,7 +136,7 @@ sub getViewVars { foreach my $issue ( @{ $issues } ) { my $issueVar = $issue->get; $issueVar->{ url } = $issue->getUrl; - + my $isRecent = ( !$displayIssueId && $recentCount < $maxRecent ) || ( $issue->getId eq $displayIssueId ) @@ -157,7 +167,7 @@ sub view { my $self = shift; my $form = $self->session->form; - my $var = $self->getViewVars( { + my $var = $self->getViewVars( { displayIssue => $form->guid('displayIssue'), } ); From 595e340515d0b83e3b869367e1e4a3a42ef5905b Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 24 Nov 2010 15:01:21 +0100 Subject: [PATCH 29/48] Fix syntax error resulting from merge. --- sbin/install_newsletter.pl | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index c044a0f..9745c38 100644 --- a/sbin/install_newsletter.pl +++ b/sbin/install_newsletter.pl @@ -64,7 +64,12 @@ sub addConfirmationTemplateColumn { 'WUk-wEhGiF8dcEogrJfrfg', ] ); + } + + print "Done.\n"; +} +#---------------------------------------------------------------------------- sub addSentToIndex { my $session = shift; my $db = $session->db; From 0d1b0fe7ac62f179ed3458d8ae4739ed58068a51 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Thu, 9 Dec 2010 14:10:19 +0100 Subject: [PATCH 30/48] Add sortable YUI data table to bounce score overview. --- lib/WebGUI/Mailing/Bounce.pm | 62 ++++++++++++++++++++++++++++++++++-- 1 file changed, 59 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Mailing/Bounce.pm b/lib/WebGUI/Mailing/Bounce.pm index c76b572..422cc23 100644 --- a/lib/WebGUI/Mailing/Bounce.pm +++ b/lib/WebGUI/Mailing/Bounce.pm @@ -86,21 +86,77 @@ EOSQL my $sth = $db->read( $sql, [ $windowSize, $windowSize - 1 ] ); - my $output = '
' + my $output = '
'; + . ''; while ( my $values = $sth->arrayRef ) { $output .= ''; } - $output .= '
' . join( '', $i18n->get('email'), $i18n->get('bounce score'), $i18n->get('bounce reason'), $i18n->get('bounce message') ) - . '
'. join( '', @$values ) . '
'; + $output .= '
'; + + $self->addBounceScoreTableJS; return WebGUI::Mailing::Admin->new( $session )->getAdminConsole->render( $output, $i18n->get( 'bounce scores' ) ); } +sub addBounceScoreTableJS { + my $self = shift; + my ($style, $url) = $self->session->quick( qw{ style url } ); + my $i18n = WebGUI::International->new( $self->session, 'MailingManager' ); + + my $emailLabel = $i18n->get('email'); + my $scoreLabel = $i18n->get('bounce score'); + my $reasonLabel = $i18n->get('bounce reason'); + my $messageLabel= $i18n->get('bounce message'); + + my $js = < + // + +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; From 3ffb43bd6815de61f46e8614857a84e256ad60dc Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 15 Dec 2010 17:19:42 +0100 Subject: [PATCH 31/48] Make newsletter settable --- .../Registration/Step/MailingSubscribe.pm | 70 +++++++++++-------- 1 file changed, 40 insertions(+), 30 deletions(-) diff --git a/lib/WebGUI/Registration/Step/MailingSubscribe.pm b/lib/WebGUI/Registration/Step/MailingSubscribe.pm index deff855..19eebd5 100644 --- a/lib/WebGUI/Registration/Step/MailingSubscribe.pm +++ b/lib/WebGUI/Registration/Step/MailingSubscribe.pm @@ -15,12 +15,15 @@ sub getAvailableMailings { my $self = shift; my $session = $self->session; - my $availableMailings = WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], { - returnObjects => 1, - isa => 'WebGUI::Asset::Wobject::NewsletterCollection', - } ); + my $mailingIds = $self->get( 'includeMailings' ); - return $availableMailings; + my @mailings = + grep { defined $_ } + map { WebGUI::Asset->newByDynamicClass( $session, $_ ) } + ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds + ; + + return \@mailings; } #------------------------------------------------------------------- @@ -31,7 +34,7 @@ sub apply { my $subscribeTo = { map { $_ => 1 } @{ $self->getConfigurationData->{ subscribeMailings } || [] } }; - + my $availableMailings = $self->getAvailableMailings; my $sendNotification = 0; @@ -49,22 +52,32 @@ 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, 'Registration_Step_Homepage' ); -# -# -# $definition->{ dynamic }->{ urlStorageField } = { -# fieldType => 'selectBox', -# label => 'Store homepage url in field', -# options => \%profileFields, -# }; -# -# 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' ); + + 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 => 'Store homepage url in field', + options => \%mailings, + vertical => 1, + }; + + return $definition; +} #------------------------------------------------------------------- sub getSummaryTemplateVars { @@ -77,7 +90,7 @@ sub getSummaryTemplateVars { # Fetch preferred homepage url my $mailings = $self->getConfigurationData->{ subscribeMailings }; - my @assets = + my @assets = grep { defined $_ } map { WebGUI::Asset->newByDynamicClass( $session, $_ ) } @{ $mailings }; @@ -89,12 +102,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 ); } #------------------------------------------------------------------- @@ -119,7 +132,7 @@ sub getViewVars { } else { # The step hasn't been done yet. - @subscribeMailings = grep { $_->isSubscribed( $user ) } @{ $availableMailings }; + @subscribeMailings = map { $_->getId } grep { $_->isSubscribed( $user ) } @{ $availableMailings }; } # Create lookup table @@ -171,10 +184,7 @@ sub updateFromFormPost { my $self = shift; my $session = $self->session; - $self->SUPER::updateFromFormPost; - -# $self->update( { -# } ); + return $self->SUPER::updateFromFormPost; } #------------------------------------------------------------------- From efb7a004acb5f30531a79375827f0e7b13c27084 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Thu, 16 Dec 2010 13:39:15 +0100 Subject: [PATCH 32/48] Make subscribe buttons ie proof. --- lib/WebGUI/AssetAspect/Subscriber.pm | 34 ++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 13d2d08..f1c1750 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -203,12 +203,32 @@ sub appendSubscriptionFormVars { 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 + ; + 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'), + } + } ) + . WebGUI::Form::submit( $session ) + . $formFooter + ; # Compose default subscription form for current user my $form = ''; @@ -217,11 +237,11 @@ 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; From 98c3c699598675f56c0417f053080daf205bd15e Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Thu, 16 Dec 2010 13:42:35 +0100 Subject: [PATCH 33/48] Fix typo. --- lib/WebGUI/AssetAspect/Subscriber.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index f1c1750..a48a51b 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -246,7 +246,7 @@ sub appendSubscriptionFormVars { $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; From c6d7fe913ddc392e96e7b0a40e959959e6cb317f Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Thu, 16 Dec 2010 16:50:19 +0100 Subject: [PATCH 34/48] Fix invalid label. --- lib/WebGUI/Registration/Step/MailingSubscribe.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Registration/Step/MailingSubscribe.pm b/lib/WebGUI/Registration/Step/MailingSubscribe.pm index 19eebd5..965f452 100644 --- a/lib/WebGUI/Registration/Step/MailingSubscribe.pm +++ b/lib/WebGUI/Registration/Step/MailingSubscribe.pm @@ -71,7 +71,7 @@ sub crud_definition { $definition->{ dynamic }->{ includeMailings } = { fieldType => 'checkList', - label => 'Store homepage url in field', + label => 'Include newsletters', options => \%mailings, vertical => 1, }; From 1d35a471e870405218a64b475ac264f9bef5343d Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 22 Dec 2010 10:30:53 +0100 Subject: [PATCH 35/48] Prevent warning. --- lib/WebGUI/Asset/Wobject/NewsletterCollection.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm index cce6d01..594f2a8 100644 --- a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm +++ b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm @@ -138,7 +138,7 @@ sub getViewVars { $issueVar->{ url } = $issue->getUrl; my $isRecent = - ( !$displayIssueId && $recentCount < $maxRecent ) + ( ! defined $displayIssueId && $recentCount < $maxRecent ) || ( $issue->getId eq $displayIssueId ) ; From e209e0104a1f635482f4d5e72b2a46a150f6c104 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 22 Dec 2010 10:40:53 +0100 Subject: [PATCH 36/48] Fix missing i18n messages. --- lib/WebGUI/Registration/Step/MailingSubscribe.pm | 4 ++-- lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm | 3 +++ lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm | 3 +++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Registration/Step/MailingSubscribe.pm b/lib/WebGUI/Registration/Step/MailingSubscribe.pm index 965f452..997d8b8 100644 --- a/lib/WebGUI/Registration/Step/MailingSubscribe.pm +++ b/lib/WebGUI/Registration/Step/MailingSubscribe.pm @@ -57,7 +57,7 @@ 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' ); + my $i18n = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' ); tie my %mailings, 'Tie::IxHash', ( map { $_->getId => $_->getTitle } @@ -71,7 +71,7 @@ sub crud_definition { $definition->{ dynamic }->{ includeMailings } = { fieldType => 'checkList', - label => 'Include newsletters', + label => $i18n->get('Include newsletters'), options => \%mailings, vertical => 1, }; diff --git a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm index 957d7f1..698a399 100644 --- a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm +++ b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm @@ -9,6 +9,9 @@ our $I18N = { 'Subscribe to this mailing' => { message => 'Abonneer op deze nieuwsbrief', }, + 'Include newsletters' => { + message => 'Selecteerbare nieuwsbrieven', + }, }; 1; diff --git a/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm b/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm index 9b6df53..71534e4 100644 --- a/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm +++ b/lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm @@ -9,6 +9,9 @@ our $I18N = { 'Subscribe to this mailing' => { message => 'Subscribe to this mailing', }, + 'Include newsletters' => { + message => 'Include newsletters', + }, }; 1; From cc02178bb7cec17aadca5134c2b88354777261f2 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 22 Dec 2010 15:24:14 +0100 Subject: [PATCH 37/48] Now prevent warning even morerest. --- lib/WebGUI/Asset/Wobject/NewsletterCollection.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm index 594f2a8..fd581ed 100644 --- a/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm +++ b/lib/WebGUI/Asset/Wobject/NewsletterCollection.pm @@ -137,10 +137,10 @@ sub getViewVars { my $issueVar = $issue->get; $issueVar->{ url } = $issue->getUrl; - my $isRecent = - ( ! defined $displayIssueId && $recentCount < $maxRecent ) - || ( $issue->getId eq $displayIssueId ) - ; + my $isRecent = defined $displayIssueId + ? $issue->getId eq $displayIssueId + : $recentCount < $maxRecent + ; if ( $isRecent ) { $issueVar->{ content } = $self->getAssetContent( $issue ); From b5348ea49e77558491edfdb8e857d6b4a735e211 Mon Sep 17 00:00:00 2001 From: Arjan Widlak Date: Wed, 12 Jan 2011 15:10:04 +0100 Subject: [PATCH 38/48] Changed some i18n text --- lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm index 698a399..5d08975 100644 --- a/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm +++ b/lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm @@ -4,10 +4,10 @@ use strict; our $I18N = { 'Subscribe to mailings' => { - message => 'Abonneren op nieuwsbrieven', + message => 'Ontvang op nieuwsbrieven', }, 'Subscribe to this mailing' => { - message => 'Abonneer op deze nieuwsbrief', + message => 'Ontvang op deze nieuwsbrief', }, 'Include newsletters' => { message => 'Selecteerbare nieuwsbrieven', From 95d0f9fedbeb09eea2f59994c50a618c2c3cc2f8 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Fri, 14 Jan 2011 14:32:15 +0100 Subject: [PATCH 39/48] Set a flag when rendering mailings --- lib/WebGUI/AssetAspect/Mailable.pm | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) 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; } From 2a6e8f6193dbc385e53df9d0fc5ffc8e4a4f2152 Mon Sep 17 00:00:00 2001 From: Arjan Widlak Date: Wed, 19 Jan 2011 12:38:19 +0100 Subject: [PATCH 40/48] Added option to add existing users to another group than new users. Added documentation. --- sbin/importSpecialState.pl | 46 +++++++++++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 10 deletions(-) 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 From 87139a7498c55986f8367160e8850a2a9af9309b Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 15 Jun 2011 04:56:23 +0200 Subject: [PATCH 41/48] Fixed bug where generate mailing would generate two mailings before even saving the form. --- lib/WebGUI/Mailing.pm | 84 +++++++++++++++++++++---------------- lib/WebGUI/Mailing/Admin.pm | 74 ++++++++++++++++++++++++++++---- 2 files changed, 113 insertions(+), 45 deletions(-) diff --git a/lib/WebGUI/Mailing.pm b/lib/WebGUI/Mailing.pm index 31ced29..93d8124 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 = WebGUI::HTMLForm->new( $session ); + my $f = $self->getEditForm; $f->hidden( name => 'newsletter', value => 'mailing', @@ -435,6 +435,16 @@ 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 ) { @@ -444,7 +454,7 @@ sub www_edit { 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 @@ -458,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; } #---------------------------------------------------------------------------- @@ -486,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; @@ -494,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.

@@ -516,11 +526,11 @@ sub www_previewEmail { } - - - - - + + + + +