![]() ![]() | ![]() |
- added a showhashsubset debugging function
1: # The LearningOnline Network with CAPA 2: # The LON-CAPA Homework handler 3: # 4: # $Id: lonhomework.pm,v 1.79 2002/05/24 18:55:23 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: # Guy Albertelli 29: # 11/30 Gerd Kortemeyer 30: # 6/1,8/17,8/18 Gerd Kortemeyer 31: 32: package Apache::lonhomework; 33: use strict; 34: use Apache::style(); 35: use Apache::lonxml(); 36: use Apache::lonnet(); 37: use Apache::lonplot(); 38: use Apache::inputtags(); 39: use Apache::structuretags(); 40: use Apache::randomlabel(); 41: use Apache::response(); 42: use Apache::hint(); 43: use Apache::outputtags(); 44: use Apache::Constants qw(:common); 45: use HTML::Entities(); 46: #use Time::HiRes qw( gettimeofday tv_interval ); 47: 48: BEGIN { 49: &Apache::lonxml::register_insert(); 50: } 51: 52: sub get_target { 53: if ( $ENV{'request.state'} eq "published") { 54: if ( defined($ENV{'form.grade_target'}) 55: && ($Apache::lonhomework::viewgrades == 'F' )) { 56: return ($ENV{'form.grade_target'}); 57: } 58: if ( defined($ENV{'form.submitted'})) { 59: return ('grade', 'web'); 60: } else { 61: return ('web'); 62: } 63: } elsif ($ENV{'request.state'} eq "construct") { 64: if ( defined($ENV{'form.grade_target'}) ) { 65: return ($ENV{'form.grade_target'}); 66: } 67: if ( defined($ENV{'form.preview'})) { 68: if ( defined($ENV{'form.submitted'})) { 69: return ('grade', 'web'); 70: } else { 71: return ('web'); 72: } 73: } else { 74: if ( $ENV{'form.problemmode'} eq 'View' ) { 75: if ( defined($ENV{'form.submitted'}) && 76: (!defined($ENV{'form.resetdata'})) ) { 77: return ('grade', 'web','answer'); 78: } else { 79: return ('web','answer'); 80: } 81: } elsif ( $ENV{'form.problemmode'} eq 'Edit' ) { 82: if ( $ENV{'form.submitted'} eq 'edit' ) { 83: return ('modified','edit'); 84: } else { 85: return ('edit'); 86: } 87: } else { 88: return ('web'); 89: } 90: } 91: } 92: return (); 93: } 94: 95: sub setup_vars { 96: my ($target) = @_; 97: return ';' 98: # return ';$external::target='.$target.';'; 99: } 100: 101: sub send_header { 102: my ($request)= @_; 103: $request->print(&Apache::lontexconvert::header()); 104: # $request->print('<form name='.$ENV{'form.request.prefix'}.'lonhomework method="POST" action="'.$request->uri.'">'); 105: } 106: 107: sub createmenu { 108: my ($which,$request)=@_; 109: if ($which eq 'grade') { 110: $request->print('<script language="JavaScript"> 111: hwkmenu=window.open("/res/adm/pages/homeworkmenu.html","homeworkremote", 112: "height=350,width=150,menubar=no"); 113: </script>'); 114: } 115: } 116: 117: sub send_footer { 118: my ($request)= @_; 119: # $request->print('</form>'); 120: $request->print(&Apache::lontexconvert::footer()); 121: } 122: 123: $Apache::lonxml::browse=''; 124: 125: sub check_access { 126: my ($id) = @_; 127: my $date =''; 128: my $status = ''; 129: my $datemsg = ''; 130: my $lastdate = ''; 131: my $temp; 132: my $type; 133: my $passed; 134: &Apache::lonxml::debug("checking for part :$id:"); 135: &Apache::lonxml::debug("time:".time); 136: foreach $temp ("opendate","duedate","answerdate") { 137: $lastdate = $date; 138: $date = &Apache::lonnet::EXT("resource.$id.$temp"); 139: &Apache::lonxml::debug("found :$date: for :$temp:"); 140: if ($date eq '') { 141: $date = "an unknown date"; $passed = 0; 142: } elsif ($date eq 'con_lost') { 143: $date = "an indeterminate date"; $passed = 0; 144: } else { 145: if (time < $date) { $passed = 0; } else { $passed = 1; } 146: $date = localtime $date; 147: } 148: if (!$passed) { $type=$temp; last; } 149: } 150: &Apache::lonxml::debug("have :$type:$passed:"); 151: if ($passed) { 152: $status='SHOW_ANSWER'; 153: $datemsg=$date; 154: } elsif ($type eq 'opendate') { 155: $status='CLOSED'; 156: $datemsg = "will open on $date"; 157: } elsif ($type eq 'duedate') { 158: $status='CAN_ANSWER'; 159: $datemsg = "is due at $date"; 160: } elsif ($type eq 'answerdate') { 161: $status='CLOSED'; 162: $datemsg = "was due on $lastdate, and answers will be available on $date"; 163: } 164: if ($status eq 'CAN_ANSWER') { 165: #check #tries 166: my $tries = $Apache::lonhomework::history{"resource.$id.tries"}; 167: my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries"); 168: if ( $tries eq '' ) { $tries = '0'; } 169: if ( $maxtries eq '' ) { $maxtries = '2'; } 170: if ($tries >= $maxtries) { $status = 'CANNOT_ANSWER'; } 171: } 172: 173: if (($status ne 'CLOSED') && ($Apache::lonhomework::type eq 'exam') && 174: (!$Apache::lonhomework::history{"resource.0.outtoken"})) { 175: return ('UNCHECKEDOUT','needs to be checked out'); 176: } 177: 178: 179: &Apache::lonxml::debug("sending back :$status:$datemsg:"); 180: if (($Apache::lonhomework::browse eq 'F') && ($status eq 'CLOSED')) { 181: &Apache::lonxml::debug("should be allowed to browse a resource when closed"); 182: $status='CAN_ANSWER'; 183: $datemsg='is closed but you are allowed to view it'; 184: } 185: if ($ENV{'request.state'} eq "construct") { 186: &Apache::lonxml::debug("in construction ignoring dates"); 187: $status='CAN_ANSWER'; 188: $datemsg='is in under construction'; 189: } 190: return ($status,$datemsg); 191: } 192: 193: sub showhash { 194: my (%hash) = @_; 195: &showhashsubset(\%hash,''); 196: return ''; 197: } 198: 199: sub showhashsubset { 200: my ($hash,$keyre) = @_; 201: my $resultkey; 202: foreach $resultkey (sort keys %$hash) { 203: if ($resultkey =~ /$keyre/) { 204: if (ref($$hash{$resultkey})) { 205: if ($$hash{$resultkey} =~ /ARRAY/ ) { 206: my $string="$resultkey ---- ("; 207: foreach my $elm (@{ $$hash{$resultkey} }) { 208: $string.="$elm,"; 209: } 210: chop($string); 211: &Apache::lonxml::debug("$string)"); 212: } else { 213: &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}"); 214: } 215: } else { 216: &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}"); 217: } 218: } 219: } 220: &Apache::lonxml::debug("\n<br />restored values^</br>\n"); 221: return ''; 222: } 223: 224: sub setuppermissions { 225: $Apache::lonhomework::browse= &Apache::lonnet::allowed('bre',$ENV{'request.filename'}); 226: $Apache::lonhomework::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); 227: return '' 228: } 229: 230: sub setupheader { 231: my $request=$_[0]; 232: if ($ENV{'browser.mathml'}) { 233: $request->content_type('text/xml'); 234: } else { 235: $request->content_type('text/html'); 236: } 237: if (!$Apache::lonxml::debug && ($ENV{'REQUEST_METHOD'} eq 'GET')) { 238: &Apache::loncommon::no_cache($request); 239: } 240: $request->send_http_header; 241: return OK if $request->header_only; 242: return '' 243: } 244: 245: sub handle_save_or_undo { 246: my ($request,$problem,$result) = @_; 247: my $file = &Apache::lonnet::filelocation("",$request->uri); 248: my $filebak =$file.".bak"; 249: my $filetmp =$file.".tmp"; 250: my $error=0; 251: 252: if ($ENV{'form.Undo'} eq 'undo') { 253: my $error=0; 254: if (!copy($file,$filetmp)) { $error=1; } 255: if ((!$error) && (!copy($filebak,$file))) { $error=1; } 256: if ((!$error) && (!move($filetmp,$filebak))) { $error=1; } 257: if (!$error) { 258: $request->print("<p><b>Undid changes, Switched $filebak and $file</b></p>"); 259: } else { 260: $request->print("<p><font color=\"red\" size=\"+1\"><b>Unable to undo, unable to switch $filebak and $file</b></font></p>"); 261: $error=1; 262: } 263: } else { 264: my $fs=Apache::File->new(">$filebak"); 265: if (defined($fs)) { 266: print $fs $$problem; 267: $request->print("<b>Making Backup to $filebak</b><br />"); 268: } else { 269: $request->print("<font color=\"red\" size=\"+1\"><b>Unable to make backup $filebak</b></font>"); 270: $error=2; 271: } 272: my $fh=Apache::File->new(">$file"); 273: if (defined($fh)) { 274: print $fh $$result; 275: $request->print("<b>Saving Modifications to $file</b><br />"); 276: } else { 277: $request->print("<font color=\"red\" size=\"+1\"><b>Unable to write to $file</b></font>"); 278: $error|=4; 279: } 280: } 281: return $error; 282: } 283: 284: sub analyze { 285: my ($request,$file) = @_; 286: &Apache::lonxml::debug("Analyze"); 287: my $result=&Apache::lonnet::ssi($request->uri,('grade_target' => 'analyze')); 288: &Apache::lonxml::debug(":$result:"); 289: (my $garbage,$result)=split(/_HASH_REF__/,$result,2); 290: &showhash(&Apache::lonnet::str2hash($result)); 291: return $result; 292: } 293: 294: sub editxmlmode { 295: my ($request,$file) = @_; 296: my $result; 297: my $problem=&Apache::lonnet::getfile($file); 298: if ($problem == -1) { 299: &Apache::lonxml::error("<b> Unable to find <i>$file</i></b>"); 300: $problem=''; 301: } 302: if (defined($ENV{'form.editxmltext'}) || defined($ENV{'form.Undo'})) { 303: my $error=&handle_save_or_undo($request,\$problem, 304: \$ENV{'form.editxmltext'}); 305: if (!$error) { $problem=&Apache::lonnet::getfile($file); } 306: } 307: my ($rows,$cols) = &Apache::edit::textarea_sizes(\$problem); 308: if ($cols > 80) { $cols = 80; } 309: $result.='<html><body bgcolor="#FFFFFF"> 310: <form name="lonhomework" method="POST" action="'. 311: $ENV{'request.uri'}.'"> 312: <input type="hidden" name="problemmode" value="EditXML" /> 313: <input type="submit" name="problemmode" value="View" /> 314: <input type="submit" name="problemmode" value="Edit" /> 315: <hr /> 316: <input type="submit" name="submit" value="Submit Changes" /> 317: <input type="submit" name="Undo" value="undo" /> 318: <hr /> 319: <textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'. 320: &HTML::Entities::encode($problem).'</textarea> 321: </form></body></html>'; 322: $request->print($result); 323: return ''; 324: } 325: 326: sub renderpage { 327: my ($request,$file) = @_; 328: 329: my (@targets) = &get_target(); 330: &Apache::lonxml::debug("Running targets ".join(':',@targets)); 331: foreach my $target (@targets) { 332: #my $t0 = [&gettimeofday()]; 333: my $problem=&Apache::lonnet::getfile($file); 334: if ($problem == -1) { 335: &Apache::lonxml::error("<b> Unable to find <i>$file</i></b>"); 336: $problem=''; 337: } 338: 339: my %mystyle; 340: my $result = ''; 341: &Apache::inputtags::initialize_inputtags; 342: &Apache::edit::initialize_edit; 343: if ($target eq 'analyze') { %Apache::lonhomework::anaylze=(); } 344: if ($target eq 'web') { 345: my ($symb)=&Apache::lonxml::whichuser(); 346: if ($symb eq '') { 347: if ($ENV{'request.state'} eq "construct") { 348: } else { 349: $request->print("Browsing or <a href=\"/adm/ambiguous\">ambiguous</a> reference, submissions ignored<br />"); 350: } 351: } 352: #if ($Apache::lonhomework::viewgrades eq 'F') {&createmenu('grade',$request); } 353: } 354: #if ($target eq 'grade') { &showhash(%Apache::lonhomework::history); } 355: #if ($target eq 'web') { &showhash(%ENV); } 356: 357: my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm'); 358: if ($default == -1) { 359: &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>"); 360: $default=''; 361: } 362: &Apache::lonxml::debug("Should be parsing now"); 363: $result = &Apache::lonxml::xmlparse($request, $target, $problem, 364: $default.&setup_vars($target),%mystyle); 365: 366: #$request->print("Result follows:"); 367: if ($target eq 'modified') { 368: &handle_save_or_undo($request,\$problem,\$result); 369: } else { 370: if ($target eq 'analyze') { 371: $result=&Apache::lonnet::hashref2str(\%Apache::lonhomework::analyze); 372: undef(%Apache::lonhomework::analyze); 373: } 374: #my $td=&tv_interval($t0); 375: #if ( $Apache::lonxml::debug) { 376: #$result =~ s:</body>::; 377: #$result.="<br />Spent $td seconds processing target $target\n</body>"; 378: #} 379: $request->print($result); 380: } 381: #$request->print(":Result ends"); 382: #my $td=&tv_interval($t0); 383: } 384: } 385: 386: # with no arg it returns a HTML <option> list of the template titles 387: # with one arg it returns the filename associated with the arg passed 388: sub get_template_list { 389: my ($namewanted,$extension) = @_; 390: my $result; 391: &Apache::lonxml::debug("Looking for :$extension:"); 392: foreach my $file (</home/httpd/html/res/adm/includes/templates/*.$extension>) { 393: my $name=&Apache::lonnet::metadata($file,'title'); 394: if ($namewanted && ($name eq $namewanted)) { 395: $result=$file; 396: last; 397: } else { 398: $result.="<option>$name</option>"; 399: } 400: } 401: return $result; 402: } 403: 404: sub newproblem { 405: my ($request) = @_; 406: my $extension=$request->uri; 407: $extension=~s:^.*\.([\w]+)$:$1:; 408: &Apache::lonxml::debug("Looking for :$extension:"); 409: if ($ENV{'form.template'}) { 410: use File::Copy; 411: my $file = &get_template_list($ENV{'form.template'},$extension); 412: my $dest = &Apache::lonnet::filelocation("",$request->uri); 413: copy($file,$dest); 414: &renderpage($request,$dest); 415: } elsif($ENV{'form.newfile'}) { 416: # I don't like hard-coded filenames but for now, this will work. 417: use File::Copy; 418: my $templatefilename = 419: $request->dir_config('lonIncludes').'/templates/blank.problem'; 420: &Apache::lonxml::debug("$templatefilename"); 421: my $dest = &Apache::lonnet::filelocation("",$request->uri); 422: copy($templatefilename,$dest); 423: &renderpage($request,$dest); 424: }else { 425: my $templatelist=&get_template_list('',$extension); 426: my $url=$request->uri; 427: my $dest = &Apache::lonnet::filelocation("",$request->uri); 428: if (!defined($templatelist)) { 429: # We didn't find a template, so just create a blank problem. 430: $request->print(<<ENDNEWPROBLEM); 431: <body bgcolor="#FFFFFF"> 432: The requested file $url doesn\'t exist. You can create a new $extension <br /> 433: <form action="$url" method="POST"> 434: <input type="submit" name="newfile" value="New $extension"><br /> 435: </form> 436: </body> 437: ENDNEWPROBLEM 438: return ''; 439: } 440: $request->print(<<ENDNEWPROBLEM); 441: <body bgcolor="#FFFFFF"> 442: The requested file $url doesn\'t exist. You can create a new $extension <br /> 443: <form action="$url" method="POST"> 444: <input type="submit" value="New $extension"><br /> 445: <select name="template"> 446: $templatelist 447: </select> 448: </form> 449: </body> 450: ENDNEWPROBLEM 451: } 452: return ''; 453: } 454: 455: sub view_or_edit_menu { 456: my ($request) = @_; 457: my $url=$request->uri; 458: $request->print(<<EDITMENU); 459: <body bgcolor="#FFFFFF"> 460: <form action="$url" method="POST"> 461: Would you like to <input type="submit" name="problemmode" value="View"> or 462: <input type="submit" name="problemmode" value="Edit"> the problem. 463: </form> 464: </body> 465: EDITMENU 466: } 467: 468: sub handler { 469: #my $t0 = [&gettimeofday()]; 470: my $request=$_[0]; 471: 472: if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} 473: 474: if (&setupheader($request)) { return OK; } 475: $ENV{'request.uri'}=$request->uri; 476: 477: #setup permissions 478: $Apache::lonhomework::browse= &Apache::lonnet::allowed('bre',$ENV{'request.filename'}); 479: $Apache::lonhomework::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); 480: &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:"); 481: # some times multiple problemmodes are submitted, need to select 482: # the last one 483: if ( defined($ENV{'form.problemmode'}) && 484: ref($ENV{'form.problemmode'}) ) { 485: my $mode=$ENV{'form.problemmode'}->[-1]; 486: undef $ENV{'form.problemmode'}; 487: $ENV{'form.problemmode'}=$mode; 488: } 489: &Apache::lonxml::debug("Problem Mode ".$ENV{'form.problemmode'}); 490: my $file=&Apache::lonnet::filelocation("",$request->uri); 491: 492: #check if we know where we are 493: if ($ENV{'request.course.fn'} && !&Apache::lonnet::symbread()) { 494: # if we are browsing we might not be able to know where we are 495: if ($Apache::lonhomework::browse ne 'F') { 496: #should know where we are, so ask 497: $request->internal_redirect('/adm/ambiguous'); return; 498: } 499: } 500: 501: if ($ENV{'request.state'} eq "construct") { 502: if ($ENV{'form.resetdata'} eq 'Reset Submissions') { 503: my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); 504: &Apache::lonnet::tmpreset($symb,'',$domain,$name); 505: } 506: if ( -e $file ) { 507: if (!(defined $ENV{'form.problemmode'})) { 508: #first visit to problem in construction space 509: #&view_or_edit_menu($request); 510: $ENV{'form.problemmode'}='View'; 511: &renderpage($request,$file); 512: } elsif ($ENV{'form.problemmode'} eq 'EditXML') { 513: &editxmlmode($request,$file); 514: } elsif ($ENV{'form.problemmode'} eq 'Answer Distribution') { 515: &analyze($request,$file); 516: } else { 517: &renderpage($request,$file); 518: } 519: } else { 520: # requested file doesn't exist in contruction space 521: &newproblem($request); 522: } 523: } else { 524: # just render the page normally outside of construction space 525: &Apache::lonxml::debug("not construct"); 526: &renderpage($request,$file); 527: } 528: #my $td=&tv_interval($t0); 529: #&Apache::lonxml::debug("Spent $td seconds processing"); 530: # &Apache::lonhomework::send_footer($request); 531: # always turn off debug messages 532: $Apache::lonxml::debug=0; 533: return OK; 534: 535: } 536: 537: 1; 538: __END__