Diff for /loncom/interface/lonfeedback.pm between versions 1.33 and 1.42

version 1.33, 2002/10/03 15:04:29 version 1.42, 2003/03/29 22:50:22
Line 112  $options<hr> Line 112  $options<hr>
 My question/comment/feedback:<p>  My question/comment/feedback:<p>
 <textarea name=comment cols=60 rows=10 wrap=hard>  <textarea name=comment cols=60 rows=10 wrap=hard>
 </textarea><p>  </textarea><p>
 <input type=hidden name=sendit value=1>  Attachment (128 KB max size): <input type="file" name="attachment" />
 <input type=button value="Send Feedback" onClick='gosubmit();'></input>  </p>
   <p>
   <input type="hidden" name="sendit" value="1" />
   <input type=button value="Send Feedback" onClick='gosubmit();' />
   </p>
 </form>  </form>
 ENDDOCUMENT  ENDDOCUMENT
 $r->print(&generate_preview_button().'</body></html>');  $r->print(&generate_preview_button().'</body></html>');
Line 179  ENDNOREDIRTWO Line 183  ENDNOREDIRTWO
 sub screen_header {  sub screen_header {
   my ($feedurl) = @_;    my ($feedurl) = @_;
   my $options='';    my $options='';
   if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) {    if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
     $options=       $options= 
       '<p><input type=checkbox name=author> Feedback to resource author';        '<p><input type=checkbox name=author> Feedback to resource author';
   }    }
   if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) {    if (&feedback_available(1)) {
     $options.=      $options.=
     '<br><input type=checkbox name=question> Question about resource content';      '<br><input type=checkbox name=question> Question about resource content';
   }    }
   if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) {    if (&feedback_available(0,1)) {
     $options.=      $options.=
       '<br><input type=checkbox name=course> '.        '<br><input type=checkbox name=course> '.
  'Question/Comment/Feedback about course content';   'Question/Comment/Feedback about course content';
   }    }
   if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) {    if (&feedback_available(0,0,1)) {
     $options.=      $options.=
       '<br><input type=checkbox name=policy> '.        '<br><input type=checkbox name=policy> '.
  'Question/Comment/Feedback about course policy';   'Question/Comment/Feedback about course policy';
Line 226  sub resource_output { Line 230  sub resource_output {
 }  }
   
 sub clear_out_html {  sub clear_out_html {
   my $message=$ENV{'form.comment'};    my ($message,$override)=@_;
   $message=~s/\<\/*m\s*\>//g;    my $cid=$ENV{'request.course.id'};
   $message=~s/\</\&lt\;/g;    if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
   $message=~s/\>/\&gt\;/g;        ($override)) {
         # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 
         # <BLOCKQUOTE> <DIV .*> <DIV> <IMG>
         my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
    BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1);
   
         $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
     {($html{uc($2)}&(length($1)<1000))?"\<$1":"\&lt;$1"}/ge;
         $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
     {($html{uc($2)}&(length($1)<1000))?"$1\>":"$1\&gt;"}/ge;
     } else {
         $message=~s/\<\/*m\s*\>//g;
         $message=~s/\</\&lt\;/g;
         $message=~s/\>/\&gt\;/g;
     }
   return $message;    return $message;
 }  }
   
 sub assemble_email {  sub assemble_email {
   my ($feedurl,$message,$prevattempts,$usersaw)=@_;    my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
   my $email=<<"ENDEMAIL";    my $email=<<"ENDEMAIL";
 Refers to <a href="$feedurl">$feedurl</a>  Refers to <a href="$feedurl">$feedurl</a>
   
Line 246  $prevattempts Line 264  $prevattempts
 <p><hr>  <p><hr>
 <h2>Original screen output (if applicable)</h2>  <h2>Original screen output (if applicable)</h2>
 $usersaw  $usersaw
   <h2>Correct Answer(s) (if applicable)</h2>
   $useranswer
 ENDCITE  ENDCITE
   return ($email,$citations);    return ($email,$citations);
 }  }
   
   sub secapply {
       my $rec=shift;
       my $defaultflag=shift;
       $rec=~s/\s+//g;
       $rec=~s/\@/\:/g;
       my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
       if ($sections) {
    foreach (split(/\;/,$sections)) {
               if (($_ eq $ENV{'request.course.sec'}) ||
                   ($defaultflag && ($_ eq '*'))) {
                   return $adr; 
               }
           }
       } else {
          return $rec;
       }
       return '';
   }
   
 sub decide_receiver {  sub decide_receiver {
   my ($feedurl) = @_;    my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
   my $typestyle='';    my $typestyle='';
   my %to=();    my %to=();
   if ($ENV{'form.author'}) {    if ($ENV{'form.author'}||$author) {
     $typestyle.='Submitting as Author Feedback<br>';      $typestyle.='Submitting as Author Feedback<br>';
     $feedurl=~/^\/res\/(\w+)\/(\w+)\//;      $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
     $to{$2.':'.$1}=1;      $to{$2.':'.$1}=1;
   }    }
   if ($ENV{'form.question'}) {    if ($ENV{'form.question'}||$question) {
     $typestyle.='Submitting as Question<br>';      $typestyle.='Submitting as Question<br>';
     foreach (split(/\,/,      foreach (split(/\,/,
    $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})     $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
      ) {       ) {
       $to{$_}=1;   my $rec=&secapply($_,$defaultflag);
           if ($rec) { $to{$rec}=1; }
     }       } 
   }    }
   if ($ENV{'form.course'}) {    if ($ENV{'form.course'}||$course) {
     $typestyle.='Submitting as Comment<br>';      $typestyle.='Submitting as Comment<br>';
     foreach (split(/\,/,      foreach (split(/\,/,
    $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})     $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
      ) {       ) {
       $to{$_}=1;   my $rec=&secapply($_,$defaultflag);
           if ($rec) { $to{$rec}=1; }
     }       } 
   }    }
   if ($ENV{'form.policy'}) {    if ($ENV{'form.policy'}||$policy) {
     $typestyle.='Submitting as Policy Feedback<br>';      $typestyle.='Submitting as Policy Feedback<br>';
     foreach (split(/\,/,      foreach (split(/\,/,
    $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})     $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
      ) {       ) {
       $to{$_}=1;   my $rec=&secapply($_,$defaultflag);
           if ($rec) { $to{$rec}=1; }
     }       } 
   }    }
     if ((scalar(%to) eq '0') && (!$defaultflag)) {
        ($typestyle,%to)=
    &decide_receiver($feedurl,$author,$question,$course,$policy,1);
     }
   return ($typestyle,%to);    return ($typestyle,%to);
 }  }
   
   sub feedback_available {
       my ($question,$course,$policy)=@_;
       my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
       return scalar(%to);
   }
   
 sub send_msg {  sub send_msg {
   my ($feedurl,$email,$citations,%to)=@_;    my ($feedurl,$email,$citations,%to)=@_;
   my $status='';    my $status='';
Line 294  sub send_msg { Line 346  sub send_msg {
     if ($_) {      if ($_) {
       my $declutter=&Apache::lonnet::declutter($feedurl);        my $declutter=&Apache::lonnet::declutter($feedurl);
       unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),        unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
                'Feedback ['.$declutter.']',$email,$citations) eq 'ok') {                 'Feedback ['.$declutter.']',$email,$citations,$feedurl)=~/ok/) {
  $status.='<br>Error sending message to '.$_.'<br>';   $status.='<br>Error sending message to '.$_.'<br>';
       } else {        } else {
  $sendsomething++;   $sendsomething++;
Line 317  sub send_msg { Line 369  sub send_msg {
 }  }
   
 sub adddiscuss {  sub adddiscuss {
     my ($symb,$email,$anon)=@_;      my ($symb,$email,$anon,$attachmenturl)=@_;
     my $status='';      my $status='';
     if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.      if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
         ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {          ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
Line 329  sub adddiscuss { Line 381  sub adddiscuss {
                  'plainname'    => $ENV{'environment.firstname'}.' '.                   'plainname'    => $ENV{'environment.firstname'}.' '.
                    $ENV{'environment.middlename'}.' '.                     $ENV{'environment.middlename'}.' '.
                                    $ENV{'environment.lastname'}.' '.                                     $ENV{'environment.lastname'}.' '.
                                    $ENV{'enrironment.generation'});                                     $ENV{'enrironment.generation'},
                    'attachment'   => $attachmenturl);
     if ($anon) {      if ($anon) {
  $contrib{'anonymous'}='true';   $contrib{'anonymous'}='true';
     }      }
Line 390  sub handler { Line 443  sub handler {
 # --------------------------- Get query string for limited number of parameters  # --------------------------- Get query string for limited number of parameters
   
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                        ['hide','unhide','postdata','preview']);                               ['hide','unhide','deldisc','postdata','preview']);
   
   if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {    if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
 # ----------------------------------------------------------------- Hide/unhide  # ----------------------------------------------------------------- Hide/unhide
Line 422  sub handler { Line 475  sub handler {
   
     &redirect_back($r,&Apache::lonnet::clutter($url),      &redirect_back($r,&Apache::lonnet::clutter($url),
        'Changed discussion status<p>','0','0');         'Changed discussion status<p>','0','0');
     } elsif ($ENV{'form.deldisc'}) {
   # --------------------------------------------------------------- Hide for good
       $r->content_type('text/html');
       $r->send_http_header;
   
       my $entry=$ENV{'form.deldisc'};
   
       my ($symb,$idx)=split(/\:\:\:/,$entry);
       my ($map,$ind,$url)=split(/\_\_\_/,$symb);
   
       my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
                        $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
        $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
   
           
       my $currentdeleted=$contrib{'deleted'};
       
       $currentdeleted.='.'.$idx.'.';
   
       my %newhash=('deleted' => $currentdeleted);
   
       &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
                        $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
        $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
   
       &redirect_back($r,&Apache::lonnet::clutter($url),
          'Changed discussion status<p>','0','0');
   } elsif ($ENV{'form.preview'}) {    } elsif ($ENV{'form.preview'}) {
 # -------------------------------------------------------- User wants a preview  # -------------------------------------------------------- User wants a preview
       &show_preview($r);        &show_preview($r);
Line 477  sub handler { Line 557  sub handler {
 # Get output from resource  # Get output from resource
       my $usersaw=&resource_output($feedurl);        my $usersaw=&resource_output($feedurl);
   
   # Get resource answer
         my $useranswer=&Apache::loncommon::get_student_answers(
                          $symb,$ENV{'user.name'},$ENV{'user.domain'},
          $ENV{'request.course.id'});
   # Get attachments, if any, and not too large
         my $attachmenturl='';
         if ($ENV{'form.attachment.filename'}) {
     unless (length($ENV{'form.attachment'})>131072) {
         $attachmenturl=&Apache::lonnet::userfileupload('attachment',1);
     }
         }
 # Filter HTML out of message (could be nasty)  # Filter HTML out of message (could be nasty)
       my $message=&clear_out_html;        my $message=&clear_out_html($ENV{'form.comment'});
   
 # Assemble email  # Assemble email
       my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,        my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
           $usersaw);            $usersaw,$useranswer);
    
 # Who gets this?  # Who gets this?
       my ($typestyle,%to) = &decide_receiver($feedurl);        my ($typestyle,%to) = &decide_receiver($feedurl);
   
Line 494  sub handler { Line 585  sub handler {
   
       my $numpost=0;        my $numpost=0;
       if ($ENV{'form.discuss'}) {        if ($ENV{'form.discuss'}) {
   $typestyle.=&adddiscuss($symb,$message);    $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl);
   $numpost++;    $numpost++;
       }        }
   
       if ($ENV{'form.anondiscuss'}) {        if ($ENV{'form.anondiscuss'}) {
   $typestyle.=&adddiscuss($symb,$message,1);    $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl);
   $numpost++;    $numpost++;
       }        }
   

Removed from v.1.33  
changed lines
  Added in v.1.42


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