![]() ![]() | ![]() |
- lots of \w -> probper regexp replacements
1: # The LearningOnline Network 2: # Evaluate 3: # 4: # $Id: lonevaluate.pm,v 1.20 2006/12/05 02:55:52 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::lonevaluate; 30: 31: use strict; 32: use Apache::lonnet; 33: use Apache::Constants qw(:common); 34: use Apache::loncommon(); 35: use Apache::lonenc(); 36: use LONCAPA(); 37: 38: sub handler { 39: my $r = shift; 40: &Apache::loncommon::content_type($r,'text/html'); 41: &Apache::loncommon::no_cache($r); 42: 43: $r->send_http_header; 44: return OK if $r->header_only; 45: 46: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['postdata']); 47: my $feedurl=$env{'form.postdata'}; 48: $feedurl=~s/^http\:\/\///; 49: $feedurl=~s/^$ENV{'SERVER_NAME'}//; 50: $feedurl=~s/^$ENV{'HTTP_HOST'}//; 51: 52: $feedurl=&Apache::lonnet::declutter($feedurl); 53: 54: my $title=&Apache::lonnet::gettitle($feedurl); 55: my $showurl=&Apache::lonenc::check_encrypt($feedurl); 56: 57: my ($rdomain,$rauth)=($feedurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\//); 58: 59: my $prefix=$env{'user.name'}.'@'.$env{'user.domain'}.'___'. 60: $feedurl.'___'; 61: 62: my @items=('correct','helpful','depth','clear','technical','comments', 63: 'timestamp'); 64: 65: my @retrieve=map{ $prefix.$_ } @items; 66: 67: my %currenteval= 68: &Apache::lonnet::get('nohist_resevaldata',\@retrieve,$rdomain,$rauth); 69: 70: my $already=($currenteval{$prefix.'timestamp'} ne ''); 71: 72: $env{'form.timestamp'}=time; 73: 74: my $warning=''; 75: 76: if ($env{'form.submiteval'} eq 'true') { 77: # ------------------------------------------------ User is submitting something 78: my $complete=1; 79: foreach my $item (@items) { 80: if ($env{'form.'.$item}) { 81: $currenteval{$prefix.$item}=$env{'form.'.$item}; 82: } elsif ($item ne 'comments') { 83: $complete=0; 84: } 85: } 86: if ($complete) { 87: my $showurl=&Apache::lonenc::check_encrypt(&Apache::lonnet::clutter($feedurl)); 88: my $js =<<ENDJS; 89: <script type="text/javascript"> 90: function goback() { 91: if ((window.name=='loncapaclient')) { 92: window.location='$showurl'; 93: } else { 94: self.close(); 95: } 96: } 97: </script> 98: ENDJS 99: 100: my $start_page = 101: &Apache::loncommon::start_page('Evaluate Resource',$js); 102: $r->print(<<ENDHEADER); 103: $start_page 104: <h1>Thank you for your input!</h1> 105: ENDHEADER 106: $r->print('Storing feedback: '. 107: &Apache::lonnet::put('nohist_resevaldata',\%currenteval,$rdomain,$rauth)); 108: unless ($already) { 109: $r->print('<br />Logging first evaluation'); 110: } 111: $r->print( 112: '<script type="text/javascript">setTimeout("goback()",2000);</script>'.&Apache::loncommon::end_page()); 113: return OK; 114: } else { 115: $warning='Please fill out all fields below'; 116: } 117: 118: } 119: 120: # ---------------------------------------------------------- Dial in old values 121: my $dialold=''; 122: my $oldcomments=''; 123: 124: foreach my $item (@items) { 125: unless ($item eq 'comments') { 126: unless (($item eq 'timestamp') || 127: (!defined($currenteval{$prefix.$item}))) { 128: $dialold.= 129: 'document.evaluation.'.$item.'.selectedIndex='. 130: $currenteval{$prefix.$item}.";\n"; 131: } 132: } else { 133: $oldcomments=$currenteval{$prefix.$item}; 134: } 135: } 136: # ------------------------------------------------------- Print out eval screen 137: my $standardoptions=(<<ENDOPTIONS); 138: <option value="0">-</option> 139: <option value="1">Strongly Disagree</option> 140: <option value="2">Disagree</option> 141: <option value="3">Neutral</option> 142: <option value="4">Agree</option> 143: <option value="5">Strongly Agree</option> 144: ENDOPTIONS 145: 146: my $start_page = &Apache::loncommon::start_page('Evaluate Resource'); 147: my $end_page = &Apache::loncommon::end_page(); 148: $r->print(<<ENDDOCUMENT); 149: $start_page 150: <tt>$title</tt><br /><br /> 151: <h3><font color="red">$warning</font></h3> 152: Please rank the following criteria: 153: <form method="post" name="evaluation" action="/adm/evaluate"> 154: <input type="hidden" name="submiteval" value="true" /> 155: <input type="hidden" name="postdata" value="$showurl" /> 156: The material appears to be correct 157: <br /><select name="correct"> 158: $standardoptions 159: </select> 160: <hr /> 161: The material is helpful 162: <br /><select name="helpful"> 163: $standardoptions 164: </select> 165: <hr /> 166: The material is covered with sufficient depth 167: <br /><select name="depth"> 168: $standardoptions 169: </select> 170: <hr /> 171: The material is presented in a clear way 172: <br /><select name="clear"> 173: $standardoptions 174: </select> 175: <hr /> 176: The resource is technically correct 177: (loads fast enough, does not produce errors, links work, etc) 178: <br /><select name="technical"> 179: $standardoptions 180: </select> 181: <hr /> 182: Any comments? 183: <br /><textarea name="comments" cols="40" rows="5">$oldcomments</textarea> 184: <script type="text/javascript">$dialold</script> 185: <br /><input type="submit" value="Submit Evaluation" /> 186: </form> 187: $end_page 188: ENDDOCUMENT 189: return OK; 190: } 191: 192: 1; 193: __END__