loncom/interface/lonmsg.pm - diff

Return to lonmsg.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmsg.pm between versions 1.214.2.5 and 1.221

version 1.214.2.5, 2009/01/05 20:08:25	version 1.221, 2009/01/05 20:04:40
Line 53 with <recipient username="$uname:$udom">	Line 53 with <recipient username="$uname:$udom">
Domain Coordinator e-mail for the storage of information about	Domain Coordinator e-mail for the storage of information about
recipients of the message/e-mail.	recipients of the message/e-mail.

=head1 FUNCTIONS	=head1 SUBROUTINES

=over 4	=over

	=pod

	=item packagemsg()

	Package

	=item get_course_context()

	=item unpackagemsg()

	Unpack message into a hash

	=item buildmsgid()

	Get info out of msgid

	=item unpackmsgid()

	=item sendemail()

	=item sendnotification()

	Send notification emails

	=item newmail()

	Check for email

	=item author_res_msg()

	Automated message to the author of a resource

	=item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
	of the resource with the URI $filename.

	=item retrieve_author_res_msg()

	Retrieve author resource messages

	=item del_url_author_res_msg()

	Delete all author messages related to one URL

	=item clear_author_res_msg()

	Clear out all author messages in URL path

	=item all_url_author_res_msg()

	Return hash with URLs for which there is a resource message

	=item store_instructor_comment()

	Add a comment to the User Notes screen

	=item user_crit_msg_raw()

	Critical message to a user

	=item user_crit_msg()

	New routine that respects "forward" and calls old routine

	=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>:
	Sends a critical message $message to the $user at $domain. If $sendback
	is true, a receipt will be sent to the current user when $user receives
	the message.

	Additionally it will check if the user has a Forwarding address
	set, and send the message to that address instead

	returns
	- in array context a list of results for each message that was sent
	- in scalar context a space seperated list of results for each
	message sent


	=item user_crit_received()

	Critical message received

	=item user_normal_msg_raw()

	Normal communication

	=item user_normal_msg()

	New routine that respects "forward" and calls old routine

	=item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
	$baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle,
	$error,$nosentstore,$recipid)>:
	Sends a message to the $user at $domain, with subject $subject and message $message.

	Additionally it will check if the user has a Forwarding address
	set, and send the message to that address instead

	returns
	- in array context a list of results for each message that was sent
	- in scalar context a space seperated list of results for each
	message sent

	=item store_sent_mail()

	=item store_recipients()

	=item foldersuffix()

	=item get_user_folders()

	User-defined folders

	=item secapply()

	=item B<decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag)>:

	Arguments
	$feedurl - /res/ url of resource (only need if $author is true)
	$author,$question,$course,$policy - all true/false parameters
	if true will attempt to find the addresses of user that should receive
	this type of feedback (author - feedback to author of resource $feedurl,
	$question 'Resource Content Questions', $course 'Course Content Question',
	$policy 'Course Policy')
	(Additionally it also checks $env for whether the corresponding form.<name>
	element exists, for ease of use in a html response context)

	$defaultflag - (internal should be left blank) if true gather addresses
	that aren't for a section even if I have a section
	(used for reccursion internally, first we look for
	addresses for our specific section then we recurse
	and look for non section addresses)

	Returns
	$typestyle - string of html text, describing what addresses were found
	%to - a hash, which keys are addresses of users to send messages to
	the keys will look like name:domain

	=item user_lang()

	=back

=cut	=cut

Line 74 use LONCAPA qw(:DEFAULT :match);	Line 215 use LONCAPA qw(:DEFAULT :match);
}	}
}	}

# ===================================================================== Package

