![]() ![]() | ![]() |
- conversions to use the start html wrapper
1: # The LearningOnline Network with CAPA 2: # The LON-CAPA Homework handler 3: # 4: # $Id: lonhomework.pm,v 1.197 2005/03/01 03:24:05 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::lonhomework; 30: use strict; 31: use Apache::style(); 32: use Apache::lonxml(); 33: use Apache::lonnet(); 34: use Apache::lonplot(); 35: use Apache::inputtags(); 36: use Apache::structuretags(); 37: use Apache::randomlabel(); 38: use Apache::response(); 39: use Apache::hint(); 40: use Apache::outputtags(); 41: use Apache::caparesponse(); 42: use Apache::radiobuttonresponse(); 43: use Apache::optionresponse(); 44: use Apache::imageresponse(); 45: use Apache::essayresponse(); 46: use Apache::externalresponse(); 47: use Apache::rankresponse(); 48: use Apache::matchresponse(); 49: use Apache::chemresponse(); 50: use Apache::drawimage(); 51: use Apache::Constants qw(:common); 52: use HTML::Entities(); 53: use Apache::loncommon(); 54: use Apache::lonlocal; 55: use Time::HiRes qw( gettimeofday tv_interval ); 56: use Apache::lonnet(); 57: 58: # FIXME - improve commenting 59: 60: 61: BEGIN { 62: &Apache::lonxml::register_insert(); 63: } 64: 65: 66: # 67: # Decides what targets to render for. 68: # Implicit inputs: 69: # Various session environment variables: 70: # request.state - published - is a /res/ resource 71: # uploaded - is a /uploaded/ resource 72: # contruct - is a /priv/ resource 73: # form.grade_target - a form parameter requesting a specific target 74: sub get_target { 75: &Apache::lonxml::debug("request.state = $ENV{'request.state'}"); 76: if( defined($ENV{'form.grade_target'})) { 77: &Apache::lonxml::debug("form.grade_target= $ENV{'form.grade_target'}"); 78: } else { 79: &Apache::lonxml::debug("form.grade_target <undefined>"); 80: } 81: if (($ENV{'request.state'} eq "published") || 82: ($ENV{'request.state'} eq "uploaded")) { 83: if ( defined($ENV{'form.grade_target'} ) 84: && ($ENV{'form.grade_target'} eq 'tex')) { 85: return ($ENV{'form.grade_target'}); 86: } elsif ( defined($ENV{'form.grade_target'} ) 87: && ($Apache::lonhomework::viewgrades eq 'F' )) { 88: return ($ENV{'form.grade_target'}); 89: } 90: 91: if ( defined($ENV{'form.submitted'}) && 92: ( !defined($ENV{'form.resetdata'})) && 93: ( !defined($ENV{'form.newrandomization'}))) { 94: return ('grade', 'web'); 95: } else { 96: return ('web'); 97: } 98: } elsif ($ENV{'request.state'} eq "construct") { 99: if ( defined($ENV{'form.grade_target'}) ) { 100: return ($ENV{'form.grade_target'}); 101: } 102: if ( defined($ENV{'form.preview'})) { 103: if ( defined($ENV{'form.submitted'})) { 104: return ('grade', 'web'); 105: } else { 106: return ('web'); 107: } 108: } else { 109: if ( $ENV{'form.problemmode'} eq &mt('View') || 110: $ENV{'form.problemmode'} eq &mt('Discard Edits and View')) { 111: if ( defined($ENV{'form.submitted'}) && 112: (!defined($ENV{'form.resetdata'})) && 113: (!defined($ENV{'form.newrandomization'}))) { 114: return ('grade', 'web','answer'); 115: } else { 116: return ('web','answer'); 117: } 118: } elsif ( $ENV{'form.problemmode'} eq &mt('Edit') || 119: $ENV{'form.problemmode'} eq 'Edit') { 120: if ( $ENV{'form.submitted'} eq 'edit' ) { 121: if ( $ENV{'form.submit'} eq &mt('Submit Changes and View') ) { 122: return ('modified','web','answer'); 123: } else { 124: return ('modified','edit'); 125: } 126: } else { 127: return ('edit'); 128: } 129: } else { 130: return ('web'); 131: } 132: } 133: } 134: return (); 135: } 136: 137: sub setup_vars { 138: my ($target) = @_; 139: return ';' 140: # return ';$external::target='.$target.';'; 141: } 142: 143: sub send_header { 144: my ($request)= @_; 145: $request->print(&Apache::lontexconvert::header()); 146: # $request->print('<form name='.$ENV{'form.request.prefix'}.'lonhomework method="POST" action="'.$request->uri.'">'); 147: } 148: 149: sub createmenu { 150: my ($which,$request)=@_; 151: if ($which eq 'grade') { 152: $request->print('<script language="JavaScript"> 153: hwkmenu=window.open("/res/adm/pages/homeworkmenu.html","homeworkremote", 154: "height=350,width=150,menubar=no"); 155: </script>'); 156: } 157: } 158: 159: sub send_footer { 160: my ($request)= @_; 161: # $request->print('</form>'); 162: $request->print(&Apache::lontexconvert::footer()); 163: } 164: 165: $Apache::lonxml::browse=''; 166: 167: sub check_ip_acc { 168: my ($acc)=@_; 169: if (!defined($acc) || $acc =~ /^\s*$/) { return 1; } 170: my $allowed=0; 171: my $ip=$ENV{'REMOTE_ADDR'}; 172: my $name; 173: foreach my $pattern (split(',',$acc)) { 174: if ($pattern =~ /\*$/) { 175: #35.8.* 176: $pattern=~s/\*//; 177: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } 178: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { 179: #35.8.3.[34-56] 180: my $low=$2; 181: my $high=$3; 182: $pattern=$1; 183: if ($ip =~ /^\Q$pattern\E/) { 184: my $last=(split(/\./,$ip))[3]; 185: if ($last <=$high && $last >=$low) { $allowed=1; } 186: } 187: } elsif ($pattern =~ /^\*/) { 188: #*.msu.edu 189: $pattern=~s/\*//; 190: if (!defined($name)) { 191: use Socket; 192: my $netaddr=inet_aton($ip); 193: ($name)=gethostbyaddr($netaddr,AF_INET); 194: } 195: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } 196: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { 197: #127.0.0.1 198: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } 199: } else { 200: #some.name.com 201: if (!defined($name)) { 202: use Socket; 203: my $netaddr=inet_aton($ip); 204: ($name)=gethostbyaddr($netaddr,AF_INET); 205: } 206: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } 207: } 208: if ($allowed) { last; } 209: } 210: return $allowed; 211: } 212: # JB, 9/24/2002: Any changes in this function may require a change 213: # in lonnavmaps::resource::getDateStatus. 214: sub check_access { 215: my ($id) = @_; 216: my $date =''; 217: my $status; 218: my $datemsg = ''; 219: my $lastdate = ''; 220: my $temp; 221: my $type; 222: my $passed; 223: 224: if ($ENV{'request.state'} eq "construct") { 225: if ($ENV{'form.problemstate'}) { 226: if ($ENV{'form.problemstate'} =~ /^CANNOT_ANSWER/) { 227: if ( ! ($ENV{'form.problemstate'} eq 'CANNOT_ANSWER_correct' && 228: lc($Apache::lonhomework::problemstatus) eq 'no')) { 229: return ('CANNOT_ANSWER', 230: &mt('is in this state due to author settings.')); 231: } 232: } else { 233: return ($ENV{'form.problemstate'}, 234: &mt('is in this state due to author settings.')); 235: } 236: } 237: &Apache::lonxml::debug("in construction ignoring dates"); 238: $status='CAN_ANSWER'; 239: $datemsg=&mt('is in under construction'); 240: # return ($status,$datemsg); 241: } 242: 243: &Apache::lonxml::debug("checking for part :$id:"); 244: &Apache::lonxml::debug("time:".time); 245: 246: if ($ENV{'request.state'} ne "construct") { 247: my $allowed=&check_ip_acc(&Apache::lonnet::EXT("resource.$id.acc")); 248: if (!$allowed && ($Apache::lonhomework::browse ne 'F')) { 249: $status='INVALID_ACCESS'; 250: $date=&mt("can not be accessed from your location."); 251: return($status,$date); 252: } 253: 254: foreach $temp ("opendate","duedate","answerdate") { 255: $lastdate = $date; 256: $date = &Apache::lonnet::EXT("resource.$id.$temp"); 257: my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type"); 258: if ($thistype =~ /^(con_lost|no_such_host)/ || 259: $date =~ /^(con_lost|no_such_host)/) { 260: $status='UNAVAILABLE'; 261: $date=&mt("may open later."); 262: return($status,$date); 263: } 264: if ($thistype eq 'date_interval') { 265: if ($temp eq 'opendate') { 266: $date=&Apache::lonnet::EXT("resource.$id.duedate")-$date; 267: } 268: if ($temp eq 'answerdate') { 269: $date=&Apache::lonnet::EXT("resource.$id.duedate")+$date; 270: } 271: } 272: &Apache::lonxml::debug("found :$date: for :$temp:"); 273: if ($date eq '') { 274: $date = &mt("an unknown date"); $passed = 0; 275: } elsif ($date eq 'con_lost') { 276: $date = &mt("an indeterminate date"); $passed = 0; 277: } else { 278: if (time < $date) { $passed = 0; } else { $passed = 1; } 279: $date = localtime $date; 280: } 281: if (!$passed) { $type=$temp; last; } 282: } 283: &Apache::lonxml::debug("have :$type:$passed:"); 284: if ($passed) { 285: $status='SHOW_ANSWER'; 286: $datemsg=$date; 287: } elsif ($type eq 'opendate') { 288: $status='CLOSED'; 289: $datemsg = &mt("will open on")." $date"; 290: } elsif ($type eq 'duedate') { 291: $status='CAN_ANSWER'; 292: $datemsg = &mt("is due at")." $date"; 293: } elsif ($type eq 'answerdate') { 294: $status='CLOSED'; 295: $datemsg = &mt("was due on")." $lastdate".&mt(", and answers will be available on")." $date"; 296: } 297: } 298: if ($status eq 'CAN_ANSWER') { 299: #check #tries, and if correct. 300: my $tries = $Apache::lonhomework::history{"resource.$id.tries"}; 301: my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries"); 302: if ( $tries eq '' ) { $tries = '0'; } 303: if ( $maxtries eq '' && 304: $ENV{'request.state'} ne 'construct') { $maxtries = '2'; } 305: if ($maxtries && $tries >= $maxtries) { $status = 'CANNOT_ANSWER'; } 306: # if (correct and show prob status) or excused then CANNOT_ANSWER 307: if(($Apache::lonhomework::history{"resource.$id.solved"}=~/^correct/ 308: && 309: lc($Apache::lonhomework::problemstatus) ne 'no') 310: || 311: $Apache::lonhomework::history{"resource.$id.solved"}=~/^excused/) { 312: $status = 'CANNOT_ANSWER'; 313: } 314: } 315: if ($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER') { 316: my $interval=&Apache::lonnet::EXT("resource.$id.interval"); 317: &Apache::lonxml::debug("looking for interval $interval"); 318: if ($interval) { 319: my $first_access=&Apache::lonnet::get_first_access('map'); 320: &Apache::lonxml::debug("looking for accesstime $first_access"); 321: if (!$first_access) { 322: $status='NOT_YET_VIEWED'; 323: $datemsg=&seconds_to_human_length($interval); 324: } else { 325: my $newdate=localtime($first_access+$interval); 326: if (time > ($first_access+$interval)) { 327: $status='CLOSED'; 328: $datemsg = &mt("was due on")." $newdate".&mt(", and answers will be available on")." $date"; 329: } else { 330: $datemsg = &mt("is due at")." $newdate"; 331: } 332: } 333: } 334: } 335: #if (($status ne 'CLOSED') && ($Apache::lonhomework::type eq 'exam') && 336: # (!$Apache::lonhomework::history{"resource.0.outtoken"})) { 337: # return ('UNCHECKEDOUT','needs to be checked out'); 338: #} 339: 340: 341: &Apache::lonxml::debug("sending back :$status:$datemsg:"); 342: if (($Apache::lonhomework::browse eq 'F') && ($status eq 'CLOSED')) { 343: &Apache::lonxml::debug("should be allowed to browse a resource when closed"); 344: $status='CAN_ANSWER'; 345: $datemsg=&mt('is closed but you are allowed to view it'); 346: } 347: 348: return ($status,$datemsg); 349: } 350: 351: sub seconds_to_human_length { 352: my ($length)=@_; 353: 354: my $seconds=$length%60; $length=int($length/60); 355: my $minutes=$length%60; $length=int($length/60); 356: my $hours=$length%24; $length=int($length/24); 357: my $days=$length; 358: 359: my $timestr; 360: if ($days > 0) { $timestr.=&mt('[quant,_1,day]',$days); } 361: if ($hours > 0) { $timestr.=($timestr?", ":""). 362: &mt('[quant,_1,hour]',$hours); } 363: if ($minutes > 0) { $timestr.=($timestr?", ":""). 364: &mt('[quant,_1,minute]',$minutes); } 365: if ($seconds > 0) { $timestr.=($timestr?", ":""). 366: &mt('[quant,_1,second]',$seconds); } 367: return $timestr; 368: } 369: 370: sub showhash { 371: my (%hash) = @_; 372: &showhashsubset(\%hash,'.'); 373: return ''; 374: } 375: 376: sub showarray { 377: my ($array)=@_; 378: my $string="("; 379: foreach my $elm (@{ $array }) { 380: if (ref($elm) eq 'ARRAY') { 381: $string.=&showarray($elm); 382: } elsif (ref($elm) eq 'HASH') { 383: $string.= "HASH --- \n<br />"; 384: $string.= &showhashsubset($elm,'.'); 385: } else { 386: $string.="$elm," 387: } 388: } 389: chop($string); 390: $string.=")"; 391: return $string; 392: } 393: 394: sub showhashsubset { 395: my ($hash,$keyre) = @_; 396: my $resultkey; 397: foreach $resultkey (sort keys %$hash) { 398: if ($resultkey !~ /$keyre/) { next; } 399: if (ref($$hash{$resultkey}) eq 'ARRAY' ) { 400: &Apache::lonxml::debug("$resultkey ---- ". 401: &showarray($$hash{$resultkey})); 402: } elsif (ref($$hash{$resultkey}) eq 'HASH' ) { 403: &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}"); 404: &showhashsubset($$hash{$resultkey},'.'); 405: } else { 406: &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}"); 407: } 408: } 409: &Apache::lonxml::debug("\n<br />restored values^</br>\n"); 410: return ''; 411: } 412: 413: sub setuppermissions { 414: $Apache::lonhomework::browse= &Apache::lonnet::allowed('bre',$ENV{'request.filename'}); 415: my $viewgrades = &Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); 416: if (! $viewgrades && 417: exists($ENV{'request.course.sec'}) && 418: $ENV{'request.course.sec'} !~ /^\s*$/) { 419: $viewgrades = &Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}. 420: '/'.$ENV{'request.course.sec'}); 421: } 422: $Apache::lonhomework::viewgrades = $viewgrades; # File global variable...dirt. 423: if ($Apache::lonhomework::browse eq 'F' && 424: $ENV{'form.devalidatecourseresdata'} eq 'on') { 425: my (undef,$courseid) = &Apache::lonxml::whichuser(); 426: &Apache::lonnet::devalidatecourseresdata($ENV{"course.$courseid.num"}, 427: $ENV{"course.$courseid.domain"}); 428: } 429: return '' 430: } 431: 432: sub setupheader { 433: my $request=$_[0]; 434: &Apache::loncommon::content_type($request,'text/html'); 435: if (!$Apache::lonxml::debug && ($ENV{'REQUEST_METHOD'} eq 'GET')) { 436: &Apache::loncommon::no_cache($request); 437: } 438: # $request->set_last_modified(&Apache::lonnet::metadata($request->uri, 439: # 'lastrevisiondate')); 440: $request->send_http_header; 441: return OK if $request->header_only; 442: return '' 443: } 444: 445: sub handle_save_or_undo { 446: my ($request,$problem,$result) = @_; 447: my $file = &Apache::lonnet::filelocation("",$request->uri); 448: my $filebak =$file.".bak"; 449: my $filetmp =$file.".tmp"; 450: my $error=0; 451: 452: &Apache::lonnet::correct_line_ends($result); 453: 454: if ($ENV{'form.Undo'} eq &mt('undo')) { 455: my $error=0; 456: if (!copy($file,$filetmp)) { $error=1; } 457: if ((!$error) && (!copy($filebak,$file))) { $error=1; } 458: if ((!$error) && (!move($filetmp,$filebak))) { $error=1; } 459: if (!$error) { 460: &Apache::lonxml::info("<p><b>".&mt("Undid changes, Switched")." $filebak ".&mt("and")." $file</b></p>"); 461: } else { 462: &Apache::lonxml::info("<p><font color=\"red\" size=\"+1\"><b>".&mt("Unable to undo, unable to switch")." $filebak ".&mt("and")." $file</b></font></p>"); 463: $error=1; 464: } 465: } else { 466: my $fs=Apache::File->new(">$filebak"); 467: if (defined($fs)) { 468: print $fs $$problem; 469: &Apache::lonxml::info("<b>".&mt("Making Backup to"). 470: " $filebak</b>"); 471: } else { 472: &Apache::lonxml::info("<font color=\"red\" size=\"+1\"><b>".&mt("Unable to make backup")." $filebak</b></font>"); 473: $error=2; 474: } 475: my $fh=Apache::File->new(">$file"); 476: if (defined($fh)) { 477: print $fh $$result; 478: &Apache::lonxml::info("<b>".&mt("Saving Modifications to"). 479: " $file</b>"); 480: } else { 481: &Apache::lonxml::info("<font color=\"red\" size=\"+1\"><b>". 482: &mt("Unable to write to")." $file</b></font>"); 483: $error|=4; 484: } 485: } 486: return $error; 487: } 488: 489: sub analyze_header { 490: my ($request) = @_; 491: my $bodytag='<body bgcolor="#ffffff">'; 492: if ($ENV{'environment.remote'} eq 'off') { 493: $bodytag=&Apache::loncommon::bodytag(); 494: } 495: my $html=&Apache::lonxml::xmlbegin(); 496: my $result.=$html.' 497: <head><title>'.&mt("Analyzing a problem").'</title></head> 498: '.$bodytag.&Apache::lonxml::message_location().' 499: <form name="lonhomework" method="POST" action="'. 500: &HTML::Entities::encode($ENV{'request.uri'},'<>&"').'">'. 501: &Apache::structuretags::remember_problem_state().' 502: <input type="submit" name="problemmode" value="'.&mt("EditXML").'" /> 503: <input type="submit" name="problemmode" value="'.&mt('Edit').'" /> 504: <hr /> 505: <input type="submit" name="submit" value="'.&mt("View").'" /> 506: <hr /> 507: </form>'; 508: &Apache::lonxml::add_messages(\$result); 509: $request->print($result); 510: $request->rflush(); 511: } 512: 513: sub analyze_footer { 514: my ($request) = @_; 515: my $result='</body></html>'; 516: $request->print($result); 517: $request->rflush(); 518: } 519: 520: sub analyze { 521: my ($request,$file) = @_; 522: &Apache::lonxml::debug("Analyze"); 523: my $result; 524: my %overall; 525: my %allparts; 526: my $rndseed=$ENV{'form.rndseed'}; 527: &analyze_header($request); 528: my %prog_state= 529: &Apache::lonhtmlcommon::Create_PrgWin($request,&mt('Analyze Progress'), 530: &mt('Getting Problem Variants'), 531: $ENV{'form.numtoanalyze'}, 532: 'inline',undef); 533: for(my $i=1;$i<$ENV{'form.numtoanalyze'}+1;$i++) { 534: &Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state, 535: &mt('last problem')); 536: if (&Apache::loncommon::connection_aborted($request)) { return; } 537: my $subresult=&Apache::lonnet::ssi($request->uri, 538: ('grade_target' => 'analyze'), 539: ('rndseed' => $i+$rndseed)); 540: (my $garbage,$subresult)=split(/_HASH_REF__/,$subresult,2); 541: my %analyze=&Apache::lonnet::str2hash($subresult); 542: my @parts; 543: if (defined(@{ $analyze{'parts'} })) { 544: @parts=@{ $analyze{'parts'} }; 545: } 546: foreach my $part (@parts) { 547: if (!exists($allparts{$part})) {$allparts{$part}=1;}; 548: if ($analyze{$part.'.type'} eq 'numericalresponse' || 549: $analyze{$part.'.type'} eq 'stringresponse' || 550: $analyze{$part.'.type'} eq 'formularesponse' ) { 551: push( @{ $overall{$part.'.answer'} }, 552: [@{ $analyze{$part.'.answer'} }]); 553: } 554: } 555: } 556: &Apache::lonhtmlcommon::Update_PrgWin($request,\%prog_state, 557: &mt('Analyzing Results')); 558: $request->print('<hr />'.&mt('List of possible answers').': '); 559: foreach my $part (sort(keys(%allparts))) { 560: if (defined(@{ $overall{$part.'.answer'} })) { 561: my $num_cols=scalar(@{ $overall{$part.'.answer'}->[0] }); 562: $request->print('<table><tr><th colspan="'.($num_cols+1).'">'.&mt('Part').' '.$part.'</th></tr>'); 563: my %frequency; 564: foreach my $answer (sort {$a->[0] <=> $b->[0]} (@{ $overall{$part.'.answer'} })) { 565: $frequency{join("\0",@{ $answer })}++; 566: } 567: $request->print('<tr><th colspan="'.($num_cols).'">'.&mt('Answer').'</th><th>'.&mt('Frequency').'</th></tr>'); 568: foreach my $answer (sort {(split("\0",$a))[0] <=> (split("\0",$b))[0]} (keys(%frequency))) { 569: $request->print('<tr><td align="right">'. 570: join('</td><td align="right">',split("\0",$answer)). 571: '</td><td>('.$frequency{$answer}. 572: ')</td></tr>'); 573: } 574: $request->print('</table>'); 575: } else { 576: $request->print('<p>'.&mt('Response').' '.$part.' '. 577: &mt('is not analyzable at this time').'</p>'); 578: } 579: } 580: if (scalar(keys(%allparts)) == 0 ) { 581: $request->print('<p>'.&mt('Found no analyzable respones in this problem, currently only Numerical, Formula and String response styles are supported.').'</p>'); 582: } 583: &Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state); 584: &analyze_footer($request); 585: &Apache::lonhomework::showhash(%overall); 586: return $result; 587: } 588: 589: sub editxmlmode { 590: my ($request,$file) = @_; 591: my $result; 592: my $problem=&Apache::lonnet::getfile($file); 593: if ($problem eq -1) { 594: &Apache::lonxml::error("<b> ".&mt('Unable to find'). 595: " <i>$file</i></b>"); 596: $problem=''; 597: } 598: if (defined($ENV{'form.editxmltext'}) || defined($ENV{'form.Undo'})) { 599: my $error=&handle_save_or_undo($request,\$problem, 600: \$ENV{'form.editxmltext'}); 601: if (!$error) { $problem=&Apache::lonnet::getfile($file); } 602: } 603: &Apache::lonhomework::showhashsubset(\%ENV,'^form'); 604: if ( $ENV{'form.submit'} eq &mt('Submit Changes and View') ) { 605: &Apache::lonhomework::showhashsubset(\%ENV,'^form'); 606: $ENV{'form.problemmode'}='View'; 607: &renderpage($request,$file); 608: } else { 609: my ($rows,$cols) = &Apache::edit::textarea_sizes(\$problem); 610: my $xml_help = '<table><tr><td>'. 611: &Apache::loncommon::helpLatexCheatsheet("Problem_Editor_XML_Index", 612: "Problem Editing Help"). 613: '</td><td>'. 614: &Apache::loncommon::help_open_menu('',undef,undef,undef,5,'Authoring'). 615: '</td></tr></table>'; 616: if ($cols > 80) { $cols = 80; } 617: if ($cols < 70) { $cols = 70; } 618: if ($rows < 20) { $rows = 20; } 619: my $bodytag='<body bgcolor="#ffffff">'; 620: if ($ENV{'environment.remote'} eq 'off') { 621: $bodytag=&Apache::loncommon::bodytag(); 622: } 623: my $html=&Apache::lonxml::xmlbegin(); 624: $result.=$html.$bodytag.&Apache::lonxml::message_location().' 625: <form name="lonhomework" method="POST" action="'. 626: &HTML::Entities::encode($ENV{'request.uri'},'<>&"').'">'. 627: &Apache::structuretags::remember_problem_state().' 628: <input type="hidden" name="problemmode" value="'.&mt('EditXML').'" /> 629: <input type="submit" name="problemmode" accesskey="d" value="'.&mt('Discard Edits and View').'" /> 630: <input type="submit" name="problemmode" accesskey="e" value="'.&mt('Edit').'" /> 631: <hr /> 632: <input type="submit" name="submit" accesskey="s" value="'.&mt('Submit Changes').'" /> 633: <input type="submit" name="submit" accesskey="v" value="'.&mt('Submit Changes and View').'" /> 634: <input type="submit" name="Undo" accesskey="u" value="'.&mt('undo').'" /> 635: <hr /> 636: ' . $xml_help . ' 637: <textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'. 638: &HTML::Entities::encode($problem,'<>&"').'</textarea> 639: </form></body></html>'; 640: &Apache::lonxml::add_messages(\$result); 641: $request->print($result); 642: } 643: return ''; 644: } 645: 646: # 647: # Render the page in whatever target desired. 648: # 649: sub renderpage { 650: my ($request,$file) = @_; 651: 652: my (@targets) = &get_target(); 653: &Apache::lonhomework::showhashsubset(\%ENV,'form.'); 654: &Apache::lonxml::debug("Running targets ".join(':',@targets)); 655: my $overall_result; 656: foreach my $target (@targets) { 657: # FIXME need to do something intelligent when a problem goes 658: # from viewable to not viewable due to map conditions 659: #&setuppermissions(); 660: #if ( $Apache::lonhomework::browse ne '2' 661: # && $Apache::lonhomework::browse ne 'F' ) { 662: # $request->print(" You most likely shouldn't see me."); 663: #} 664: #my $t0 = [&gettimeofday()]; 665: my $problem=&Apache::lonnet::getfile($file); 666: if ($problem eq -1) { 667: &Apache::lonxml::error("<b> ".&mt('Unable to find')." <i>$file</i></b>"); 668: $problem=''; 669: } 670: 671: my %mystyle; 672: my $result = ''; 673: if ($target eq 'analyze') { %Apache::lonhomework::analyze=(); } 674: if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); } 675: if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%ENV,'^form');} 676: 677: &Apache::lonxml::debug("Should be parsing now"); 678: $result = &Apache::lonxml::xmlparse($request, $target, $problem, 679: &setup_vars($target),%mystyle); 680: undef($Apache::lonhomework::parsing_a_problem); 681: #$request->print("Result follows:"); 682: if ($target eq 'modified') { 683: &handle_save_or_undo($request,\$problem,\$result); 684: } else { 685: if ($target eq 'analyze') { 686: $result=&Apache::lonnet::hashref2str(\%Apache::lonhomework::analyze); 687: undef(%Apache::lonhomework::analyze); 688: } 689: #my $td=&tv_interval($t0); 690: #if ( $Apache::lonxml::debug) { 691: #$result =~ s:</body>::; 692: #$result.="<br />Spent $td seconds processing target $target\n</body>"; 693: #} 694: # $request->print($result); 695: $overall_result.=$result; 696: # $request->rflush(); 697: } 698: #$request->print(":Result ends"); 699: #my $td=&tv_interval($t0); 700: } 701: &Apache::lonxml::add_messages(\$overall_result); 702: $request->print($overall_result); 703: $request->rflush(); 704: } 705: 706: # with no arg it returns a HTML <option> list of the template titles 707: # with one arg it returns the filename associated with the arg passed 708: sub get_template_list { 709: my ($namewanted,$extension) = @_; 710: my $result; 711: my @allnames; 712: &Apache::lonxml::debug("Looking for :$extension:"); 713: foreach my $file (</home/httpd/html/res/adm/includes/templates/*.$extension>) { 714: my $name=&Apache::lonnet::metadata($file,'title'); 715: if ($namewanted && ($name eq $namewanted)) { 716: $result=$file; 717: last; 718: } else { 719: if ($name) { push (@allnames, $name); } 720: } 721: } 722: if (@allnames && !$result) { 723: $result="<option>".&mt("Select a")." $extension ".&mt('template')."</option>\n<option>". 724: join('</option><option>',sort(@allnames)).'</option>'; 725: } 726: return $result; 727: } 728: 729: sub newproblem { 730: my ($request) = @_; 731: my $extension=$request->uri; 732: $extension=~s:^.*\.([\w]+)$:$1:; 733: &Apache::lonxml::debug("Looking for :$extension:"); 734: my $templatelist=&get_template_list('',$extension); 735: if ($ENV{'form.template'} && 736: $ENV{'form.template'} ne "Select a $extension template") { 737: use File::Copy; 738: my $file = &get_template_list($ENV{'form.template'},$extension); 739: my $dest = &Apache::lonnet::filelocation("",$request->uri); 740: copy($file,$dest); 741: &renderpage($request,$dest); 742: } elsif($ENV{'form.newfile'} && !$templatelist) { 743: # I don't like hard-coded filenames but for now, this will work. 744: use File::Copy; 745: my $templatefilename = 746: $request->dir_config('lonIncludes').'/templates/blank.problem'; 747: &Apache::lonxml::debug("$templatefilename"); 748: my $dest = &Apache::lonnet::filelocation("",$request->uri); 749: copy($templatefilename,$dest); 750: &renderpage($request,$dest); 751: } else { 752: my $url=&HTML::Entities::encode($request->uri,'<>&"'); 753: my $shownurl=$url; 754: $shownurl=~s-^/~-/priv/-; 755: my $dest = &Apache::lonnet::filelocation("",$request->uri); 756: my $errormsg; 757: if ($ENV{'form.newfile'}) { 758: $errormsg='<p><font color="red">'.&mt('You did not select a template.').'</font></p>'."\n"; 759: } 760: my $instructions; 761: my $bodytag=&Apache::loncommon::bodytag(undef,undef,undef, 762: ($ENV{'environment.remote'} ne 'off')); 763: if ($templatelist) { $instructions=&mt(", select a template from the pull-down menu below.").'<br />'.&mt("Then");} 764: my %lt=&Apache::lonlocal::texthash( 'create' => 'Creating a new', 765: 'resource' => 'resource', 766: 'requested' => 'The requested file', 767: 'not exist' => 'currently does not exist', 768: 'createnew' => 'To create a new', 769: 'click' => 'click on the', 770: 'Create' => 'Create', 771: 'button' => 'button'); 772: $request->print(<<ENDNEWPROBLEM); 773: $bodytag 774: <h1>$lt{'create'} $extension $lt{'resource'}</h1> 775: $errormsg 776: $lt{'requested'} <tt>$shownurl</tt> $lt{'not exist'}. 777: <p> 778: <b>$lt{'createnew'} $extension$instructions $lt{'click'} "$lt{'Create'} $extension" $lt{'button'}.</b> 779: </p> 780: <p><form action="$url" method="POST"> 781: ENDNEWPROBLEM 782: if (defined($templatelist)) { 783: $request->print("<select name=\"template\">$templatelist</select>"); 784: } 785: $request->print("<br /><input type=\"submit\" name=\"newfile\" value=\"".&mt('Create')." $extension\" />"); 786: $request->print("</form></p></body>"); 787: } 788: return ''; 789: } 790: 791: sub view_or_edit_menu { 792: my ($request) = @_; 793: my $url=&HTML::Entities::encode($request->uri,'<>&"'); 794: my %lt=&Apache::lonlocal::texthash( 'would' => 'Would you like to', 795: 'view' => 'View', 796: 'Edit' => 'edit', 797: 'or' => 'or', 798: 'the problem' => 'the problem'); 799: $request->print(<<EDITMENU); 800: <body bgcolor="#FFFFFF"> 801: <form action="$url" method="POST"> 802: $lt{'would'} <input type="submit" name="problemmode" accesskey="v" value="<{'view'}"> 803: <{'or'} <input type="submit" name="problemmode" accesskey="e" value="<{'Edit'}"> 804: <{'the problem'}. 805: </form> 806: </body> 807: EDITMENU 808: } 809: 810: sub handler { 811: #my $t0 = [&gettimeofday()]; 812: my $request=$_[0]; 813: 814: $Apache::lonxml::debug=$ENV{'user.debug'}; 815: $ENV{'request.uri'}=$request->uri; 816: &setuppermissions(); 817: # some times multiple problemmodes are submitted, need to select 818: # the last one 819: if ( defined($ENV{'form.problemmode'}) && ref($ENV{'form.problemmode'}) ) { 820: my $mode=$ENV{'form.problemmode'}->[-1]; 821: undef $ENV{'form.problemmode'}; 822: $ENV{'form.problemmode'}=$mode; 823: } 824: 825: my $file=&Apache::lonnet::filelocation("",$request->uri); 826: 827: #check if we know where we are 828: if ($ENV{'request.course.fn'} && !&Apache::lonnet::symbread()) { 829: # if we are browsing we might not be able to know where we are 830: if ($Apache::lonhomework::browse ne 'F' && 831: $ENV{'request.state'} ne "construct") { 832: #should know where we are, so ask 833: if ( &Apache::lonnet::mod_perl_version() == 2 ) { 834: &Apache::lonnet::cleanenv(); 835: } 836: &Apache::lonnet::logthis(&Apache::lonnet::mod_perl_version()); 837: $request->internal_redirect('/adm/ambiguous'); return OK; 838: } 839: } 840: if (&setupheader($request)) { return OK; } 841: &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:"); 842: &Apache::lonxml::debug("Problem Mode ".$ENV{'form.problemmode'}); 843: my ($symb) = &Apache::lonxml::whichuser(); 844: &Apache::lonxml::debug('symb is '.$symb); 845: if ($ENV{'request.state'} eq "construct" || $symb eq '') { 846: if ($ENV{'form.resetdata'} eq &mt('Reset Submissions') || 847: $ENV{'form.resetdata'} eq &mt('New Problem Variation') || 848: $ENV{'form.newrandomization'} eq &mt('New Randomization')) { 849: my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); 850: &Apache::lonnet::tmpreset($symb,'',$domain,$name); 851: &Apache::lonxml::debug("Attempt reset"); 852: } 853: } 854: if ($ENV{'request.state'} eq "construct") { 855: if ( -e $file ) { 856: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 857: ['problemmode']); 858: if (!(defined $ENV{'form.problemmode'})) { 859: #first visit to problem in construction space 860: #&view_or_edit_menu($request); 861: $ENV{'form.problemmode'}='View'; 862: &renderpage($request,$file); 863: } elsif ($ENV{'form.problemmode'} eq &mt('EditXML') || 864: $ENV{'form.problemmode'} eq 'EditXML') { 865: &editxmlmode($request,$file); 866: } elsif ($ENV{'form.problemmode'} eq &mt('Calculate answers')) { 867: &analyze($request,$file); 868: } else { 869: &renderpage($request,$file); 870: } 871: } else { 872: # requested file doesn't exist in contruction space 873: &newproblem($request); 874: } 875: } else { 876: # just render the page normally outside of construction space 877: &Apache::lonxml::debug("not construct"); 878: &renderpage($request,$file); 879: } 880: #my $td=&tv_interval($t0); 881: #&Apache::lonxml::debug("Spent $td seconds processing"); 882: # &Apache::lonhomework::send_footer($request); 883: # always turn off debug messages 884: $Apache::lonxml::debug=0; 885: return OK; 886: 887: } 888: 889: 1; 890: __END__