package LATMOS::Accounts::Web::Controller::Services::Mailing; use Moose; use namespace::autoclean; use Email::MIME::Creator; use Email::Send (); 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->config->{features}{mailing}) { $c->go('/component_disabled'); return; } 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'); } if ($c->req->upload('attachment')) { $c->forward('attachment'); } } sub to :Private { my ( $self, $c ) = @_; } sub attachment :Private { my ( $self, $c ) = @_; my $upload = $c->req->upload('attachment'); my $attach = Email::MIME->create( attributes => { content_type => $upload->type, filename => $upload->filename, encoding => 'base64', name => $upload->filename,, }, body => $upload->slurp, ); push(@{$c->session->{mailing}{attachments}}, $attach); } 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, @{$c->session->{mailing}{attachments}} ], ); $email->header_set( Subject => $c->req->param('subject') ); $email->header_set( From => $from ); $c->stash->{receivers} = []; 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; push(@{ $c->stash->{receivers} }, $email_addr); my $to = sprintf( '%s <%s>', $obj->get_attributes('displayName'), $email_addr ); $email->header_set( To => $to ); my $sender = Email::Send->new({mailer => 'SMTP'}); $sender->send($email->as_string); } $c->session->{mailing}{subject} = ''; $c->session->{mailing}{body} = ''; $c->session->{mailing}{attachments} = []; $c->session->{to} = {}; } =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;