source: trunk/LATMOS-Accounts-Web/lib/LATMOS/Accounts/Web/Controller/Services/Mailing.pm @ 1135

package LATMOS::Accounts::Web::Controller::Services::Mailing;
use Moose;
use namespace::autoclean;
use Email::MIME::Creator;
use Email::Sender::Simple qw(sendmail);
use Email::Sender::Transport::SMTP::Persistent qw();


BEGIN { extends 'Catalyst::Controller'; }

=head1 NAME

LATMOS::Accounts::Web::Controller::Services::Mailing - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut


=head2 index

=cut

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    if ($c->req->param('sto')) {
        $c->session->{mailing}{subject} = $c->req->param('subject');
        $c->session->{mailing}{body} = $c->req->param('body');
        $c->go('to');
    }
    if ($c->req->param('add_to')) {
        $c->go('to');
    }
    if ($c->req->param('remove_to')) {
        $c->go('to');
    }

    if ($c->req->param('send')) {
        $c->go('send');
    }
}

sub to :Private {
    my ( $self, $c ) = @_;
}

sub filter :Local {
    my ( $self, $c ) = @_;
    for ($c->req->param('filter') || '') {
    /^dpmt/ and do {
        $c->req->params->{attr} = [ qw(sutype) ];
        $c->req->params->{attrval} = [ qw(dpmt) ];
        $c->go('/ajax/select_objects_list', [ 'group', ]);
        last;
    };
    /^quick$/ and do {
        $c->go('/ajax/services/mailing/quick_input', [ ]);
        last; 
    };

    # Else
    $c->go('/ajax/attrvalues', [ 'user', $_ ]);
    }
}

sub send :Private {
    my ( $self, $c ) = @_;

    my $from = $c->model('Accounts')->base->get_object(
        'user', $c->user->username
    )->get_attributes('mail');

    my $bodypart = Email::MIME->create(
        attributes => {
            content_type => 'text/plain',
            disposition  => 'attachment',
            charset      => 'utf-8',
            encoding     => '8bit',
        },
        body => $c->req->param('body'),
    );

    my $email = Email::MIME->create(
        header_str => [
            From => $from,
        ],
        attributes => {
            charset      => 'utf-8',
        },
        parts      => [ $bodypart ],
    );
    $email->header_set( Subject => $c->req->param('subject') );

    warn $email->as_string;
    foreach (sort (keys %{ $c->session->{to} })) {
        my $obj = $c->model('Accounts')->base->get_object(
            'user', $_
        ) or next;
        my $email_addr = $obj->get_attributes('mail') or next;
        my $to = sprintf(
            '%s <%s>',
            $obj->get_attributes('displayName'),
            $email_addr
        );
        $email->header_set( To => $to );
        sendmail(
            $email,
            {
                from => $from,
                transport => Email::Sender::Transport::SMTP::Persistent->new({
                        host => 'localhost',
                        port => 25,
                })
            }
        );
    }

}

=head1 AUTHOR

olivier

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

__PACKAGE__->meta->make_immutable;

1;