webgui_newsletter/lib/WebGUI/Mailing/Email.pm

package WebGUI::Mailing::Email;

use strict;
use warnings;

use HTML::TreeBuilder;

use base 'WebGUI::Crud';

sub crud_definition {
    my $class   = shift;
    my $session = shift;

    my $definition = $class->SUPER::crud_definition( $session );

    $definition->{ tableName    } = 'WGMailing_queue';
    $definition->{ tableKey     } = 'mailId';
    $definition->{ sequenceKey  } = 'mailingId';

    my %properties = (
        mailingId       => {
            fieldType       => 'guid',
        },
        userId          => {
            fieldType       => 'guid',
        },
        recipientEmail  => {
            fieldType       => 'email',
            defaultValue    => undef,
        },
        status          => {
            fieldType       => 'text',
            defaultValue    => 'queued',    # Allowed are: 'queued', 'sent', 'error', 'bounced'
        },
        errorMessage    => {
            fieldType       => 'text',
            defaultValue    => undef,
        },
        isTest          => {
            fieldType       => 'yesNo',
            defaultValue    => 1,           # For safety: explicitly turn this off to send real emails
        },
        sendDate        => {
            fieldType       => 'dateTime',
        },
        sentTo          => {
            fieldType       => 'text',
        },
        bounceReason    => {
            fieldType       => 'text',
        },
    );

    $definition->{ properties } = { 
        %{ $definition->{ properties } || {} },
        %properties,
    };

    return $definition;
}

sub getMailing {
    my $self = shift;
    my $session = $self->session;

    my $mailing = WebGUI::Mailing->new( $session, $self->get('mailingId') );
    #### TODO: error checking;
    return $mailing;
}

sub getQueuedTestEmails {
    my $class   = shift;
    my $session = shift;

    my $it = $class->getAllIterator( $session, {
        constraints => [
            { 'isTest=?'    => [ 1 ]        },
            { 'status=?'    => [ 'queued' ] },
        ],
    } );

    return $it;
}

sub getQueued {
    my $class       = shift;
    my $session     = shift;
    my $mailingId   = shift;

    my $it = $class->getAllIterator( $session, {
        constraints => [
            { 'mailingId=?'     => [ $mailingId  ] },
            { 'isTest=?'        => [ 0           ] },
            { 'status=?'        => [ 'queued'    ] },
        ],
    } );

    return $it;
}

sub error {
    my $self    = shift;
    my $message = shift;

    $self->update( {
        status          => 'error',
        errorMessage    => $message || 'No error message available',
    } );

    return;
}

sub absolutifyURIs {
    my $self    = shift;
    my $content = shift;
    my $pageUrl = shift;
    my $siteUrl = $self->session->url->getSiteURL;

    my $tb      = HTML::TreeBuilder->new;
    my $root    = $tb->parse( $content );

    foreach my $link ( @{ $root->extract_links } ) { 
        my ($uri, $element, $attr, $tag) = @{ $link };
        
        if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) {
            my $new = 
                    ( $uri =~ m{ ^ / }xmsi )        # Is url absolute?
                    ? $siteUrl . $uri
                    : $siteUrl . $pageUrl . '/' . $uri
                    ;
            
            # replace attribute
            $element->attr( $attr, $new );
        }
    } 

    return $tb->as_HTML;
}

sub send {
    my $self    = shift;
    my $session = $self->session;
    my $id      = $session->id;

    #### TODO: Error checking
    my $mailing = $self->getMailing;
    my $configuration = $mailing->get('configuration') || {};
    my $asset   = $mailing->getAsset;
    my $content = $asset->processContentAsUser( $mailing->get('issueId'), $self->get('userId'), $configuration );
    my $body    = $self->absolutifyURIs( $content, $asset->getUrl );

    # Mail is a test mail but there is noone to send the result to
    if ( $self->get( 'isTest' ) && !$self->get('recipientEmail') ) {
        $self->error( 'Cannot send test mails without an override reciepint address' );

        return;
    }

    # Determine recipients email address and bail out if we can't find one.
    my $to  = $self->get('recipientEmail') || $self->user->get('email');
    if ( !$to ) {
        $self->error( 'Cannot find an email address for this user' );
        return;
    }

    # Check bounce score
    my $bounceScoreOk = WebGUI::Mailing::Bounce->new( $session )->bounceScoreOk( $to );
    if ( !$self->get( 'isTest' ) && !$bounceScoreOk ) {
        $self->update( { 
            status          => 'skipped',
            sendDate        => time,
            errorMessage    => "Bounce score for $to too high",
        } );

        return;
    }

    # Fetch subject
    my $subject   = $asset->getSubject( $configuration );

    my $messageId = $id->toHex( $self->getId );
    my $domain    = $session->setting->get( 'newsletterReturnDomain' );

    # Setup email
    my $mail = WebGUI::Mail::Send->create( $session, {
#        from        => 'martin@geefmegeld.nl',
        to          => $to,
        subject     => $subject,
        messageId   => "$messageId\@$domain",
        returnPath  => "$messageId-bounce\@$domain",
    } );
    $mail->addHtml( $body );

    # 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( { 
            status      => 'sent',
            sendDate    => time,
            sentTo      => $to,
        } );
    }

    return;
}

sub user {
    my $self    = shift;
    my $session = $self->session;

    my $user = WebGUI::User->new( $session, $self->get('userId') );
    return $user;
}

sub registerBounced {
    my $self    = shift;
    my $reason  = shift;
    my $message = shift;

    $self->update( {
        status          => 'bounced',
        errorMessage    => $message,
        bounceReason    => $reason,
    } );

    #### TODO: Write to bounce log

    return;
}

1;