--- loncom/interface/lonmsg.pm 2008/12/23 19:27:33 1.214.2.3 +++ loncom/interface/lonmsg.pm 2008/11/19 17:38:26 1.215 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines for messaging # -# $Id: lonmsg.pm,v 1.214.2.3 2008/12/23 19:27:33 raeburn Exp $ +# $Id: lonmsg.pm,v 1.215 2008/11/19 17:38:26 jms Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,9 +53,150 @@ with Domain Coordinator e-mail for the storage of information about 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: 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: + 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: + 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: + +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. + 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 @@ -74,7 +215,7 @@ use LONCAPA qw(:DEFAULT :match); } } -# ===================================================================== Package + sub packagemsg { my ($subject,$message,$citation,$baseurl,$attachmenturl, @@ -83,10 +224,10 @@ sub packagemsg { $citation=&HTML::Entities::encode($citation,'<>&"'); $subject =&HTML::Entities::encode($subject,'<>&"'); #remove machine specification - $baseurl =~ s|^https?\://[^/]+/|/|; + $baseurl =~ s|^http://[^/]+/|/|; $baseurl =&HTML::Entities::encode($baseurl,'<>&"'); #remove machine specification - $attachmenturl =~ s|^https\://[^/]+/|/|; + $attachmenturl =~ s|^http://[^/]+/|/|; $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); my $course_context = &get_course_context(); my $now=time; @@ -209,7 +350,6 @@ sub get_course_context { return $course_context; } -# ================================================== Unpack message into a hash sub unpackagemsg { my ($message,$notoken,$noattachmentlink)=@_; @@ -247,7 +387,6 @@ sub unpackagemsg { return %content; } -# ======================================================= Get info out of msgid sub buildmsgid { my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_; @@ -316,11 +455,9 @@ sub sendnotification { $text=~s/\<\;/\/gs; - my $homeserver = &Apache::lonnet::homeserver($touname,$toudom); - my $protocol = $Apache::lonnet::protocol{$homeserver}; - $protocol = 'http' if ($protocol ne 'https'); - my $url = $protocol.'://'.&Apache::lonnet::hostname($homeserver). - '/adm/email?username='.$touname.'&domain='.$toudom; + my $url='http://'. + &Apache::lonnet::hostname(&Apache::lonnet::homeserver($touname,$toudom)). + '/adm/email?username='.$touname.'&domain='.$toudom; my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend); @@ -395,7 +532,7 @@ to access the full message.',$url); &sendemail($to,$subject,$body,$touname,$toudom,$user_lh); } } -# ============================================================= Check for email + sub newmail { if ((time-$env{'user.mailcheck.time'})>300) { @@ -406,14 +543,7 @@ sub newmail { return 0; } -# =============================== Automated message to the author of a resource -=pod - -=item * B: Sends message $message to the owner - of the resource with the URI $filename. - -=cut sub author_res_msg { my ($filename,$message)=@_; @@ -435,7 +565,7 @@ sub author_res_msg { return 'no_host'; } -# =========================================== Retrieve author resource messages + sub retrieve_author_res_msg { my $url=shift; @@ -455,7 +585,8 @@ sub retrieve_author_res_msg { } -# =============================== Delete all author messages related to one URL + + sub del_url_author_res_msg { my $url=shift; @@ -469,7 +600,7 @@ sub del_url_author_res_msg { } return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); } -# =================================== Clear out all author messages in URL path + sub clear_author_res_msg { my $url=shift; @@ -483,7 +614,8 @@ sub clear_author_res_msg { } 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 { my ($author,$domain)=@_; @@ -495,7 +627,6 @@ sub all_url_author_res_msg { return %returnhash; } -# ====================================== Add a comment to the User Notes screen sub store_instructor_comment { my ($msg,$uname,$udom) = @_; @@ -510,7 +641,6 @@ sub store_instructor_comment { return $result; } -# ================================================== Critical message to a user sub user_crit_msg_raw { my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, @@ -564,24 +694,7 @@ sub user_crit_msg_raw { return $status; } -# New routine that respects "forward" and calls old routine -=pod - -=item * B: - 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 { my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, @@ -610,7 +723,6 @@ sub user_crit_msg { return join(' ',@status); } -# =================================================== Critical message received sub user_crit_received { my $msgid=shift; @@ -646,7 +758,8 @@ sub user_crit_received { return $status; } -# ======================================================== Normal communication + + sub user_normal_msg_raw { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, @@ -707,25 +820,6 @@ sub user_normal_msg_raw { return $status; } -# New routine that respects "forward" and calls old routine - -=pod - -=item * B: - 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 { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, $toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_; @@ -809,7 +903,6 @@ sub store_recipients { } } -# =============================================================== Folder suffix sub foldersuffix { my $folder=shift; @@ -824,7 +917,6 @@ sub foldersuffix { return $suffix; } -# ========================================================= User-defined folders sub get_user_folders { my ($folder) = @_; @@ -865,33 +957,6 @@ sub secapply { return ''; } -=pod - -=item * B: - -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. - 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 { my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; &Apache::lonenc::check_decrypt(\$feedurl); @@ -938,7 +1003,7 @@ sub user_lang { @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/, $env{'course.'.$fromcid.'.languages'})); } else { - my %langhash = &Apache::loncommon::getlangs($toudom,$touname); + my %langhash = &Apache::lonnet::get('environment',['languages'],$toudom,$touname); if ($langhash{'languages'} ne '') { @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'}); } else { @@ -948,17 +1013,11 @@ sub user_lang { } } } - my @languages=&Apache::lonlocal::get_genlanguages(@userlangs); + my @languages=&Apache::loncommon::get_genlanguages(@userlangs); my $user_lh = Apache::localize->get_handle(@languages); return $user_lh; } -=pod - -=back - -=cut - 1; __END__