Annotation of loncom/interface/lonfeedback.pm, revision 1.10

1.1       www         1: # The LearningOnline Network
                      2: # Feedback
                      3: #
                      4: # (Internal Server Error Handler
                      5: #
                      6: # (Login Screen
                      7: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
                      8: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
                      9: #
                     10: # 3/1/1 Gerd Kortemeyer)
                     11: #
1.5       www        12: # 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer
1.7       albertel   13: # 2/9 Guy Albertelli
1.8       www        14: # 2/10 Gerd Kortemeyer
1.9       albertel   15: # 2/13 Guy Albertelli
1.10    ! www        16: # 7/25 Gerd Kortemeyer
1.7       albertel   17: 
1.1       www        18: package Apache::lonfeedback;
                     19: 
                     20: use strict;
                     21: use Apache::Constants qw(:common);
1.3       www        22: use Apache::lonmsg();
1.9       albertel   23: use Apache::loncommon();
1.1       www        24: 
1.6       albertel   25: sub mail_screen {
                     26:   my ($r,$feedurl,$options) = @_;
                     27:   $r->print(<<ENDDOCUMENT);
1.1       www        28: <html>
                     29: <head>
                     30: <title>The LearningOnline Network with CAPA</title>
1.7       albertel   31: <meta http-equiv="pragma" content="no-cache"></meta>
1.5       www        32: <script>
                     33:     function gosubmit() {
                     34:         var rec=0;
1.10    ! www        35:         if (typeof(document.mailform.elements.author!=undefined)) {
1.5       www        36:           if (document.mailform.elements.author.checked) {
                     37:              rec=1;
                     38:           } 
                     39:         }
1.10    ! www        40:         if (typeof(document.mailform.elements.question!=undefined)) {
1.5       www        41:           if (document.mailform.elements.question.checked) {
                     42:              rec=1;
                     43:           } 
                     44:         }
1.10    ! www        45:         if (typeof(document.mailform.elements.course!=undefined)) {
1.5       www        46:           if (document.mailform.elements.course.checked) {
                     47:              rec=1;
                     48:           } 
                     49:         }
1.10    ! www        50:         if (typeof(document.mailform.elements.policy!=undefined)) {
1.5       www        51:           if (document.mailform.elements.policy.checked) {
                     52:              rec=1;
                     53:           } 
                     54:         }
1.10    ! www        55:         if (typeof(document.mailform.elements.discuss!=undefined)) {
        !            56:           if (document.mailform.elements.discuss.checked) {
        !            57:              rec=1;
        !            58:           } 
        !            59:         }
1.5       www        60: 
                     61:         if (rec) {
                     62: 	    document.mailform.submit();
                     63:         } else {
                     64:             alert('Please check a feedback type.');
                     65: 	}
                     66:     }
                     67: </script>
1.1       www        68: </head>
1.5       www        69: <body bgcolor="#FFFFFF" onLoad="window.focus();">
1.2       www        70: <img align=right src=/adm/lonIcons/lonlogos.gif>
1.1       www        71: <h1>Feedback</h1>
1.2       www        72: <h2><tt>$feedurl</tt></h2>
1.5       www        73: <form action="/adm/feedback" method=post name=mailform>
1.2       www        74: <input type=hidden name=postdata value="$feedurl">
1.5       www        75: Please check at least one of the following feedback types:
1.2       www        76: $options<hr>
                     77: My question/comment/feedback:<p>
                     78: <textarea name=comment cols=60 rows=10>
                     79: </textarea><p>
1.5       www        80: <input type=hidden name=sendit value=1>
                     81: <input type=button value="Send Feedback" onClick='gosubmit();'></input>
1.2       www        82: </form>
1.1       www        83: </body>
                     84: </html>
                     85: ENDDOCUMENT
1.6       albertel   86: }
                     87: 
                     88: sub fail_redirect {
                     89:   my ($r,$feedurl) = @_;
                     90:   $r->print (<<ENDFAILREDIR);
1.5       www        91: <head><title>Feedback not sent</title>
1.7       albertel   92: <meta http-equiv="pragma" content="no-cache"></meta>
1.5       www        93: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
                     94: </head>
                     95: <html>
                     96: <body bgcolor="#FFFFFF">
1.8       www        97: <img align=right src=/adm/lonIcons/lonlogos.gif>
                     98: <b>Sorry, no recipients  ...</b>
1.5       www        99: </body>
                    100: </html>
                    101: ENDFAILREDIR
                    102: }
