[BACK]Return to lonfeedback.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonfeedback.pm between versions 1.13 and 1.55

version 1.13, 2001/07/26 23:26:56 version 1.55, 2003/09/15 13:38:19
Line 1 Line 1
 # The LearningOnline Network  # The LearningOnline Network
 # Feedback  # Feedback
 #  #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
 # (Internal Server Error Handler  # (Internal Server Error Handler
 #  #
 # (Login Screen  # (Login Screen
Line 15 Line 39
 # 2/13 Guy Albertelli  # 2/13 Guy Albertelli
 # 7/25 Gerd Kortemeyer  # 7/25 Gerd Kortemeyer
 # 7/26 Guy Albertelli  # 7/26 Guy Albertelli
 # 7/26 Gerd Kortemeyer  # 7/26,8/10,10/1,11/5,11/6,12/27,12/29 Gerd Kortemeyer
   # YEAR=2002
   # 1/1,1/16 Gerd Kortemeyer
   #
   
 package Apache::lonfeedback;  package Apache::lonfeedback;
   
Line 24  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();
   
   sub list_discussion {
       my ($discussiononly,$symb)=@_;
       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>Attachment: <a href="'.
    &Apache::lonnet::tokenwrapper(
                                                $contrib{$idx.':attachmenturl'}).
    '"><tt>'.$fname.'.'.$ft.'</tt></a>';
    }
    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='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.=' [anonymous] '.
    $screenname;
    }
    if ($seeid) {
       if ($hidden) {
    $sender.=' <a href="/adm/feedback?unhide='.
       $symb.':::'.$idx.'">Make Visible</a>';
       } else {
    $sender.=' <a href="/adm/feedback?hide='.
       $symb.':::'.$idx.'">Hide</a>';
       }                     
       $sender.=' <a href="/adm/feedback?deldisc='.
    $symb.':::'.$idx.'">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>
Line 60  sub mail_screen { Line 207  sub mail_screen {
              rec=1;               rec=1;
           }             } 
         }          }
           if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
             if (document.mailform.elements.anondiscuss.checked) {
                rec=1;
             } 
           }
   
         if (rec) {          if (rec) {
     document.mailform.submit();      document.mailform.submit();
Line 69  sub mail_screen { Line 221  sub mail_screen {
     }      }
 </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>  My question/comment/feedback:<p>
 <textarea name=comment cols=60 rows=10>  $latexHelp
   <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>
 </body>  
 </html>  
 ENDDOCUMENT  ENDDOCUMENT
   $r->print(&generate_preview_button().'</body></html>');
 }  }
   
 sub fail_redirect {  sub fail_redirect {
Line 105  ENDFAILREDIR Line 260  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>
Line 113  sub redirect_back { Line 268  sub redirect_back {
 <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 137  ENDNOREDIR Line 294  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>
Line 147  ENDNOREDIRTWO Line 304  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/)) {
       $msgoptions= 
       '<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.=      $msgoptions.=
     '<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.=      $msgoptions.=
       '<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.=      $msgoptions.=
       '<br><input type=checkbox name=policy> '.        '<br><input type=checkbox name=policy> '.
  'Question/Comment/Feedback about course policy';   'Question/Comment/Feedback about course policy';
   }    }
   
   if ($ENV{'request.course.id'}) {    if ($ENV{'request.course.id'}) {
     $options.='<br><input type=checkbox name=discuss> '.        if (&Apache::lonnet::allowed('pch',
  '<b>Contribution to course discussion of resource</b>';          $ENV{'request.course.id'}.
           ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
       $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;"> '.
    'Contribution to course discussion of resource';
       $discussoptions.='<br><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;"> '.
    'Anonymous contribution to course discussion of resource'.
           ' <i>(name only visible to course faculty)</i>';
         }
   }    }
   return $options;    if ($msgoptions) { $msgoptions='<h2>Sending Messages</h2>'.$msgoptions; }
     if ($discussoptions) { 
        $discussoptions='<h2>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 187  sub resource_output { Line 356  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);
   
         $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 206  $prevattempts Line 390  $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>';
     map {      foreach (split(/\,/,
       $to{$_}=1;     $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
     } split(/\,/,       ) {
     $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'});   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>';
     map {      foreach (split(/\,/,
       $to{$_}=1;     $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
     } split(/\,/,       ) {
     $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'});   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>';
     map {      foreach (split(/\,/,
       $to{$_}=1;     $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
     } split(/\,/,       ) {
     $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'});   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;
   map {    foreach (keys %to) {
     if ($_) {      if ($_) {
         my $declutter=&Apache::lonnet::declutter($feedurl);
       unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),        unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
                'Feedback '.$feedurl,$email,$citations) eq 'ok') {                 'Feedback ['.$declutter.']',$email,$citations,$feedurl,
                   $attachmenturl)=~/ok/) {
  $status.='<br>Error sending message to '.$_.'<br>';   $status.='<br>Error sending message to '.$_.'<br>';
       } else {        } else {
  #$status.='<br>Message sent to '.$_.'<br>';  
  $sendsomething++;   $sendsomething++;
       }        }
     }      }
   } keys %to;           }
   
       my %record=&Apache::lonnet::restore('_feedback');
       my ($temp)=keys %record;
       unless ($temp=~/^error\:/) {
          my %newrecord=();
          $newrecord{'resource'}=$feedurl;
          $newrecord{'subnumber'}=$record{'subnumber'}+1;
          unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
      $status.='<br>Not registered<br>';
          }
       }
          
   return ($status,$sendsomething);    return ($status,$sendsomething);
 }  }
   
 sub adddiscuss {  sub adddiscuss {
     my ($symb,$email)=@_;      my ($symb,$email,$anon,$attachmenturl)=@_;
     my $status='';      my $status='';
       if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
           ($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) {
    $contrib{'anonymous'}='true';
       }
     if (($symb) && ($email)) {      if (($symb) && ($email)) {
        $status='Adding to class discussion: '.         $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
         &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},          &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
                      $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'});
         '<br>';          my %storenewentry=($symb => time);
           $status.='<br>Updating discussion time: '.
           &Apache::lonnet::put('discussiontimes',\%storenewentry,
                        $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
        $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
     }      }
     return $status;         my %record=&Apache::lonnet::restore('_discussion');
       my ($temp)=keys %record;
       unless ($temp=~/^error\:/) {
          my %newrecord=();
          $newrecord{'resource'}=$symb;
          $newrecord{'subnumber'}=$record{'subnumber'}+1;
          $status.='<br>Registering: '.
                  &Apache::lonnet::cstore(\%newrecord,'_discussion');
       }
       } else {
    $status.='Failed.';
       }
       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 284  sub handler { Line 566  sub handler {
      $r->send_http_header;       $r->send_http_header;
      return OK;       return OK;
   }    }
     
   # --------------------------- Get query string for limited number of parameters
   
      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                ['hide','unhide','deldisc','postdata','preview']);
   
     if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
   # ----------------------------------------------------------------- Hide/unhide
       $r->content_type('text/html');
       $r->send_http_header;
   
       my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
   
       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 $currenthidden=$contrib{'hidden'};
       
       if ($ENV{'form.hide'}) {
    $currenthidden.='.'.$idx.'.';
       } else {
           $currenthidden=~s/\.$idx\.//g;
       }
       my %newhash=('hidden' => $currenthidden);
   
       &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.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),
          'Changed discussion status<p>','0','0');
     } elsif ($ENV{'form.preview'}) {
   # -------------------------------------------------------- User wants a preview
         &show_preview($r);
     } else {
   # ------------------------------------------------------------- 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'}//;
   
   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 307  sub handler { Line 663  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 326  sub handler { Line 684  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'}) {
     $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 355  sub handler { Line 735  sub handler {
    }     }
   } else {    } else {
 # Ambiguous Problem Resource  # Ambiguous Problem Resource
     $r->internal_redirect('/adm/ambiguous');        if ( Apache::exists_config_define("MODPERL2") ) {
     &Apache::lonnet::cleanenv();
         }
         $r->internal_redirect('/adm/ambiguous');
   }    }
   }
   return OK;    return OK;
 }   } 
   
 1;  1;
 __END__  __END__
   
   
   
Removed from v.1.13  
changed lines
  Added in v.1.55

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.