sub packagemsg {	sub packagemsg {
my ($subject,$message,$citation,$baseurl,$attachmenturl,	my ($subject,$message,$citation,$baseurl,$attachmenturl,
Line 83 sub packagemsg {	Line 224 sub packagemsg {
$citation=&HTML::Entities::encode($citation,'<>&"');	$citation=&HTML::Entities::encode($citation,'<>&"');
$subject =&HTML::Entities::encode($subject,'<>&"');	$subject =&HTML::Entities::encode($subject,'<>&"');
#remove machine specification	#remove machine specification
$baseurl =~ s\|^https?\://[^/]+/\|/\|;	$baseurl =~ s\|^https?://[^/]+/\|/\|;
$baseurl =&HTML::Entities::encode($baseurl,'<>&"');	$baseurl =&HTML::Entities::encode($baseurl,'<>&"');
#remove machine specification	#remove machine specification
$attachmenturl =~ s\|^https?\://[^/]+/\|/\|;	$attachmenturl =~ s\|^https?://[^/]+/\|/\|;
$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');	$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
my $course_context = &get_course_context();	my $course_context = &get_course_context();
my $now=time;	my $now=time;
Line 209 sub get_course_context {	Line 350 sub get_course_context {
return $course_context;	return $course_context;
}	}

# ================================================== Unpack message into a hash

sub unpackagemsg {	sub unpackagemsg {
my ($message,$notoken,$noattachmentlink)=@_;	my ($message,$notoken,$noattachmentlink)=@_;
Line 247 sub unpackagemsg {	Line 387 sub unpackagemsg {
return %content;	return %content;
}	}

# ======================================================= Get info out of msgid

sub buildmsgid {	sub buildmsgid {
my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;	my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
Line 306 sub sendemail {	Line 445 sub sendemail {
%senderemails=&Apache::loncommon::getemails();	%senderemails=&Apache::loncommon::getemails();
}	}
foreach my $type ('permanentemail','critnotification','notification') {	foreach my $type ('permanentemail','critnotification','notification') {
if ($senderemails{$type}) {	if ($senderemails{$type}) {
($senderaddress) = split(/,/,$senderemails{$type});	($senderaddress) = split(/,/,$senderemails{$type});
last if ($senderaddress);	last if ($senderaddress);
}	}
}	}
}	}
$body=	$body=
"*** ".&mt_user($user_lh,'This is an automatic message generated by the LON-CAPA system.')."\n".	"*** ".&mt_user($user_lh,'This is an automatic e-mail generated by the LON-CAPA system.')."\n".
"* ".($senderaddress?&mt_user($user_lh,'You can reply to this message'):&mt_user($user_lh,'Please do not reply to this address.')."\n* ".	"* ".($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;	&mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body;
my $msg = new Mail::Send;	my $msg = new Mail::Send;
$msg->to($to);	$msg->to($to);
$msg->subject('[LON-CAPA] '.$subject);	$msg->subject('[LON-CAPA] '.$subject);
if ($replytoaddress) {	if ($replytoaddress) {
$msg->add('Reply-to',$replytoaddress);	$msg->add('Reply-to',$replytoaddress);
}	}
if ($senderaddress) {	if ($senderaddress) {
$msg->add('From',$senderaddress);	$msg->add('From',$senderaddress);
}	}
if (my $fh = $msg->open()) {	if (my $fh = $msg->open()) {
print $fh $body;	print $fh $body;
Line 422 to access the full message.',$url);	Line 561 to access the full message.',$url);
&sendemail($to,$subject,$body,$touname,$toudom,$user_lh);	&sendemail($to,$subject,$body,$touname,$toudom,$user_lh);
}	}
}	}
# ============================================================= Check for email

sub newmail {	sub newmail {
if ((time-$env{'user.mailcheck.time'})>300) {	if ((time-$env{'user.mailcheck.time'})>300) {
Line 433 sub newmail {	Line 572 sub newmail {
return 0;	return 0;
}	}

# =============================== Automated message to the author of a resource

=pod

=item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
of the resource with the URI $filename.

=cut

sub author_res_msg {	sub author_res_msg {
my ($filename,$message)=@_;	my ($filename,$message)=@_;
Line 462 sub author_res_msg {	Line 594 sub author_res_msg {
return 'no_host';	return 'no_host';
}	}

# =========================================== Retrieve author resource messages

sub retrieve_author_res_msg {	sub retrieve_author_res_msg {
my $url=shift;	my $url=shift;
Line 482 sub retrieve_author_res_msg {	Line 614 sub retrieve_author_res_msg {
}	}


# =============================== Delete all author messages related to one URL


sub del_url_author_res_msg {	sub del_url_author_res_msg {
my $url=shift;	my $url=shift;
Line 496 sub del_url_author_res_msg {	Line 629 sub del_url_author_res_msg {
}	}
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);	return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
}	}
# =================================== Clear out all author messages in URL path

sub clear_author_res_msg {	sub clear_author_res_msg {
my $url=shift;	my $url=shift;
Line 510 sub clear_author_res_msg {	Line 643 sub clear_author_res_msg {
}	}
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);	return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
}	}
# ================= Return hash with URLs for which there is a resource message


sub all_url_author_res_msg {	sub all_url_author_res_msg {
my ($author,$domain)=@_;	my ($author,$domain)=@_;
Line 522 sub all_url_author_res_msg {	Line 656 sub all_url_author_res_msg {
return %returnhash;	return %returnhash;
}	}

# ====================================== Add a comment to the User Notes screen

sub store_instructor_comment {	sub store_instructor_comment {
my ($msg,$uname,$udom) = @_;	my ($msg,$uname,$udom) = @_;
Line 537 sub store_instructor_comment {	Line 670 sub store_instructor_comment {
return $result;	return $result;
}	}

# ================================================== Critical message to a user

sub user_crit_msg_raw {	sub user_crit_msg_raw {
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,	my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
Line 591 sub user_crit_msg_raw {	Line 723 sub user_crit_msg_raw {
return $status;	return $status;
}	}

# New routine that respects "forward" and calls old routine

=pod

=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>:
Sends a critical message $message to the $user at $domain. If $sendback
is true, a receipt will be sent to the current user when $user receives
the message.

Additionally it will check if the user has a Forwarding address
set, and send the message to that address instead

returns
- in array context a list of results for each message that was sent
- in scalar context a space seperated list of results for each
message sent

=cut

sub user_crit_msg {	sub user_crit_msg {
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,	my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
Line 637 sub user_crit_msg {	Line 752 sub user_crit_msg {
return join(' ',@status);	return join(' ',@status);
}	}

# =================================================== Critical message received

sub user_crit_received {	sub user_crit_received {
my $msgid=shift;	my $msgid=shift;
Line 673 sub user_crit_received {	Line 787 sub user_crit_received {
return $status;	return $status;
}	}

# ======================================================== Normal communication


sub user_normal_msg_raw {	sub user_normal_msg_raw {
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,	my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
Line 734 sub user_normal_msg_raw {	Line 849 sub user_normal_msg_raw {
return $status;	return $status;
}	}

# New routine that respects "forward" and calls old routine

=pod

=item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
$baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle,
$error,$nosentstore,$recipid)>:
Sends a message to the $user at $domain, with subject $subject and message $message.

Additionally it will check if the user has a Forwarding address
set, and send the message to that address instead

returns
- in array context a list of results for each message that was sent
- in scalar context a space seperated list of results for each
message sent

=cut

sub user_normal_msg {	sub user_normal_msg {
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,	my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
$toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_;	$toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_;
Line 836 sub store_recipients {	Line 932 sub store_recipients {
}	}
}	}

# =============================================================== Folder suffix

sub foldersuffix {	sub foldersuffix {
my $folder=shift;	my $folder=shift;
Line 851 sub foldersuffix {	Line 946 sub foldersuffix {
return $suffix;	return $suffix;
}	}

# ========================================================= User-defined folders

sub get_user_folders {	sub get_user_folders {
my ($folder) = @_;	my ($folder) = @_;
Line 892 sub secapply {	Line 986 sub secapply {
return '';	return '';
}	}

=pod

=item * B<decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag)>:

Arguments
$feedurl - /res/ url of resource (only need if $author is true)
$author,$question,$course,$policy - all true/false parameters
if true will attempt to find the addresses of user that should receive
this type of feedback (author - feedback to author of resource $feedurl,
$question 'Resource Content Questions', $course 'Course Content Question',
$policy 'Course Policy')
(Additionally it also checks $env for whether the corresponding form.<name>
element exists, for ease of use in a html response context)

$defaultflag - (internal should be left blank) if true gather addresses
that aren't for a section even if I have a section
(used for reccursion internally, first we look for
addresses for our specific section then we recurse
and look for non section addresses)

Returns
$typestyle - string of html text, describing what addresses were found
%to - a hash, which keys are addresses of users to send messages to
the keys will look like name:domain

=cut

sub decide_receiver {	sub decide_receiver {
my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;	my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
&Apache::lonenc::check_decrypt(\$feedurl);	&Apache::lonenc::check_decrypt(\$feedurl);
Line 967 sub user_lang {	Line 1034 sub user_lang {
} else {	} else {
my %langhash = &Apache::loncommon::getlangs($touname,$toudom);	my %langhash = &Apache::loncommon::getlangs($touname,$toudom);
if ($langhash{'languages'} ne '') {	if ($langhash{'languages'} ne '') {
@userlangs = split(/\s(\,\|\;\|\:)\s/,$langhash{'languages'});	@userlangs = split(/\s(\,\|\;\|\:)\s/,$langhash{'languages'});
} else {	} else {
my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);	my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
if ($domdefs{'lang_def'} ne '') {	if ($domdefs{'lang_def'} ne '') {
Line 980 sub user_lang {	Line 1047 sub user_lang {
return $user_lh;	return $user_lh;
}	}

=pod

=back

=cut

1;	1;
__END__	__END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.214.2.5
changed lines
	Added in v.1.221