[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm lonmsg.pm lonsupportreq.pm
musolffc
musolffc at source.lon-capa.org
Mon Jun 22 22:42:35 EDT 2015
musolffc Tue Jun 23 02:42:35 2015 EDT
Modified files:
/loncom/interface lonmsg.pm loncommon.pm lonsupportreq.pm
Log:
New function to send email (with an attachment)
loncommon.pm contains &mime_email() to build and send emails using MIME::Lite. The
functionality is based on the previous code in lonsupportreq.pm. Now both
lonsupportreq.pm and lonmsg.pm call mime_email().
Files attached to LON-CAPA messages (normal or critical) will now be included in the
external email if the "Send copy to permanent e-mail address (if known)" option is
selected. Attachments were previously only sent internally and stripped from the
external email.
This should resolve bug #6723.
-------------- next part --------------
Index: loncom/interface/lonmsg.pm
diff -u loncom/interface/lonmsg.pm:1.241 loncom/interface/lonmsg.pm:1.242
--- loncom/interface/lonmsg.pm:1.241 Thu Jun 18 23:02:48 2015
+++ loncom/interface/lonmsg.pm Tue Jun 23 02:42:34 2015
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines for messaging
#
-# $Id: lonmsg.pm,v 1.241 2015/06/18 23:02:48 musolffc Exp $
+# $Id: lonmsg.pm,v 1.242 2015/06/23 02:42:34 musolffc Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -200,9 +200,9 @@
use strict;
use Apache::lonnet;
+use Apache::loncommon;
use HTML::TokeParser();
use Apache::lonlocal;
-use Mail::Send;
use HTML::Entities;
use Encode;
use LONCAPA qw(:DEFAULT :match);
@@ -421,7 +421,7 @@
sub sendemail {
- my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_;
+ my ($to,$subject,$body,$to_uname,$to_udom,$user_lh,$attachmenturl)=@_;
my $senderaddress='';
my $replytoaddress='';
my $msgsent;
@@ -457,19 +457,18 @@
"*** ".($senderaddress?&mt_user($user_lh,'You can reply to this e-mail'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ".
&mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body;
- my $msg = new Mail::Send;
- $msg->to($to);
- $msg->subject('[LON-CAPA] '.$subject);
- if ($replytoaddress) {
- $msg->add('Reply-to',$replytoaddress);
- }
- if ($senderaddress) {
- $msg->add('From',$senderaddress);
- }
- $msg->add('Content-type','text/plain; charset=UTF-8');
- if (my $fh = $msg->open()) {
- print $fh $body;
- $fh->close;
+ $attachmenturl = &Apache::lonnet::filelocation("",$attachmenturl);
+ my $filesize = (stat($attachmenturl))[7];
+ if ($filesize > 1048576) {
+ # Don't send if it exceeds 1 MB.
+ print '<p><span class="LC_error">'
+ .&mt('Email not sent. Attachment exceeds permitted length.')
+ .'</span><br /></p>';
+ } else {
+ # Otherwise build and send the email
+ $subject = '[LON-CAPA] '.$subject;
+ &Apache::loncommon::mime_email($senderaddress, $to, $subject, $body, ,'',
+ '', $attachmenturl, '', '');
$msgsent = 1;
}
return $msgsent;
@@ -478,7 +477,7 @@
# ==================================================== Send notification emails
sub sendnotification {
- my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_;
+ my ($to,$touname,$toudom,$subj,$crit,$text,$msgid,$attachmenturl)=@_;
my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
unless ($sender=~/\w/) {
$sender=$env{'user.name'}.':'.$env{'user.domain'};
@@ -562,7 +561,7 @@
}
$body = $bodybegin.$bodysubj.$sendtext.$bodyend;
}
- if (&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh)) {
+ if (&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh,$attachmenturl)) {
$numsent ++;
}
}
@@ -573,7 +572,7 @@
my $htmlfree = &make_htmlfree($text);
$body = $bodybegin.$bodysubj.$htmlfree.$bodyend;
}
- if (&sendemail($to,$subject,$body,$touname,$toudom,$user_lh)) {
+ if (&sendemail($to,$subject,$body,$touname,$toudom,$user_lh,$attachmenturl)) {
$numsent ++;
}
}
@@ -742,7 +741,7 @@
my $numperm = 0;
my $permlogmsgstatus;
if ($critnotify) {
- $numcrit = &sendnotification($critnotify,$user,$domain,$subject,1,$text,$msgid);
+ $numcrit = &sendnotification($critnotify,$user,$domain,$subject,1,$text,$msgid,$attachmenturl);
}
if ($toperm && $permemail) {
if ($critnotify && $numcrit) {
@@ -751,7 +750,7 @@
}
}
unless ($numperm) {
- $numperm = &sendnotification($permemail,$user,$domain,$subject,1,$text,$msgid);
+ $numperm = &sendnotification($permemail,$user,$domain,$subject,1,$text,$msgid,$attachmenturl);
}
}
if ($toperm) {
@@ -886,7 +885,7 @@
my $numperm = 0;
my $permlogmsgstatus;
if ($notify) {
- $numnotify = &sendnotification($notify,$user,$domain,$subject,0,$text,$msgid);
+ $numnotify = &sendnotification($notify,$user,$domain,$subject,0,$text,$msgid,$attachmenturl);
}
if ($toperm && $permemail) {
if ($notify && $numnotify) {
@@ -896,7 +895,7 @@
}
unless ($numperm) {
$numperm = &sendnotification($permemail,$user,$domain,$subject,0,
- $text,$msgid);
+ $text,$msgid,$attachmenturl);
}
}
if ($toperm) {
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1222 loncom/interface/loncommon.pm:1.1223
--- loncom/interface/loncommon.pm:1.1222 Tue Jun 9 21:22:56 2015
+++ loncom/interface/loncommon.pm Tue Jun 23 02:42:34 2015
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1222 2015/06/09 21:22:56 damieng Exp $
+# $Id: loncommon.pm,v 1.1223 2015/06/23 02:42:34 musolffc Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -79,6 +79,8 @@
use Captcha::reCAPTCHA;
use Crypt::DES;
use DynaLoader; # for Crypt::DES version
+use MIME::Lite;
+use MIME::Types;
# ---------------------------------------------- Designs
use vars qw(%defaultdesign);
@@ -13851,6 +13853,85 @@
=pod
+=item * &mime_email()
+
+Sends an email with a possible attachment
+
+Inputs:
+
+=over 4
+
+from - Sender's email address
+
+to - Email address of recipient
+
+subject - Subject of email
+
+body - Body of email
+
+cc_string - Carbon copy email address
+
+bcc - Blind carbon copy email address
+
+type - File type of attachment
+
+attachment_path - Path of file to be attached
+
+file_name - Name of file to be attached
+
+attachment_text - The body of an attachment of type "TEXT"
+
+=back
+
+=back
+
+=cut
+
+############################################################
+############################################################
+
+sub mime_email {
+ my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
+ $file_name, $attachment_text) = @_;
+ my $msg = MIME::Lite->new(
+ From => $from,
+ To => $to,
+ Subject => $subject,
+ Type =>'TEXT',
+ Data => $body,
+ );
+ if ($cc_string ne '') {
+ $msg->add("Cc" => $cc_string);
+ }
+ if ($bcc ne '') {
+ $msg->add("Bcc" => $bcc);
+ }
+ $msg->attr("content-type" => "text/plain");
+ $msg->attr("content-type.charset" => "UTF-8");
+ # Attach file if given
+ if ($attachment_path) {
+ unless ($file_name) {
+ if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
+ }
+ my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
+ $msg->attach(Type => $type,
+ Path => $attachment_path,
+ Filename => $file_name
+ );
+ # Otherwise attach text if given
+ } elsif ($attachment_text) {
+ $msg->attach(Type => 'TEXT',
+ Data => $attachment_text);
+ }
+ # Send it
+ $msg->send('sendmail');
+}
+
+############################################################
+############################################################
+
+=pod
+
=head1 Course Catalog Routines
=over 4
Index: loncom/interface/lonsupportreq.pm
diff -u loncom/interface/lonsupportreq.pm:1.80 loncom/interface/lonsupportreq.pm:1.81
--- loncom/interface/lonsupportreq.pm:1.80 Thu Jun 18 20:19:06 2015
+++ loncom/interface/lonsupportreq.pm Tue Jun 23 02:42:34 2015
@@ -1,5 +1,5 @@
#
-# $Id: lonsupportreq.pm,v 1.80 2015/06/18 20:19:06 musolffc Exp $
+# $Id: lonsupportreq.pm,v 1.81 2015/06/23 02:42:34 musolffc Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,8 +27,6 @@
package Apache::lonsupportreq;
use strict;
-use MIME::Types;
-use MIME::Lite;
use CGI::Cookie();
use Apache::Constants qw(:common);
use Apache::loncommon();
@@ -880,33 +878,15 @@
}
}
- my $msg = MIME::Lite->new(
- From => $from,
- To => $to,
- Subject => $subject,
- Type =>'TEXT',
- Data => $supportmsg,
- );
+ my $cc_string;
if ($homeserver) {
if (@ok_ccs > 0) {
- my $cc_string = join(', ', at ok_ccs);
- $msg->add("Cc" => $cc_string);
+ $cc_string = join(', ', at ok_ccs);
}
}
- if ($bcc ne '') {
- $msg->add("Bcc" => $bcc);
- }
- $msg->attr("content-type" => "text/plain");
- $msg->attr("content-type.charset" => "UTF-8");
-
- if ($homeserver && $attachmentpath) {
- my ($type, $encoding) = MIME::Types::by_suffix($attachmentpath);
- $msg->attach(Type => $type,
- Path => $attachmentpath,
- Filename => $fname
- );
- } else {
+ my $attachment_text;
+ unless ($homeserver && $attachmentpath) {
my $envdata = '';
foreach my $var (@cookievars) {
$envdata .= "$var: $cookies{$var}\n";
@@ -920,12 +900,12 @@
foreach my $var (@loncvars) {
$envdata .= "$var: $env{$var}\n";
}
- $msg->attach(Type => 'TEXT',
- Data => $envdata);
+ $attachment_text = $envdata;
}
-
-### Send it:
- $msg->send('sendmail');
+
+ # Compose and send a MIME email
+ &Apache::loncommon::mime_email($from, $to, $subject, $supportmsg, $cc_string, $bcc,
+ $attachmentpath, $fname, $attachment_text);
if ($attachmentpath =~ m|$Apache::lonnet::perlvar{'lonDaemons'}/tmp/helprequests/(\d+)/[^/]+|) {
unlink($attachmentpath);
More information about the LON-CAPA-cvs
mailing list