--- loncom/interface/lonfeedback.pm	2001/02/08 21:35:24	1.5
+++ loncom/interface/lonfeedback.pm	2001/07/25 16:08:38	1.10
@@ -10,75 +10,53 @@
 # 3/1/1 Gerd Kortemeyer)
 #
 # 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer
-#
+# 2/9 Guy Albertelli
+# 2/10 Gerd Kortemeyer
+# 2/13 Guy Albertelli
+# 7/25 Gerd Kortemeyer
+
 package Apache::lonfeedback;
 
 use strict;
 use Apache::Constants qw(:common);
 use Apache::lonmsg();
+use Apache::loncommon();
 
-sub handler {
-    my $r = shift;
-    $r->content_type('text/html');
-    $r->send_http_header;
-    return OK if $r->header_only;
-
-    my $feedurl=$ENV{'form.postdata'};
-    $feedurl=~s/^http\:\/\///;
-    $feedurl=~s/^$ENV{'SERVER_NAME'}//;
-    $feedurl=~s/^$ENV{'HTTP_HOST'}//;
-
-    if ((($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) 
-        || ($ENV{'request.course.id'})) {
-# --------------------------------------------------- Print login screen header
-    unless ($ENV{'form.sendit'}) {
-	my $options='';
-        if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) {
-           $options= 
- '<p><input type=checkbox name=author> Feedback to resource author';
-        }
-	if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) {
-           $options.=
- '<br><input type=checkbox name=question> Question about resource content';
-        }
-	if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) {
-           $options.=
- '<br><input type=checkbox name=course> '.
- 'Question/Comment/Feedback about course content';
-        }
-	if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) {
-           $options.=
- '<br><input type=checkbox name=policy> '.
- 'Question/Comment/Feedback about course policy';
-        }
-	if ($options) {
-       $r->print(<<ENDDOCUMENT);
+sub mail_screen {
+  my ($r,$feedurl,$options) = @_;
+  $r->print(<<ENDDOCUMENT);
 <html>
 <head>
 <title>The LearningOnline Network with CAPA</title>
+<meta http-equiv="pragma" content="no-cache"></meta>
 <script>
     function gosubmit() {
         var rec=0;
-        if (document.mailform.elements.author!=undefined) {
+        if (typeof(document.mailform.elements.author!=undefined)) {
           if (document.mailform.elements.author.checked) {
              rec=1;
           } 
         }
-        if (document.mailform.elements.question!=undefined) {
+        if (typeof(document.mailform.elements.question!=undefined)) {
           if (document.mailform.elements.question.checked) {
              rec=1;
           } 
         }
-        if (document.mailform.elements.course!=undefined) {
+        if (typeof(document.mailform.elements.course!=undefined)) {
           if (document.mailform.elements.course.checked) {
              rec=1;
           } 
         }
-        if (document.mailform.elements.policy!=undefined) {
+        if (typeof(document.mailform.elements.policy!=undefined)) {
           if (document.mailform.elements.policy.checked) {
              rec=1;
           } 
         }
+        if (typeof(document.mailform.elements.discuss!=undefined)) {
+          if (document.mailform.elements.discuss.checked) {
+             rec=1;
+          } 
+        }
 
         if (rec) {
 	    document.mailform.submit();
@@ -105,150 +83,35 @@ My question/comment/feedback:<p>
 </body>
 </html>
 ENDDOCUMENT
-} else {
-    print (<<ENDFAILREDIR);
+}
+
+sub fail_redirect {
+  my ($r,$feedurl) = @_;
+  $r->print (<<ENDFAILREDIR);
 <head><title>Feedback not sent</title>
+<meta http-equiv="pragma" content="no-cache"></meta>
 <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
 </head>
 <html>
 <body bgcolor="#FFFFFF">
-Sorry, no recipients  ...
+<img align=right src=/adm/lonIcons/lonlogos.gif>
+<b>Sorry, no recipients  ...</b>
 </body>
 </html>
 ENDFAILREDIR
-
 }
-} else {
-#
-# Get previous user input
-#
-    my $symb=&Apache::lonnet::symbread($feedurl);
-    my $prevattempts='';
-    if ($symb) {
-       my $answer=&Apache::lonnet::reply(
-              "restore:".$ENV{'user.domain'}.':'.$ENV{'user.name'}.':'.
-              $ENV{'request.course.id'}.':'.
-              &Apache::lonnet::escape($symb),
-              $ENV{'user.home'});
-       my %returnhash=();
-       map {
-	  my ($name,$value)=split(/\=/,$_);
-          $returnhash{&Apache::lonnet::unescape($name)}=
-                      &Apache::lonnet::unescape($value);
-       } split(/\&/,$answer);
-       my %lasthash=();
-       my $version;
-       for ($version=1;$version<=$returnhash{'version'};$version++) {
-          map {
-             $lasthash{$_}=$returnhash{$version.':'.$_};
-          } split(/\:/,$returnhash{$version.':keys'});
-       }
-       $prevattempts='<table border=2></tr><th>History</th>';
-       map {
-           $prevattempts.='<th>'.$_.'</th>';
-       } keys %lasthash;
-       for ($version=1;$version<=$returnhash{'version'};$version++) {
-	   $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
-           map {
-               $prevattempts.='<td>'.$returnhash{$version.':'.$_}.'</td>';   
-	  } keys %lasthash;
-       }
-       $prevattempts.='</tr><tr><th>Current</th>';
-       map {
-           $prevattempts.='<td>'.$lasthash{$_}.'</td>';
-       } keys %lasthash;
-       $prevattempts.='</tr></table>';
-    }
-#
-# Get output from resource
-#
-    my $usersaw=&Apache::lonnet::ssi($feedurl);
-    $usersaw=~s/\<body[^\>]*\>//gi;
-    $usersaw=~s/\<\/body\>//gi;
-    $usersaw=~s/\<html\>//gi;
-    $usersaw=~s/\<\/html\>//gi;
-    $usersaw=~s/\<head\>//gi;
-    $usersaw=~s/\<\/head\>//gi;
-    $usersaw=~s/action\s*\=/would_be_action\=/gi;
-#
-# Filter HTML out of message (could be nasty)
-#
-    my $message=$ENV{'form.comment'};
-    $message=~s/\</\&lt\;/g;
-    $message=~s/\>/\&gt\;/g;
-
-#
-# Assemble email
-#
-    my $email=<<"ENDEMAIL";
-Refers to <a href="$feedurl">$feedurl</a>
 
-$message
-ENDEMAIL
-    my $citations=<<"ENDCITE";
-<h2>Previous attempts of student (if applicable)</h2>
-$prevattempts
-<p><hr>
-<h2>Original screen output (if applicable)</h2>
-$usersaw
-ENDCITE
-#
-# Who gets this?
-#
-    my $typestyle='';
-    my %to=();
-    if ($ENV{'form.author'}) {
-        $typestyle.='Author Feedback<br>';
-	$feedurl=~/^\/res\/(\w+)\/(\w+)\//;
-        $to{$2.':'.$1}=1;
-    }
-    if ($ENV{'form.question'}) {
-        $typestyle.='Question<br>';
-	map {
-            $to{$_}=1;
-        } split(/\,/,
-          $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'});
-    }
-    if ($ENV{'form.course'}) {
-        $typestyle.='Comment<br>';
-	map {
-            $to{$_}=1;
-        } split(/\,/,
-          $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'});
-    }
-    if ($ENV{'form.policy'}) {
-        $typestyle.='Policy<br>';
-	map {
-            $to{$_}=1;
-        } split(/\,/,
-          $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'});
-    }
-#
-# Actually send mail
-#
-    my $status='';
-    my $sendsomething=0;
-    map {
-       if ($_) {
-          unless (
-          &Apache::lonmsg::user_normal_msg(split(/\:/,$_),'Feedback '.$feedurl,
-                                           $email,$citations) eq 'ok') {
-            $status.='<br>Error sending message to '.$_.'<br>';
-	} else {
-          $sendsomething++;
-        }
-       }
-    } keys %to;       
-#
-# Receipt screen and redirect back to where came from
-#
-    print (<<ENDREDIR);
+sub redirect_back {
+  my ($r,$feedurl,$typestyle,$sendsomething,$status) = @_;
+  $r->print (<<ENDREDIR);
 <head>
 <title>Feedback sent</title>
+<meta http-equiv="pragma" content="no-cache"></meta>
 <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
 </head>
 <html>
 <body bgcolor="#FFFFFF">
+<img align=right src=/adm/lonIcons/lonlogos.gif>
 $typestyle
 <b>Sent $sendsomething message(s).</b>
 <font color=red>$status</font>
@@ -256,19 +119,220 @@ $typestyle
 </html>
 ENDREDIR
 }
-} else {
-    print (<<ENDNOREDIR);
+
+sub no_redirect_back {
+  my ($r,$feedurl) = @_;
+  $r->print (<<ENDNOREDIR);
 <head><title>Feedback not sent</title>
-<meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
+<meta http-equiv="pragma" content="no-cache"></meta>
+ENDNOREDIR
+
+  if ($feedurl!~/^\/adm\/feedback/) { 
+    $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
+  }
+  
+  $r->print (<<ENDNOREDIRTWO);
 </head>
 <html>
 <body bgcolor="#FFFFFF">
-Sorry, no feedback possible on this resource  ...
+<img align=right src=/adm/lonIcons/lonlogos.gif>
+<b>Sorry, no feedback possible on this resource  ...</b>
 </body>
 </html>
-ENDNOREDIR
+ENDNOREDIRTWO
+}
+
+sub screen_header {
+  my ($feedurl) = @_;
+  my $options='';
+  if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) {
+    $options= 
+      '<p><input type=checkbox name=author> Feedback to resource author';
+  }
+  if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) {
+    $options.=
+    '<br><input type=checkbox name=question> Question about resource content';
+  }
+  if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) {
+    $options.=
+      '<br><input type=checkbox name=course> '.
+	'Question/Comment/Feedback about course content';
+  }
+  if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) {
+    $options.=
+      '<br><input type=checkbox name=policy> '.
+	'Question/Comment/Feedback about course policy';
+  }
+  if ($ENV{'request.course.id'}) {
+    $options.='<br><input type=checkbox name=discuss> '.
+	'<b>Contribution to course discussion of resource</b>';
+  }
+  return $options;
+}
+
+sub resource_output {
+  my ($feedurl) = @_;
+  my $usersaw=&Apache::lonnet::ssi($feedurl);
+  $usersaw=~s/\<body[^\>]*\>//gi;
+  $usersaw=~s/\<\/body\>//gi;
+  $usersaw=~s/\<html\>//gi;
+  $usersaw=~s/\<\/html\>//gi;
+  $usersaw=~s/\<head\>//gi;
+  $usersaw=~s/\<\/head\>//gi;
+  $usersaw=~s/action\s*\=/would_be_action\=/gi;
+  return $usersaw;
+}
+
+sub clear_out_html {
+  my $message=$ENV{'form.comment'};
+  $message=~s/\</\&lt\;/g;
+  $message=~s/\>/\&gt\;/g;
+  return $message;
+}
+
+sub assemble_email {
+  my ($feedurl,$message,$prevattempts,$usersaw)=@_;
+  my $email=<<"ENDEMAIL";
+Refers to <a href="$feedurl">$feedurl</a>
+
+$message
+ENDEMAIL
+    my $citations=<<"ENDCITE";
+<h2>Previous attempts of student (if applicable)</h2>
+$prevattempts
+<p><hr>
+<h2>Original screen output (if applicable)</h2>
+$usersaw
+ENDCITE
+  return ($email,$citations);
+}
+
+sub decide_receiver {
+  my ($feedurl) = @_;
+  my $typestyle='';
+  my %to=();
+  if ($ENV{'form.author'}) {
+    $typestyle.='Submitting as Author Feedback<br>';
+    $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
+    $to{$2.':'.$1}=1;
+  }
+  if ($ENV{'form.question'}) {
+    $typestyle.='Submitting as Question<br>';
+    map {
+      $to{$_}=1;
+    } split(/\,/,
+	    $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'});
+  }
+  if ($ENV{'form.course'}) {
+    $typestyle.='Submitting as Comment<br>';
+    map {
+      $to{$_}=1;
+    } split(/\,/,
+	    $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'});
+  }
+  if ($ENV{'form.policy'}) {
+    $typestyle.='Submitting as Policy Feedback<br>';
+    map {
+      $to{$_}=1;
+    } split(/\,/,
+	    $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'});
+  }
+  return ($typestyle,%to);
+}
+
+sub send_msg {
+  my ($feedurl,$email,$citations,%to)=@_;
+  my $status='';
+  my $sendsomething=0;
+  map {
+    if ($_) {
+      unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
+               'Feedback '.$feedurl,$email,$citations) eq 'ok') {
+	$status.='<br>Error sending message to '.$_.'<br>';
+      } else {
+	#$status.='<br>Message sent to '.$_.'<br>';
+	$sendsomething++;
+      }
+    }
+  } keys %to;       
+  return ($status,$sendsomething);
 }
-    return OK;
+
+sub handler {
+  my $r = shift;
+  if ($r->header_only) {
+     $r->content_type('text/html');
+     $r->send_http_header;
+     return OK;
+  }
+  
+  my $feedurl=$ENV{'form.postdata'};
+  $feedurl=~s/^http\:\/\///;
+  $feedurl=~s/^$ENV{'SERVER_NAME'}//;
+  $feedurl=~s/^$ENV{'HTTP_HOST'}//;
+
+  my $symb=&Apache::lonnet::symbread($feedurl);
+  my $goahead=1;
+  if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
+      unless ($symb) { $goahead=0; }
+  }
+
+  if ($goahead) {
+# Go ahead with feedback, no ambiguous reference
+    $r->content_type('text/html');
+    $r->send_http_header;
+  
+    if (
+      (
+       ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
+      ) 
+      || 
+      ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
+     ) {
+# --------------------------------------------------- Print login screen header
+    unless ($ENV{'form.sendit'}) {
+      my $options=&screen_header($feedurl);
+      if ($options) {
+	&mail_screen($r,$feedurl,$options);
+      } else {
+	&fail_redirect($r,$feedurl);
+      }
+    } else {
+      
+# Get previous user input
+      my $prevattempts=&Apache::loncommon::get_previous_attempt(
+            $symb,$ENV{'user.name'},$ENV{'user.domain'},$ENV{'user.home'},
+            $ENV{'request.course.id'});
+
+# Get output from resource
+      my $usersaw=&resource_output($feedurl);
+
+# Filter HTML out of message (could be nasty)
+      my $message=&clear_out_html;
+
+# Assemble email
+      my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
+          $usersaw);
+
+# Who gets this?
+      my ($typestyle,%to) = &decide_receiver($feedurl);
+
+# Actually send mail
+      my ($status,$numsent)=&send_msg($feedurl,$email,$citations,%to);
+
+# Receipt screen and redirect back to where came from
+      &redirect_back($r,$feedurl,$typestyle,$numsent,$status);
+
+    }
+   } else {
+# Unable to give feedback
+    &no_redirect_back($r,$feedurl);
+   }
+  } else {
+# Ambiguous Problem Resource
+    $r->internal_redirect('/adm/ambiguous');
+  }
+  return OK;
 } 
 
 1;
