Diff for /loncom/interface/lonfeedback.pm between versions 1.24 and 1.63

version 1.24, 2002/03/02 03:50:27 version 1.63, 2003/10/15 20:13:31
Line 50  use strict; Line 50  use strict;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonmsg();  use Apache::lonmsg();
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::lontexconvert();
   use Apache::lonlocal;
   
   sub list_discussion {
       my ($mode,$status,$symb)=@_;
       my $discussiononly=0;
       if ($mode eq 'board') { $discussiononly=1; }
       unless ($ENV{'request.course.id'}) { return ''; }
       my $crs='/'.$ENV{'request.course.id'};
       if ($ENV{'request.course.sec'}) {
    $crs.='_'.$ENV{'request.course.sec'};
       }                 
       $crs=~s/\_/\//g;
       unless ($symb) {
    $symb=&Apache::lonnet::symbread();
       }
       unless ($symb) { return ''; }
       my $seeid=&Apache::lonnet::allowed('rin',$crs);
       my $viewgrades=&Apache::lonnet::allowed('vgr',$crs);
       my $discussion='';
       my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
     $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
       if ($contrib{'version'}) {
    unless ($discussiononly) {
       $discussion.=
    '<address><hr />';
    }
    my $idx;
    for ($idx=1;$idx<=$contrib{'version'};$idx++) {
       my $hidden=($contrib{'hidden'}=~/\.$idx\./);
       my $deleted=($contrib{'deleted'}=~/\.$idx\./);
       unless ((($hidden) && (!$seeid)) || ($deleted)) {
    my $message=$contrib{$idx.':message'};
    $message=~s/\n/\<br \/\>/g;
    $message=&Apache::lontexconvert::msgtexconverted($message);
    if ($contrib{$idx.':attachmenturl'}) {
       my ($fname,$ft)
                           =($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/);
       $message.='<p>'.&mt('Attachment').': <a href="'.
    &Apache::lonnet::tokenwrapper(
                                                $contrib{$idx.':attachmenturl'}).
    '"><tt>'.$fname.'.'.$ft.'</tt></a></p>';
    }
    if ($message) {
       if ($hidden) {
    $message='<font color="#888888">'.$message.'</font>';
       }
       my $screenname=&Apache::loncommon::screenname(
       $contrib{$idx.':sendername'},
       $contrib{$idx.':senderdomain'});
       my $plainname=&Apache::loncommon::nickname(
       $contrib{$idx.':sendername'},
       $contrib{$idx.':senderdomain'});
       
       my $sender=&mt('Anonymous');
       if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
    $sender=&Apache::loncommon::aboutmewrapper(
    $plainname,
    $contrib{$idx.':sendername'},
    $contrib{$idx.':senderdomain'}).' ('.
    $contrib{$idx.':sendername'}.' at '.
    $contrib{$idx.':senderdomain'}.')';
    if ($contrib{$idx.':anonymous'}) {
       $sender.=' ['.&mt('anonymous').'] '.
    $screenname;
    }
    if ($seeid) {
       if ($hidden) {
    $sender.=' <a href="/adm/feedback?unhide='.
       $symb.':::'.$idx.'">'.&mt('Make Visible').'</a>';
       } else {
    $sender.=' <a href="/adm/feedback?hide='.
       $symb.':::'.$idx.'">'.&mt('Hide').'</a>';
       }                     
       $sender.=' <a href="/adm/feedback?deldisc='.
    $symb.':::'.$idx.'">'.&mt('Delete').'</a>';
    }
       } else {
    if ($screenname) {
       $sender='<i>'.$screenname.'</i>';
    }
       }
       my $vgrlink;
       if ($viewgrades) {
    $vgrlink=&Apache::loncommon::submlink('Submissions',
               $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
       }
       $discussion.='<p><b>'.$sender.'</b> '.$vgrlink.' ('.
    localtime($contrib{$idx.':timestamp'}).
    '):<blockquote>'.$message.
    '</blockquote></p>';
           }
       } 
    }
    unless ($discussiononly) {
       $discussion.='</address>';
    }
       }
       if ($discussiononly) {
    $discussion.=(<<ENDDISCUSS);
   <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
   <input type="submit" name="discuss" value="Post Discussion" />
   <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
   <input type="hidden" name="symb" value="$symb" />
   <input type="hidden" name="sendit" value="true" />
   <br />
   <font size="1">Note: in anonymous discussion, your name is visible only to
   course faculty</font><br />
   <textarea name="comment" cols="60" rows="10" wrap="hard"></textarea>
   <p>
   Attachment (128 KB max size): <input type="file" name="attachment" />
   </p>
   </form>
   ENDDISCUSS
         $discussion.=&generate_preview_button();
      }
      return $discussion;
   }
   
 sub mail_screen {  sub mail_screen {
   my ($r,$feedurl,$options) = @_;    my ($r,$feedurl,$options) = @_;
     my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion',
                                             '','onLoad="window.focus();"');
     my $title=&Apache::lonnet::gettitle($feedurl);
     if (!$title) { $title = $feedurl; }
     my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
   $r->print(<<ENDDOCUMENT);    $r->print(<<ENDDOCUMENT);
 <html>  <html>
 <head>  <head>
 <title>The LearningOnline Network with CAPA</title>  <title>The LearningOnline Network with CAPA</title>
 <meta http-equiv="pragma" content="no-cache"></meta>  <meta http-equiv="pragma" content="no-cache"></meta>
 <script>  <script type="text/javascript">
   //<!--
     function gosubmit() {      function gosubmit() {
         var rec=0;          var rec=0;
         if (typeof(document.mailform.elements.author)!="undefined") {          if (typeof(document.mailform.elements.author)!="undefined") {
Line 98  sub mail_screen { Line 223  sub mail_screen {
             alert('Please check a feedback type.');              alert('Please check a feedback type.');
  }   }
     }      }
   //-->
 </script>  </script>
 </head>  </head>
 <body bgcolor="#FFFFFF" onLoad="window.focus();">  $bodytag
 <img align=right src=/adm/lonIcons/lonlogos.gif>  <h2><tt>$title</tt></h2>
 <h1>Feedback</h1>  <form action="/adm/feedback" method="post" name="mailform"
 <h2><tt>$feedurl</tt></h2>  enctype="multipart/form-data">
 <form action="/adm/feedback" method=post name=mailform>  <input type="hidden" name="postdata" value="$feedurl" />
 <input type=hidden name=postdata value="$feedurl">  
 Please check at least one of the following feedback types:  Please check at least one of the following feedback types:
 $options<hr>  $options<hr />
 My question/comment/feedback:<p>  <p>My question/comment/feedback:</p>
 <textarea name=comment cols=60 rows=10 wrap=hard>  <p>
 </textarea><p>  $latexHelp
 <input type=hidden name=sendit value=1>  <textarea name="comment" cols="60" rows="10" wrap="hard">
 <input type=button value="Send Feedback" onClick='gosubmit();'></input>  </textarea></p>
   <p>
   Attachment (128 KB max size): <input type="file" name="attachment" />
   </p>
   <p>
   <input type="hidden" name="sendit" value="1" />
   <input type="button" value="Send Feedback" onClick='gosubmit();' />
   </p>
 </form>  </form>
 </body>  
 </html>  
 ENDDOCUMENT  ENDDOCUMENT
   $r->print(&generate_preview_button().'</body></html>');
 }  }
   
 sub fail_redirect {  sub fail_redirect {
   my ($r,$feedurl) = @_;    my ($r,$feedurl) = @_;
   $r->print (<<ENDFAILREDIR);    $r->print (<<ENDFAILREDIR);
 <head><title>Feedback not sent</title>  <head><title>Feedback not sent</title>
 <meta http-equiv="pragma" content="no-cache"></meta>  <meta http-equiv="pragma" content="no-cache" />
 <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">  <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
 </head>  </head>
 <html>  <html>
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF">
 <img align=right src=/adm/lonIcons/lonlogos.gif>  <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 <b>Sorry, no recipients  ...</b>  <b>Sorry, no recipients  ...</b>
 </body>  </body>
 </html>  </html>
Line 136  ENDFAILREDIR Line 267  ENDFAILREDIR
 }  }
   
 sub redirect_back {  sub redirect_back {
   my ($r,$feedurl,$typestyle,$sendsomething,$status) = @_;    my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status) = @_;
   $r->print (<<ENDREDIR);    $r->print (<<ENDREDIR);
 <head>  <head>
 <title>Feedback sent</title>  <title>Feedback sent</title>
 <meta http-equiv="pragma" content="no-cache"></meta>  <meta http-equiv="pragma" content="no-cache" />
 <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">  <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
 </head>  </head>
 <html>  <html>
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
 <img align=right src=/adm/lonIcons/lonlogos.gif>  <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 $typestyle  $typestyle
 <b>Sent $sendsomething message(s).</b>  <b>Sent $sendsomething message(s), and $sendposts post(s).</b>
 <font color=red>$status</font>  <font color="red">$status</font>
   <form name="reldt" action="$feedurl" target="loncapaclient">
   </form>
 </body>  </body>
 </html>  </html>
 ENDREDIR  ENDREDIR
Line 158  sub no_redirect_back { Line 291  sub no_redirect_back {
   my ($r,$feedurl) = @_;    my ($r,$feedurl) = @_;
   $r->print (<<ENDNOREDIR);    $r->print (<<ENDNOREDIR);
 <head><title>Feedback not sent</title>  <head><title>Feedback not sent</title>
 <meta http-equiv="pragma" content="no-cache"></meta>  <meta http-equiv="pragma" content="no-cache" />
 ENDNOREDIR  ENDNOREDIR
   
   if ($feedurl!~/^\/adm\/feedback/) {     if ($feedurl!~/^\/adm\/feedback/) { 
Line 168  ENDNOREDIR Line 301  ENDNOREDIR
   $r->print (<<ENDNOREDIRTWO);    $r->print (<<ENDNOREDIRTWO);
 </head>  </head>
 <html>  <html>
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
 <img align=right src=/adm/lonIcons/lonlogos.gif>  <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 <b>Sorry, no feedback possible on this resource  ...</b>  <b>Sorry, no feedback possible on this resource  ...</b>
 </body>  </body>
 </html>  </html>
Line 178  ENDNOREDIRTWO Line 311  ENDNOREDIRTWO
   
 sub screen_header {  sub screen_header {
   my ($feedurl) = @_;    my ($feedurl) = @_;
   my $options='';    my $msgoptions='';
   if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) {    my $discussoptions='';
     $options=     if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
       '<p><input type=checkbox name=author> Feedback to resource author';      $msgoptions= 
   }        '<p><input type="checkbox" name="author" /> '.
   if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) {        &mt('Feedback to resource author').'</p>';
     $options.=    }
     '<br><input type=checkbox name=question> Question about resource content';    if (&feedback_available(1)) {
   }      $msgoptions.=
   if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) {      '<br /><input type="checkbox" name="question" /> '.
     $options.=      &mt('Question about resource content');
       '<br><input type=checkbox name=course> '.    }
  'Question/Comment/Feedback about course content';    if (&feedback_available(0,1)) {
   }      $msgoptions.=
   if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) {        '<br /><input type="checkbox" name="course" /> '.
     $options.=   &mt('Question/Comment/Feedback about course content');
       '<br><input type=checkbox name=policy> '.    }
  'Question/Comment/Feedback about course policy';    if (&feedback_available(0,0,1)) {
       $msgoptions.=
         '<br /><input type="checkbox" name="policy" /> '.
    &mt('Question/Comment/Feedback about course policy');
   }    }
   
   if ($ENV{'request.course.id'}) {    if ($ENV{'request.course.id'}) {
       if (&Apache::lonnet::allowed('pch',        if (&Apache::lonnet::allowed('pch',
         $ENV{'request.course.id'}.          $ENV{'request.course.id'}.
         ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {          ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
     $options.='<br><input type=checkbox name=discuss> '.      $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" /> '.
  '<b>Contribution to course discussion of resource</b>';   &mt('Contribution to course discussion of resource');
     $options.='<br><input type=checkbox name=anondiscuss> '.      $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
  '<b>Anonymous contribution to course discussion of resource</b>'.   &mt('Anonymous contribution to course discussion of resource').
         ' (name only visible to course faculty)';          ' <i>('.&mt('name only visible to course faculty').')</i>';
       }        }
   }    }
   return $options;    if ($msgoptions) { $msgoptions='<h2>'.&mt('Sending Messages').'</h2>'.$msgoptions; }
     if ($discussoptions) { 
        $discussoptions='<h2>'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
     return $msgoptions.$discussoptions;
 }  }
   
 sub resource_output {  sub resource_output {
   my ($feedurl) = @_;    my ($feedurl) = @_;
   my $usersaw=&Apache::lonnet::ssi($feedurl);    my $usersaw=&Apache::lonnet::ssi_body($feedurl);
   $usersaw=~s/\<body[^\>]*\>//gi;    $usersaw=~s/\<body[^\>]*\>//gi;
   $usersaw=~s/\<\/body\>//gi;    $usersaw=~s/\<\/body\>//gi;
   $usersaw=~s/\<html\>//gi;    $usersaw=~s/\<html\>//gi;
Line 226  sub resource_output { Line 365  sub resource_output {
 }  }
   
 sub clear_out_html {  sub clear_out_html {
   my $message=$ENV{'form.comment'};    my ($message,$override)=@_;
   $message=~s/\</\&lt\;/g;    my $cid=$ENV{'request.course.id'};
   $message=~s/\>/\&gt\;/g;    if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
         ($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,
                   M=>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/\</\&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 242  ENDEMAIL Line 396  ENDEMAIL
     my $citations=<<"ENDCITE";      my $citations=<<"ENDCITE";
 <h2>Previous attempts of student (if applicable)</h2>  <h2>Previous attempts of student (if applicable)</h2>
 $prevattempts  $prevattempts
 <p><hr>  <br /><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,$attachmenturl,%to)=@_;
   my $status='';    my $status='';
   my $sendsomething=0;    my $sendsomething=0;
   foreach (keys %to) {    foreach (keys %to) {
     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,
  $status.='<br>Error sending message to '.$_.'<br>';                  $attachmenturl)=~/ok/) {
    $status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
       } else {        } else {
  $sendsomething++;   $sendsomething++;
       }        }
Line 308  sub send_msg { Line 497  sub send_msg {
        $newrecord{'resource'}=$feedurl;         $newrecord{'resource'}=$feedurl;
        $newrecord{'subnumber'}=$record{'subnumber'}+1;         $newrecord{'subnumber'}=$record{'subnumber'}+1;
        unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {         unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
    $status.='<br>Not registered<br>';     $status.='<br />'.&mt('Not registered').'<br />';
        }         }
     }      }
                 
Line 316  sub send_msg { Line 505  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'}:''))) {
   
     my %contrib=('message'      => $email,      my %contrib=('message'      => $email,
                  'sendername'   => $ENV{'user.name'},                   'sendername'   => $ENV{'user.name'},
                  'senderdomain' => $ENV{'user.domain'});                   'senderdomain' => $ENV{'user.domain'},
                    'screenname'   => $ENV{'environment.screenname'},
                    'plainname'    => $ENV{'environment.firstname'}.' '.
                      $ENV{'environment.middlename'}.' '.
                                      $ENV{'environment.lastname'}.' '.
                                      $ENV{'enrironment.generation'},
                    'attachmenturl'=> $attachmenturl);
     if ($anon) {      if ($anon) {
  $contrib{'anonymous'}='true';   $contrib{'anonymous'}='true';
     }      }
Line 333  sub adddiscuss { Line 528  sub adddiscuss {
                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},                       $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});       $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
         my %storenewentry=($symb => time);          my %storenewentry=($symb => time);
         $status.='<br>Updating discussion time: '.          $status.='<br />'.&mt('Updating discussion time').': '.
         &Apache::lonnet::put('discussiontimes',\%storenewentry,          &Apache::lonnet::put('discussiontimes',\%storenewentry,
                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},                       $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});       $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
Line 344  sub adddiscuss { Line 539  sub adddiscuss {
        my %newrecord=();         my %newrecord=();
        $newrecord{'resource'}=$symb;         $newrecord{'resource'}=$symb;
        $newrecord{'subnumber'}=$record{'subnumber'}+1;         $newrecord{'subnumber'}=$record{'subnumber'}+1;
        $status.='<br>Registering: '.         $status.='<br />'.&mt('Registering').': '.
                &Apache::lonnet::cstore(\%newrecord,'_discussion');                 &Apache::lonnet::cstore(\%newrecord,'_discussion');
     }      }
     } else {      } else {
  $status.='Failed.';   $status.='Failed.';
     }      }
     return $status.'<br>';         return $status.'<br />';   
 }  }
   
   # ----------------------------------------------------------- Preview function
   
   sub show_preview {
       my $r=shift;
       my $message=&clear_out_html($ENV{'form.comment'});
       $message=~s/\n/\<br \/\>/g;
       $message=&Apache::lontexconvert::msgtexconverted($message);
       $r->print('<table border="2"><tr><td>'.
          $message.'</td></tr></table>');
   }
   
   sub generate_preview_button {
       return(<<ENDPREVIEW);
   <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
   <input type="hidden" name="comment" />
   <input type="button" value="Show Preview"
   onClick="this.form.comment.value=document.mailform.comment.value;this.form.submit();" />
   </form>
   ENDPREVIEW
   }
 sub handler {  sub handler {
   my $r = shift;    my $r = shift;
   if ($r->header_only) {    if ($r->header_only) {
Line 363  sub handler { Line 578  sub handler {
   
 # --------------------------- Get query string for limited number of parameters  # --------------------------- Get query string for limited number of parameters
   
     foreach (split(/&/,$ENV{'QUERY_STRING'})) {     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
        my ($name, $value) = split(/=/,$_);                               ['hide','unhide','deldisc','postdata','preview']);
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        if (($name eq 'hide') || ($name eq 'unhide')) {  
            unless ($ENV{'form.'.$name}) {  
               $ENV{'form.'.$name}=$value;  
    }  
        }  
     }  
   
   if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {    if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
 # ----------------------------------------------------------------- Hide/unhide  # ----------------------------------------------------------------- Hide/unhide
Line 382  sub handler { Line 589  sub handler {
     my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};      my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
   
     my ($symb,$idx)=split(/\:\:\:/,$entry);      my ($symb,$idx)=split(/\:\:\:/,$entry);
     my ($map,$ind,$url)=split(/\_\_\_/,$symb);      my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
   
     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},      my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},                       $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
Line 402  sub handler { Line 609  sub handler {
                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},                       $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});       $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
   
     &redirect_back($r,'/res/'.$url,'Changed discussion status<p>','0');      &redirect_back($r,&Apache::lonnet::clutter($url),
          &mt('Changed discussion status').'<br />','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)=&Apache::lonnet::decode_symb($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),
          &mt('Changed discussion status').'<br />','0','0');
     } elsif ($ENV{'form.preview'}) {
   # -------------------------------------------------------- User wants a preview
         &show_preview($r);
   } else {    } else {
 # ------------------------------------------------------------- Normal feedback  # ------------------------------------------------------------- Normal feedback
   my $feedurl=$ENV{'form.postdata'};    my $feedurl=$ENV{'form.postdata'};
   $feedurl=~s/^http\:\/\///;    $feedurl=~s/^http\:\/\///;
   $feedurl=~s/^$ENV{'SERVER_NAME'}//;    $feedurl=~s/^$ENV{'SERVER_NAME'}//;
   $feedurl=~s/^$ENV{'HTTP_HOST'}//;    $feedurl=~s/^$ENV{'HTTP_HOST'}//;
     $feedurl=~s/\?.+$//;
   
   my $symb=&Apache::lonnet::symbread($feedurl);    my $symb=&Apache::lonnet::symbread($feedurl);
     unless ($symb) {
         $symb=$ENV{'form.symb'};
         if ($symb) {
     my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
             $feedurl=&Apache::lonnet::clutter($url);
         }
     }
   my $goahead=1;    my $goahead=1;
   if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {    if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
       unless ($symb) { $goahead=0; }        unless ($symb) { $goahead=0; }
Line 429  sub handler { Line 673  sub handler {
       )         ) 
       ||         || 
       ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))        ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
         ||
         ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
      ) {       ) {
 # --------------------------------------------------- Print login screen header  # --------------------------------------------------- Print login screen header
     unless ($ENV{'form.sendit'}) {      unless ($ENV{'form.sendit'}) {
Line 448  sub handler { Line 694  sub handler {
 # Get output from resource  # Get output from resource
       my $usersaw=&resource_output($feedurl);        my $usersaw=&resource_output($feedurl);
   
   # Get resource answer (need to allow student to view grades for this to work)
         &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
         my $useranswer=&Apache::loncommon::get_student_answers(
                          $symb,$ENV{'user.name'},$ENV{'user.domain'},
          $ENV{'request.course.id'});
         &Apache::lonnet::delenv('allowed.vgr');
   # 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');
     }
         }
 # 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);
   
 # Actually send mail  # Actually send mail
       my ($status,$numsent)=&send_msg($feedurl,$email,$citations,%to);        my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
             $attachmenturl,%to);
   
 # Discussion? Store that.  # Discussion? Store that.
   
         my $numpost=0;
       if ($ENV{'form.discuss'}) {        if ($ENV{'form.discuss'}) {
   $typestyle.=&adddiscuss($symb,$message);    $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl);
     $numpost++;
       }        }
   
       if ($ENV{'form.anondiscuss'}) {        if ($ENV{'form.anondiscuss'}) {
   $typestyle.=&adddiscuss($symb,$message,1);    $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl);
     $numpost++;
       }        }
   
   
 # Receipt screen and redirect back to where came from  # Receipt screen and redirect back to where came from
       &redirect_back($r,$feedurl,$typestyle,$numsent,$status);        &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status);
   
     }      }
    } else {     } else {
Line 482  sub handler { Line 745  sub handler {
    }     }
   } else {    } else {
 # Ambiguous Problem Resource  # Ambiguous Problem Resource
     $r->internal_redirect('/adm/ambiguous');        if ( &Apache::lonnet::mod_perl_version() == 2 ) {
     &Apache::lonnet::cleanenv();
         }
         $r->internal_redirect('/adm/ambiguous');
   }    }
 }  }
   return OK;    return OK;
Line 490  sub handler { Line 756  sub handler {
   
 1;  1;
 __END__  __END__
   
   
   
   

Removed from v.1.24  
changed lines
  Added in v.1.63


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