# The LearningOnline Network with CAPA
# Sending messages
#
# $Id: lonnotify.pm,v 1.25 2006/11/01 22:22:31 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::lonnotify;
use strict;
use Apache::lonnet;
use Apache::loncommon;
use Apache::courseclassifier;
use LONCAPA::Enrollment;
use Apache::Constants qw(:common :http);
use Apache::lonlocal;
use Mail::Send;
use HTML::TokeParser;
use HTML::Entities;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
sub handler {
my ($r) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if ($r->header_only) {
return OK;
}
my $cdom = $env{'request.role.domain'};
unless (&Apache::lonnet::allowed('psa',$cdom)) {
# Not allowed to broadcast e-mail system-wide
$env{'user.error.msg'}="/adm/notify:psa:0:0:Cannot broadcast e-mail systemwide";
return HTTP_NOT_ACCEPTABLE;
}
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['command']);
my $command = $env{'form.command'};
my $origin = $env{'form.origin'};
&Apache::lonhtmlcommon::clear_breadcrumbs();
&Apache::lonhtmlcommon::add_breadcrumb
({href=>'/adm/notify',
text=>"Broadcast E-mail"});
if ($command eq 'process') {
&print_request_receipt($r,$command,$cdom);
} elsif ($command eq 'compose') {
&print_composition_form($r,$command,$cdom);
} elsif ($command eq 'pick_target') {
&print_selection_form($r,$command,$cdom);
} elsif ($command eq 'pick_display') {
&print_display_option_form($r,$command,$cdom);
} elsif ($command eq 'display') {
&print_display($r,$command,$cdom);
} else {
&print_front_page($r,'front',$cdom);
}
return OK;
}
sub add_script {
my ($js) = @_;
return '';
}
sub start_page {
my ($jscript,$bread_title,$formname) = @_;
my $loadcode;
if ((defined($env{'form.origin'}))
&& ($env{'form.command'} eq 'compose'
|| $env{'form.command'} eq 'pick_target'
|| $env{'form.command'} eq 'pick_display')) {
if ($env{'form.origin'} ne '') {
$loadcode = 'javascript:setFormElements(document.'.$env{'form.command'}.')';
if (($env{'form.command'} eq 'pick_target')
&& (($env{'form.origin'} eq 'compose')
|| ($env{'form.origin'} eq 'process'))) {
if ($env{'form.coursepick'} eq 'category') {
$loadcode .= ';javascript:setCourseCat(document.'.$env{'form.command'}.')';
}
}
}
}
my $start_page =
&Apache::loncommon::start_page('Broadcast e-mail to users', $jscript,
{'add_entries' =>
{'onload' => $loadcode,},});
my $breadcrumbs =
&Apache::lonhtmlcommon::breadcrumbs($bread_title,
'Broadcast_system_email');
my $output = <<"ENDONE";
$start_page
$breadcrumbs
'.&Apache::loncommon::end_page();
}
sub print_front_page {
my ($r,$formname,$cdom) = @_;
my $jscript = qq|
function next_page(caller) {
if (caller == 'view') {
document.front.command.value="pick_display"
}
else {
document.front.command.value="pick_target"
}
document.front.submit()
}
|;
my $output = &start_page(&add_script($jscript),
'Broadcast e-mail to Domain', $formname);
$output .= '';
$output .= '
';
foreach my $person (@deliveries) {
my ($username,$email) = split(/:/,$person);
$output .= &unescape($email).' ('.&unescape($username).') '."\n";
}
$output .= '
'.
&Apache::loncommon::end_data_table_row().
&Apache::loncommon::end_data_table();
} else {
$output .= 'No mail sent - no recipients identified';
}
$output .= ' Send another message?'."\n";
$output .= ''."\n".
''."\n";
$output .= &Apache::lonhtmlcommon::echo_form_input(['command','origin']);
$output .= &end_page();
$r->print($output);
return;
}
sub broadcast_email {
my ($recipients,$subject,$from,$message,$deliveries)=@_;
# Should implement staggered delivery for large numbers of recipients?.
foreach my $user (@{$recipients}) {
my $msg = new Mail::Send;
my ($username,$to) = split(/:/,$user);
$username = &unescape($username);
$to = &unescape($to);
$msg->to($to);
$msg->subject($subject);
$msg->add('From',"$from");
if (my $fh = $msg->open()) {
print $fh $message;
$fh->close;
push(@{$deliveries},$user);
}
}
}
sub get_user_info {
my ($user,%email_defaults) = @_;
my ($uname,$udom) = split(/:/,$user);
my @emailtypes = ('permanentemail','critnotification','notification');
my %userinfo = &Apache::loncommon::getemails($uname,$udom);
my $email = '';
foreach my $type (@emailtypes) {
$email = $userinfo{$type};
if ($email =~ /\@/) {
last;
}
}
if ($email eq '') {
my $authinfo = &Apache::lonnet::queryauthenticate($uname,$udom);
my ($authtype,$autharg) = split(/:/,$authinfo);
if ($authtype =~ /^krb/) {
if (defined($email_defaults{$authtype}{$autharg})) {
$email = $uname.'@'.$email_defaults{$authtype}{$autharg};
}
} else {
if ((defined($email_defaults{$authtype})) && ($email_defaults{$authtype} ne '')) {
$email = $uname.'@'.$email_defaults{$authtype};
}
}
}
return $email;
}
sub form_elements {
my ($longtypes,$authtypes) = @_;
%{$longtypes} = (
active => 'Currently has access',
previous => 'Previously had access',
future => 'Will have future access',
);
%{$authtypes} = (
krb4 => 'Kerberos 4',
krb5 => 'Kerberos 5',
internal => 'Internal (LON-CAPA)',
unix => 'Filesystem (UNIX)',
local => 'Local/Customized',
);
return;
}
sub store_mail {
my ($subject,$message,$domain,$recipients,$attachmenturl) = @_;
my $msgid;
($msgid,$message) = &Apache::lonmsg::packagemsg($subject,$message,undef,undef,
$attachmenturl,$recipients,undef,undef,'dcmail');
# Store in dc email db files on primary library server for domain.
my $server = $Apache::lonnet::domain_primary{$domain};
if (defined($server)) {
unless (&Apache::lonnet::dcmailput($domain,$msgid,$message,$server)
eq 'ok') {
&Apache::lonnet::logthis('Storage of dc mail failed for domain'.
$domain.' for server: '. $server.'. Message ID was '.$msgid);
}
} else {
&Apache::lonnet::logthis('Storage of dc mail failed for domain'.
$domain.' as no primary server identified. Message ID was '.$msgid);
}
}
sub cr_to_br {
my $incoming = shift;
$incoming =~ s/\n/\ /g;
return $incoming;
}
1;