1.4       www       103: 
1.6       albertel  104: sub redirect_back {
                    105:   my ($r,$feedurl,$typestyle,$sendsomething,$status) = @_;
                    106:   $r->print (<<ENDREDIR);
1.3       www       107: <head>
                    108: <title>Feedback sent</title>
1.7       albertel  109: <meta http-equiv="pragma" content="no-cache"></meta>
1.5       www       110: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
1.2       www       111: </head>
                    112: <html>
                    113: <body bgcolor="#FFFFFF">
1.8       www       114: <img align=right src=/adm/lonIcons/lonlogos.gif>
1.5       www       115: $typestyle
                    116: <b>Sent $sendsomething message(s).</b>
1.3       www       117: <font color=red>$status</font>
1.2       www       118: </body>
                    119: </html>
                    120: ENDREDIR
                    121: }
1.6       albertel  122: 
                    123: sub no_redirect_back {
                    124:   my ($r,$feedurl) = @_;
                    125:   $r->print (<<ENDNOREDIR);
1.2       www       126: <head><title>Feedback not sent</title>
1.7       albertel  127: <meta http-equiv="pragma" content="no-cache"></meta>
                    128: ENDNOREDIR
                    129: 
1.8       www       130:   if ($feedurl!~/^\/adm\/feedback/) { 
1.7       albertel  131:     $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
                    132:   }
                    133:   
1.8       www       134:   $r->print (<<ENDNOREDIRTWO);
1.2       www       135: </head>
                    136: <html>
                    137: <body bgcolor="#FFFFFF">
1.8       www       138: <img align=right src=/adm/lonIcons/lonlogos.gif>
                    139: <b>Sorry, no feedback possible on this resource  ...</b>
1.2       www       140: </body>
                    141: </html>
1.8       www       142: ENDNOREDIRTWO
1.2       www       143: }
1.6       albertel  144: 
                    145: sub screen_header {
                    146:   my ($feedurl) = @_;
                    147:   my $options='';
                    148:   if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) {
                    149:     $options= 
                    150:       '<p><input type=checkbox name=author> Feedback to resource author';
                    151:   }
                    152:   if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) {
                    153:     $options.=
1.8       www       154:     '<br><input type=checkbox name=question> Question about resource content';
1.6       albertel  155:   }
                    156:   if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) {
                    157:     $options.=
                    158:       '<br><input type=checkbox name=course> '.
                    159: 	'Question/Comment/Feedback about course content';
                    160:   }
                    161:   if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) {
                    162:     $options.=
                    163:       '<br><input type=checkbox name=policy> '.
                    164: 	'Question/Comment/Feedback about course policy';
1.10    ! www       165:   }
        !           166:   if ($ENV{'request.course.id'}) {
        !           167:     $options.='<br><input type=checkbox name=discuss> '.
        !           168: 	'<b>Contribution to course discussion of resource</b>';
1.6       albertel  169:   }
                    170:   return $options;
                    171: }
                    172: 
                    173: sub resource_output {
                    174:   my ($feedurl) = @_;
                    175:   my $usersaw=&Apache::lonnet::ssi($feedurl);
                    176:   $usersaw=~s/\<body[^\>]*\>//gi;
                    177:   $usersaw=~s/\<\/body\>//gi;
                    178:   $usersaw=~s/\<html\>//gi;
                    179:   $usersaw=~s/\<\/html\>//gi;
                    180:   $usersaw=~s/\<head\>//gi;
                    181:   $usersaw=~s/\<\/head\>//gi;
                    182:   $usersaw=~s/action\s*\=/would_be_action\=/gi;
                    183:   return $usersaw;
                    184: }
                    185: 
                    186: sub clear_out_html {
                    187:   my $message=$ENV{'form.comment'};
                    188:   $message=~s/\</\&lt\;/g;
                    189:   $message=~s/\>/\&gt\;/g;
                    190:   return $message;
                    191: }
                    192: 
                    193: sub assemble_email {
                    194:   my ($feedurl,$message,$prevattempts,$usersaw)=@_;
                    195:   my $email=<<"ENDEMAIL";
                    196: Refers to <a href="$feedurl">$feedurl</a>
                    197: 
                    198: $message
                    199: ENDEMAIL
                    200:     my $citations=<<"ENDCITE";
                    201: <h2>Previous attempts of student (if applicable)</h2>
                    202: $prevattempts
                    203: <p><hr>
                    204: <h2>Original screen output (if applicable)</h2>
                    205: $usersaw
                    206: ENDCITE
                    207:   return ($email,$citations);
                    208: }
                    209: 
                    210: sub decide_receiver {
                    211:   my ($feedurl) = @_;
                    212:   my $typestyle='';
                    213:   my %to=();
                    214:   if ($ENV{'form.author'}) {
1.8       www       215:     $typestyle.='Submitting as Author Feedback<br>';
1.6       albertel  216:     $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
                    217:     $to{$2.':'.$1}=1;
                    218:   }
                    219:   if ($ENV{'form.question'}) {
1.8       www       220:     $typestyle.='Submitting as Question<br>';
1.6       albertel  221:     map {
                    222:       $to{$_}=1;
                    223:     } split(/\,/,
                    224: 	    $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'});
                    225:   }
                    226:   if ($ENV{'form.course'}) {
1.8       www       227:     $typestyle.='Submitting as Comment<br>';
1.6       albertel  228:     map {
                    229:       $to{$_}=1;
                    230:     } split(/\,/,
                    231: 	    $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'});
                    232:   }
                    233:   if ($ENV{'form.policy'}) {
1.8       www       234:     $typestyle.='Submitting as Policy Feedback<br>';
1.6       albertel  235:     map {
                    236:       $to{$_}=1;
                    237:     } split(/\,/,
                    238: 	    $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'});
                    239:   }
                    240:   return ($typestyle,%to);
                    241: }
                    242: 
                    243: sub send_msg {
                    244:   my ($feedurl,$email,$citations,%to)=@_;
                    245:   my $status='';
                    246:   my $sendsomething=0;
                    247:   map {
                    248:     if ($_) {
1.8       www       249:       unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
                    250:                'Feedback '.$feedurl,$email,$citations) eq 'ok') {
1.6       albertel  251: 	$status.='<br>Error sending message to '.$_.'<br>';
                    252:       } else {
                    253: 	#$status.='<br>Message sent to '.$_.'<br>';
                    254: 	$sendsomething++;
                    255:       }
                    256:     }
                    257:   } keys %to;       
                    258:   return ($status,$sendsomething);
                    259: }
                    260: 
                    261: sub handler {
                    262:   my $r = shift;
1.8       www       263:   if ($r->header_only) {
                    264:      $r->content_type('text/html');
                    265:      $r->send_http_header;
                    266:      return OK;
                    267:   }
1.6       albertel  268:   
                    269:   my $feedurl=$ENV{'form.postdata'};
                    270:   $feedurl=~s/^http\:\/\///;
                    271:   $feedurl=~s/^$ENV{'SERVER_NAME'}//;
                    272:   $feedurl=~s/^$ENV{'HTTP_HOST'}//;
1.8       www       273: 
                    274:   my $symb=&Apache::lonnet::symbread($feedurl);
                    275:   my $goahead=1;
                    276:   if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                    277:       unless ($symb) { $goahead=0; }
                    278:   }
                    279: 
                    280:   if ($goahead) {
                    281: # Go ahead with feedback, no ambiguous reference
                    282:     $r->content_type('text/html');
                    283:     $r->send_http_header;
1.6       albertel  284:   
1.8       www       285:     if (
1.7       albertel  286:       (
                    287:        ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
                    288:       ) 
                    289:       || 
                    290:       ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
                    291:      ) {
1.6       albertel  292: # --------------------------------------------------- Print login screen header
                    293:     unless ($ENV{'form.sendit'}) {
                    294:       my $options=&screen_header($feedurl);
                    295:       if ($options) {
                    296: 	&mail_screen($r,$feedurl,$options);
                    297:       } else {
                    298: 	&fail_redirect($r,$feedurl);
                    299:       }
                    300:     } else {
                    301:       
                    302: # Get previous user input
1.9       albertel  303:       my $prevattempts=&Apache::loncommon::get_previous_attempt(
                    304:             $symb,$ENV{'user.name'},$ENV{'user.domain'},$ENV{'user.home'},
                    305:             $ENV{'request.course.id'});
1.6       albertel  306: 
                    307: # Get output from resource
                    308:       my $usersaw=&resource_output($feedurl);
                    309: 
                    310: # Filter HTML out of message (could be nasty)
                    311:       my $message=&clear_out_html;
                    312: 
                    313: # Assemble email
1.8       www       314:       my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
                    315:           $usersaw);
1.6       albertel  316: 
                    317: # Who gets this?
                    318:       my ($typestyle,%to) = &decide_receiver($feedurl);
                    319: 
                    320: # Actually send mail
                    321:       my ($status,$numsent)=&send_msg($feedurl,$email,$citations,%to);
                    322: 
                    323: # Receipt screen and redirect back to where came from
1.8       www       324:       &redirect_back($r,$feedurl,$typestyle,$numsent,$status);
1.6       albertel  325: 
                    326:     }
1.8       www       327:    } else {
1.7       albertel  328: # Unable to give feedback
1.6       albertel  329:     &no_redirect_back($r,$feedurl);
1.8       www       330:    }
                    331:   } else {
                    332: # Ambiguous Problem Resource
                    333:     $r->internal_redirect('/adm/ambiguous');
1.6       albertel  334:   }
                    335:   return OK;
1.1       www       336: } 
                    337: 
                    338: 1;
                    339: __END__
1.2       www       340: 
                    341: 
                    342: 

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