package WebGUI::AssetAspect::Subscriber; use strict; use warnings; use 5.010; use Class::C3; use Carp; use WebGUI::Asset::Template; use WebGUI::Macro; use WebGUI::Mail::Send; use WebGUI::Group; use WebGUI::Asset; use WebGUI::Form; use WebGUI::User::SpecialState; use WebGUI::International; use Tie::IxHash; use URI; #---------------------------------------------------------------------------- sub definition { my $class = shift; my $session = shift; my $definition = shift; 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' ), tab => 'subscription', noFormPost => 1, }, subscriptionEnabled => { fieldType => 'yesNo', defaultValue => 1, label => $i18n->get( 'Enable subscription' ), tab => 'subscription', }, alwaysConfirmSubscription => { fieldType => 'yesNo', defaultValue => 0, label => $i18n->get( 'require confirmation' ), tab => 'subscription', }, allowAnonymousSubscription => { fieldType => 'yesNo', defaultValue => 1, label => $i18n->get( 'allow anonymous' ), tab => 'subscription', }, confirmationRequiredTemplateId => { fieldType => 'template', defaultValue => 'd1tQuv-OlPwgz6PnLcq-hA', label => $i18n->get( 'confirmation required template' ), namespace => 'Subscriber/ConfirmationRequired', tab => 'subscription', }, confirmationEmailSubject => { fieldType => 'text', defaultValue => 'Confirm your subscription mutation', label => $i18n->get( 'confirmation email subject' ), tab => 'subscription', }, confirmationEmailTemplateId => { fieldType => 'template', defaultValue => '4aLemgMrTFhG3eqg57jCpQ', label => $i18n->get( 'confirmation email template' ), namespace => 'Subscriber/ConfirmationEmail', tab => 'subscription', }, noMutationEmailSubject => { fieldType => 'text', defaultValue => '(Un)subscribe result', label => $i18n->get( 'no mutation subject' ), tab => 'subscription', }, noMutationEmailTemplateId => { fieldType => 'template', defaultValue => 'Q8t7dUqMk05D2m7Jbgg4BQ', label => $i18n->get( 'no mutation template' ), namespace => 'Subscriber/NoMutationEmail', tab => 'subscription', }, ); push( @{ $definition }, { autoGenerateForms => 1, tableName => 'assetAspectSubscriber', className => 'WebGUI::AssetAspect::Subscriber', properties => \%properties } ); return $class->next::method( $session, $definition ); } #---------------------------------------------------------------------------- sub duplicate { my $self = shift; my $properties = shift; my $newSelf = $self->next::method( $properties ); $newSelf->update({ subscriptionGroupId => '' }); $newSelf->createSubscriptionGroup; return $newSelf; } #---------------------------------------------------------------------------- sub getEditTabs { my $self = shift; my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); return ( $self->next::method, [ 'subscription', $i18n->get('tab name'), 9 ] ); } #---------------------------------------------------------------------------- sub getListHeaders { my $self = shift; my $email = shift || return {}; my $site = $self->session->url->getSiteURL; my $headers = { 'List-Unsubscribe' => '<' . $site . $self->getUrl( "func=processSubscription&action=unsubscribe&email=$email" ) . '>', 'List-Subscribe' => '<' . $site . $self->getUrl( "func=processSubscription&action=subscribe&email=$email" ) . '>', 'List-Archives' => '<' . $site . $self->getUrl . '>', }; return $headers; } #---------------------------------------------------------------------------- sub canSubscribe { my $self = shift; return !$self->session->user->isVisitor && !$self->isSubscribed; } #---------------------------------------------------------------------------- sub canUnsubscribe { my $self = shift; return !$self->session->user->isVisitor && $self->isSubscribed; } #---------------------------------------------------------------------------- sub createSubscriptionGroup { my $self = shift; if ( my $groupId = $self->get('subscriptionGroupId') ) { return WebGUI::Group->new( $self->session, $groupId ); } else { my $group = WebGUI::Group->new($self->session, "new"); $group->name( "Subscription " . $self->getTitle ); $group->description( "Subscription Group for " . $self->getTitle . "(" . $self->getId . ")" ); $group->isEditable( 0 ); $group->showInForms( 0 ); $group->deleteGroups( [ "3" ] ); # admins don't want to be auto subscribed to this thing $self->update({ subscriptionGroupId => $group->getId }); return $group; } } #---------------------------------------------------------------------------- sub isSubscribed { my $self = shift; my $user = shift || $self->session->user; my $db = $self->session->db; return $user->isInGroup( $self->getSubscriptionGroup->getId ); } #---------------------------------------------------------------------------- sub appendSubscriptionFormVars { my $self = shift; my $var = shift || {}; my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); # Setup form controls my $formHeader = WebGUI::Form::formHeader( $session, { action => $self->getUrl } ) . WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } ) ; my $subscribeButton = sprintf '', $i18n->get('subscribe'); my $unsubscribeButton = sprintf '', $i18n->get('unsubscribe'); my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } ); my $formFooter = WebGUI::Form::formFooter( $session ); # Compose default subscription form for current user my $form = ''; if ( $session->user->isRegistered ) { $form .= $subscribeButton if $self->canSubscribe; $form .= $unsubscribeButton if $self->canUnsubscribe; } elsif ( $self->get('allowAnonymousSubscription') ) { $form = $emailBox . $subscribeButton . $unsubscribeButton; } # Setup tmpl_vars $var->{ subscriptionForm_form } = "$formHeader $form $formFooter" if $form; $var->{ subscriptionForm_header } = $formHeader; $var->{ subscriptionForm_footer } = $formFooter; $var->{ subscriptionForm_subscribeButton } = $subscribeButton; $var->{ subscriptionForm_unsubscribeButton } = $unsubscribeButton; $var->{ subscrittionForm_emailBox } = $emailBox; $var->{ user_canSubscribe } = $self->canSubscribe; $var->{ user_canUnsubscribe } = $self->canUnsubscribe; $var->{ user_isRegistered } = $session->user->isRegistered; return $var; } #---------------------------------------------------------------------------- sub getSubscriptionGroup { my $self = shift; my $groupId = $self->get( "subscriptionGroupId" ); my $group = $groupId ? WebGUI::Group->new( $self->session, $groupId ) : $self->createSubscriptionGroup ; return $group; } #---------------------------------------------------------------------------- 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. my ( $path ) = URI->new( $referer )->path =~ m{ ^/ (.*?) /?$ }xms; return $referer if WebGUI::Asset->urlExists( $self->session, $path ); return; } #---------------------------------------------------------------------------- sub getEmailVars { my $self = shift; my $user = shift; my $var = {}; my $userProperties = $user->get; while ( my ($key, $value) = each %{ $userProperties } ) { $var->{ "user_$key" } = $value; } $var->{ user_isRegular } = !WebGUI::User::SpecialState->isAdHocUser( $user ); my $assetProperties = $self->get; while ( my ($key, $value) = each %{ $assetProperties } ) { $var->{ "asset_$key" } = $value; } 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; my $user = shift; my $code = shift; my $action = shift || 'subscribe'; my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); my $var = $self->getEmailVars( $user ); my $url = $session->url->getSiteURL . $self->getUrl( "func=confirmMutation;code=$code" ); $var->{ confirmUrl } = $url; $var->{ code } = $code; $var->{ actionIsSubscribe } = $action eq 'subscribe'; my $mail = WebGUI::Mail::Send->create( $self->session, { 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 ) { 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]" ); $mail->addText( sprintf $i18n->get( 'click to confirm fallback' ), $url ); } $mail->send; return; } #---------------------------------------------------------------------------- sub sendNoMutationEmail { my $self = shift; my $user = shift; my $action = shift || 'subscribe'; my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); my $var = $self->getEmailVars( $user ); $var->{ actionIsSubscribe } = $action eq 'subscribe'; my $mail = WebGUI::Mail::Send->create( $self->session, { to => $user->get('email'), subject => $self->get('noMutationEmailSubject'), contentType => 'multipart/alternative', } ); my $templateId = $self->get('noMutationEmailTemplateId'); my $template = WebGUI::Asset::Template->new( $session, $templateId ); if ( $template ) { my $content = $template->process( $var ); $mail->addHtml( $content ); $mail->addText( $self->transformToText( $content ) ); } else { $session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" ); if ( $action eq 'subscribe' ) { $mail->addText( sprintf $i18n->get('already subscribed fallback'), $self->get('title') ); } } $mail->send; 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; my $code = shift || return; my $session = $self->session; my $db = $session->db; $db->write( ' update assetAspectSubscriber_log set ' .' confirmationIp=?, confirmationDate=?, confirmed=? where code=? and assetId=?', [ $session->env->getIp, time(), 1, $code, $self->getId, ] ); return; }; #---------------------------------------------------------------------------- sub logRequest { my $self = shift; my $type = shift || croak 'No type passed to logrequest'; my $user = shift || croak 'No user passed to logRequest'; my $code = shift; my $session = $self->session; my $db = $session->db; $db->write( ' insert into assetAspectSubscriber_log set ' .' assetId=?, requestIp=?, requestDate=?, code=?, confirmed=?, anonymous=?, type=?, userId=?, email=?', [ $self->getId, $session->env->getIp, time(), $code, 0, $self->session->user->isVisitor, $type, $user->getId, $user->get('email'), ] ); return; }; #---------------------------------------------------------------------------- sub subscribe { my $self = shift; my $user = shift || $self->session->user; my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); my $session = $self->session; if ( $requireConfirm ) { if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) { $self->sendNoMutationEmail( $user, 'subscribe' ); $self->logRequest( 'already_subscribed', $user ); } else { my $code = $self->session->id->generate; $self->logRequest( 'subscribe', $user, $code ); $self->sendSubscriptionConfirmation( $user, $code, 'subscribe' ); } } else { $self->getSubscriptionGroup->addUsers( [ $user->getId ] ); $self->logRequest( 'subscribe', $user ); } return; } #---------------------------------------------------------------------------- sub unsubscribe { my $self = shift; my $user = shift || $self->session->user; my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); my $session = $self->session; if ( $requireConfirm ) { if ( !$user->isInGroup( $self->getSubscriptionGroup->getId ) ) { $self->sendNoMutationEmail( $user, 'unsubscribe' ); $self->logRequest( 'already_unsubscribed', $user ); } else { my $code = $self->session->id->generate; $self->logRequest( 'unsubscribe', $user, $code ); $self->sendSubscriptionConfirmation( $user, $code, 'unsubscribe' ); } } else { $self->getSubscriptionGroup->deleteUsers( [ $user->getId ] ); $self->logRequest( 'unsubscribe', $user ); } return; } #---------------------------------------------------------------------------- sub www_confirmMutation { my $self = shift; my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); my ($form, $db) = $session->quick( 'form', 'db' ); my $code = $form->get('code'); return unless $code; my ($userId, $type) = $db->quickArray( 'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?', [ 0, $code, ] ); if ( $userId ) { $self->logConfirmation( $code ); if ( $type eq 'subscribe' ) { $self->getSubscriptionGroup->addUsers( [ $userId ] ); return $self->processStyle( sprintf $i18n->get( 'subscription successful'), $self->getUrl ); } elsif ( $type eq 'unsubscribe' ) { $self->getSubscriptionGroup->deleteUsers( [ $userId ] ); return $self->processStyle( sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl ); } } return $self->processStyle( $i18n->get( 'wrong code' ) ); } #---------------------------------------------------------------------------- sub subscribeAnonymous { my $self = shift; my $email = shift; # TODO || return ? my $session = $self->session; my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); # If email address doesn't have an account, create one. if ( !defined $emailUser ) { $emailUser = WebGUI::User::SpecialState->create( $session ); $emailUser->update( { email => $email } ); } $emailUser->addSpecialState( 'Subscriber', $self->getId ); $self->subscribe( $emailUser, 1 ); return; } #---------------------------------------------------------------------------- sub unsubscribeAnonymous { my $self = shift; my $email = shift; my $session = $self->session; my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); if ( defined $emailUser ) { $self->unsubscribe( $emailUser, 1 ); } return; } #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; my $session = $self->session; my $form = $session->form; my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); my $action = $form->get( 'action' ); return unless $action eq 'subscribe' || $action eq 'unsubscribe'; if ( $session->user->isRegistered ) { if ( $action eq 'subscribe' && $self->canSubscribe ) { $self->subscribe; } if ( $action eq 'unsubscribe' && $self->canUnsubscribe ) { $self->unsubscribe; } return unless $self->get('alwaysConfirmSubscription'); } elsif ( $self->get('allowAnonymousSubscription') ) { my $email = $form->email( 'email' ); return 'Error: no email address passed' unless $email; given ( $action ) { when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); } when ( 'subscribe' ) { $self->subscribeAnonymous( $email ); } } } else { return $self->processStyle( $i18n->get( 'anonnymous not allowed' ) ); } my $var = { assetUrl => $self->getUrl, returnUrl => $self->getReturnUrl, }; return $self->processStyle( $self->processTemplate( $var, $self->get('confirmationRequiredTemplateId') ) ); } #---------------------------------------------------------------------------- sub www_subscribe { my $self = shift; if ( $self->canSubscribe ) { $self->subscribe; } return $self->www_view; } #---------------------------------------------------------------------------- sub www_unsubscribe { my $self = shift; if ( $self->canUnsubscribe ) { $self->unsubscribe; } return $self->www_view; } 1;