Annotation of loncom/homework/lonhomework.pm, revision 1.353

1.63      albertel    1: # The LearningOnline Network with CAPA
1.52      albertel    2: # The LON-CAPA Homework handler
1.63      albertel    3: #
1.353   ! droeschl    4: # $Id: lonhomework.pm,v 1.352 2015/04/17 12:33:56 droeschl Exp $
1.63      albertel    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/
1.159     www        27: 
1.1       albertel   28: 
                     29: package Apache::lonhomework;
                     30: use strict;
1.73      albertel   31: use Apache::style();
                     32: use Apache::lonxml();
1.204     albertel   33: use Apache::lonnet;
1.73      albertel   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();
1.83      albertel   41: use Apache::caparesponse();
                     42: use Apache::radiobuttonresponse();
                     43: use Apache::optionresponse();
                     44: use Apache::imageresponse();
                     45: use Apache::essayresponse();
                     46: use Apache::externalresponse();
1.106     albertel   47: use Apache::rankresponse();
1.107     albertel   48: use Apache::matchresponse();
1.137     albertel   49: use Apache::chemresponse();
1.321     www        50: use Apache::functionplotresponse();
1.169     albertel   51: use Apache::drawimage();
1.26      www        52: use Apache::Constants qw(:common);
1.83      albertel   53: use Apache::loncommon();
1.146     albertel   54: use Apache::lonlocal;
1.179     albertel   55: use Time::HiRes qw( gettimeofday tv_interval );
1.282     albertel   56: use HTML::Entities();
                     57: use File::Copy();
1.188     foxr       58: 
1.189     albertel   59: # FIXME - improve commenting
1.188     foxr       60: 
1.43      albertel   61: 
1.69      harris41   62: BEGIN {
1.145     albertel   63:     &Apache::lonxml::register_insert();
1.43      albertel   64: }
                     65: 
1.188     foxr       66: 
1.276     foxr       67: =pod
                     68: 
                     69: =item set_bubble_lines()
                     70: 
                     71: Called at analysis time to set the bubble lines
                     72: hash for the problem.. This should be called in the
                     73: end_problemtype tag in analysis mode.
                     74: 
                     75: We fetch the hash of part id counters from lonxml
                     76:     and push them into analyze:{part_id.bubble_lines}.
                     77: 
                     78: =cut
                     79: 
                     80: sub set_bubble_lines {
                     81:     my %bubble_counters = &Apache::lonxml::get_bubble_line_hash();
                     82: 
                     83:     foreach my $key (keys(%bubble_counters)) {
                     84: 	$Apache::lonhomework::analyze{"$key.bubble_lines"} =
                     85: 	    $bubble_counters{"$key"};
                     86:     }
                     87: }
                     88: 
1.301     jms        89: #
                     90: # Decides what targets to render for.
                     91: # Implicit inputs:
                     92: #   Various session environment variables:
                     93: #      request.state -  published  - is a /res/ resource
                     94: #                       uploaded   - is a /uploaded/ resource
                     95: #                       contruct   - is a /priv/ resource
                     96: #      form.grade_target - a form parameter requesting a specific target
1.5       albertel   97: sub get_target {
1.204     albertel   98:     &Apache::lonxml::debug("request.state = $env{'request.state'}");
                     99:     if( defined($env{'form.grade_target'})) {
                    100: 	&Apache::lonxml::debug("form.grade_target= $env{'form.grade_target'}");
1.188     foxr      101:     } else {
1.189     albertel  102: 	&Apache::lonxml::debug("form.grade_target <undefined>");
1.188     foxr      103:     }
1.204     albertel  104:     if (($env{'request.state'} eq "published") ||
                    105: 	($env{'request.state'} eq "uploaded")) {
                    106: 	if ( defined($env{'form.grade_target'}  ) 
                    107: 	     && ($env{'form.grade_target'} eq 'tex')) {
                    108: 	    return ($env{'form.grade_target'});
                    109: 	} elsif ( defined($env{'form.grade_target'}  ) 
1.145     albertel  110: 		  && ($Apache::lonhomework::viewgrades eq 'F' )) {
1.207     albertel  111: 	    return ($env{'form.grade_target'});
1.244     albertel  112: 	} elsif ( $env{'form.grade_target'} eq 'webgrade'
                    113: 		  && ($Apache::lonhomework::queuegrade eq 'F' )) {
                    114: 	    return ($env{'form.grade_target'});
1.320     raeburn   115: 	} elsif ($env{'form.grade_target'} eq 'answer') {
                    116:             if ($env{'form.answer_output_mode'} eq 'tex') {
                    117:                 return ($env{'form.grade_target'});
                    118:             }
                    119:         }
1.207     albertel  120: 	if ($env{'form.webgrade'} &&
1.244     albertel  121: 	    ($Apache::lonhomework::modifygrades eq 'F'
                    122: 	     || $Apache::lonhomework::queuegrade eq 'F' )) {
1.207     albertel  123: 	    return ('grade','webgrade');
1.145     albertel  124: 	}
1.204     albertel  125: 	if ( defined($env{'form.submitted'}) &&
                    126: 	     ( !defined($env{'form.newrandomization'}))) {
1.217     albertel  127: 	    return ('grade', 'web');
1.145     albertel  128: 	} else {
1.217     albertel  129: 	    return ('web');
1.145     albertel  130: 	}
1.204     albertel  131:     } elsif ($env{'request.state'} eq "construct") {
1.323     www       132: #
                    133: # We are in construction space, editing and testing problems
                    134: #
1.204     albertel  135: 	if ( defined($env{'form.grade_target'}) ) {
                    136: 	    return ($env{'form.grade_target'});
1.145     albertel  137: 	}
1.204     albertel  138: 	if ( defined($env{'form.preview'})) {
                    139: 	    if ( defined($env{'form.submitted'})) {
1.323     www       140: #
                    141: # We are doing a problem preview
                    142: #
1.145     albertel  143: 		return ('grade', 'web');
                    144: 	    } else {
                    145: 		return ('web');
                    146: 	    }
                    147: 	} else {
1.267     albertel  148: 	    if ($env{'form.problemstate'} eq 'WEB_GRADE') {
                    149: 		return ('grade','webgrade','answer');
1.324     www       150:             } elsif ($env{'form.problemmode'} eq 'view') {
                    151:                 return ('grade','web','answer');
1.323     www       152: 	    } elsif ($env{'form.problemmode'} eq 'saveview') {
                    153:                 return ('modified','web','answer');
                    154:             } elsif ($env{'form.problemmode'} eq 'discard') {
                    155:                 return ('web','answer');
                    156:             } elsif (($env{'form.problemmode'} eq 'saveedit') ||
                    157:                      ($env{'form.problemmode'} eq 'undo')) {
                    158:                 return ('modified','no_output_web','edit');
                    159:             } elsif ($env{'form.problemmode'} eq 'edit') {
                    160: 		return ('no_output_web','edit');
1.145     albertel  161: 	    } else {
                    162: 		return ('web');
                    163: 	    }
1.323     www       164:         }
                    165: #
1.338     raeburn   166: # End of Authoring Space
1.323     www       167: #
1.15      albertel  168:     }
1.323     www       169: #
                    170: # Huh? We are nowhere, so do nothing.
                    171: #
1.145     albertel  172:     return ();
1.5       albertel  173: }
                    174: 
1.3       albertel  175: sub setup_vars {
1.145     albertel  176:     my ($target) = @_;
                    177:     return ';'
1.11      albertel  178: #  return ';$external::target='.$target.';';
1.2       albertel  179: }
                    180: 
1.200     albertel  181: sub proctor_checked_in {
1.226     albertel  182:     my ($slot_name,$slot,$type)=@_;
                    183:     my @possible_proctors=split(",",$slot->{'proctor'});
                    184:     
1.248     albertel  185:     return 1 if (!@possible_proctors);
                    186: 
1.226     albertel  187:     my $key;
                    188:     if ($type eq 'Task') {
1.230     albertel  189: 	my $version=$Apache::lonhomework::history{'resource.0.version'};
                    190: 	$key ="resource.$version.0.checkedin";
1.226     albertel  191:     } elsif ($type eq 'problem') {
                    192: 	$key ='resource.0.checkedin';
                    193:     }
1.249     albertel  194:     # backward compatability, used to be username@domain, 
                    195:     # now is username:domain
                    196:     my $who = $Apache::lonhomework::history{$key};
                    197:     if ($who !~ /:/) {
                    198: 	$who =~ tr/@/:/;
                    199:     }     
1.226     albertel  200:     foreach my $possible (@possible_proctors) { 
1.249     albertel  201: 	if ($who eq $possible
1.226     albertel  202: 	    && $Apache::lonhomework::history{$key.'.slot'} eq $slot_name) {
1.202     albertel  203: 	    return 1;
                    204: 	}
                    205:     }
1.226     albertel  206:     
1.200     albertel  207:     return 0;
                    208: }
                    209: 
1.226     albertel  210: sub check_slot_access {
                    211:     my ($id,$type)=@_;
                    212: 
1.207     albertel  213:     # does it pass normal muster
1.226     albertel  214:     my ($status,$datemsg)=&check_access($id);
                    215:     
1.252     albertel  216:     my $useslots = &Apache::lonnet::EXT("resource.0.useslots");
1.251     albertel  217:     if ($useslots ne 'resource' && $useslots ne 'map' 
                    218: 	&& $useslots ne 'map_map') {
1.226     albertel  219: 	return ($status,$datemsg);
                    220:     }
                    221: 
1.200     albertel  222:     if ($status eq 'SHOW_ANSWER' ||
                    223: 	$status eq 'CLOSED' ||
                    224: 	$status eq 'INVALID_ACCESS' ||
                    225: 	$status eq 'UNAVAILABLE') {
                    226: 	return ($status,$datemsg);
                    227:     }
1.204     albertel  228:     if ($env{'request.state'} eq "construct") {
1.203     albertel  229: 	return ($status,$datemsg);
                    230:     }
1.226     albertel  231:     
                    232:     if ($type eq 'Task') {
                    233: 	my $version=$Apache::lonhomework::history{'resource.version'};
1.230     albertel  234: 	if ($Apache::lonhomework::history{"resource.$version.0.checkedin"} &&
                    235: 	    $Apache::lonhomework::history{"resource.$version.0.status"} eq 'pass') {
1.226     albertel  236: 	    return ('SHOW_ANSWER');
                    237: 	}
1.207     albertel  238:     }
1.226     albertel  239: 
1.288     raeburn   240:     my $availablestudent = &Apache::lonnet::EXT("resource.0.availablestudent");
                    241:     my $available = &Apache::lonnet::EXT("resource.0.available");
                    242:     my @slots= (split(':',$availablestudent),split(':',$available));
1.210     albertel  243: 
1.200     albertel  244: #    if (!@slots) {
                    245: #	return ($status,$datemsg);
                    246: #    }
                    247:     my $slotstatus='NOT_IN_A_SLOT';
1.206     albertel  248:     my ($returned_slot,$slot_name);
1.334     raeburn   249:     my $now = time;
                    250:     my $num_usable_slots = 0;
1.210     albertel  251:     foreach my $slot (@slots) {
1.241     albertel  252: 	$slot =~ s/(^\s*|\s*$)//g;
1.201     albertel  253: 	&Apache::lonxml::debug("getting $slot");
1.200     albertel  254: 	my %slot=&Apache::lonnet::get_slot($slot);
1.201     albertel  255: 	&Apache::lonhomework::showhash(%slot);
1.334     raeburn   256:         next if ($slot{'endtime'} < $now);
                    257:         $num_usable_slots ++;
                    258: 	if ($slot{'starttime'} < $now &&
                    259: 	    $slot{'endtime'} > $now &&
1.297     raeburn   260: 	    &Apache::loncommon::check_ip_acc($slot{'ip'})) {
1.202     albertel  261: 	    &Apache::lonxml::debug("$slot is good");
                    262: 	    $slotstatus='NEEDS_CHECKIN';
                    263: 	    $returned_slot=\%slot;
1.206     albertel  264: 	    $slot_name=$slot;
1.200     albertel  265: 	    last;
1.334     raeburn   266:         } 
1.200     albertel  267:     }
1.202     albertel  268:     if ($slotstatus eq 'NEEDS_CHECKIN' &&
1.226     albertel  269: 	&proctor_checked_in($slot_name,$returned_slot,$type)) {
1.322     raeburn   270: 	&Apache::lonxml::debug("proctor checked in");
                    271: 	$slotstatus=$status;
1.200     albertel  272:     }
1.226     albertel  273: 
1.235     albertel  274:     my ($is_correct,$got_grade,$checkedin);
1.226     albertel  275:     if ($type eq 'Task') {
1.230     albertel  276: 	my $version=$Apache::lonhomework::history{'resource.0.version'};
1.231     albertel  277: 	$got_grade = 
                    278: 	    ($Apache::lonhomework::history{"resource.$version.0.status"} 
                    279: 	     =~ /^(?:pass|fail)$/);
1.235     albertel  280: 	$is_correct =  
                    281: 	    ($Apache::lonhomework::history{"resource.$version.0.status"} eq 'pass'
                    282: 	     || $Apache::lonhomework::history{"resource.0.solved"} =~ /^correct_/ );
1.226     albertel  283: 	$checkedin =
1.230     albertel  284: 	    $Apache::lonhomework::history{"resource.$version.0.checkedin"};
1.226     albertel  285:     } elsif ($type eq 'problem') {
1.252     albertel  286: 	$got_grade  = 1;
                    287: 	$checkedin  = $Apache::lonhomework::history{"resource.0.checkedin"};
                    288: 	$is_correct =
                    289: 	    ($Apache::lonhomework::history{"resource.0.solved"} =~/^correct_/);
1.226     albertel  290:     }
                    291:     
1.235     albertel  292:     &Apache::lonxml::debug(" slot is $slotstatus checkedin ($checkedin) got_grade ($got_grade) is_correct ($is_correct)");
                    293:     
1.243     albertel  294:     # no slot is currently open, and has been checked in for this version
                    295:     # but hasn't got a grade, therefore must be awaiting a grade
                    296:     if (!defined($slot_name)
                    297: 	&& $checkedin 
1.236     albertel  298: 	&& !$got_grade) {
                    299: 	return ('WAITING_FOR_GRADE');
                    300:     }
                    301: 
1.309     raeburn   302:     # Previously used slot is no longer open, and has been checked in for this version.
                    303:     # However, the problem is not closed, and potentially, another slot might be
                    304:     # used to gain access to it to work on it, until the due date is reached, and the
                    305:     # problem then becomes CLOSED.  Therefore return the slotstatus - 
1.334     raeburn   306:     # (which will be one of: NOT_IN_A_SLOT, RESERVABLE, RESERVABLE_LATER, or NOTRESERVABLE.
                    307:     if (!defined($slot_name) && $type eq 'problem') {
                    308:         if ($slotstatus eq 'NOT_IN_A_SLOT') {
                    309:             if (!$num_usable_slots) {
                    310:                 if ($env{'request.course.id'}) {
                    311:                     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    312:                     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    313:                     my ($symb)=&Apache::lonnet::whichuser();
                    314:                     $slotstatus = 'NOTRESERVABLE';
                    315:                     my ($reservable_now_order,$reservable_now,$reservable_future_order,
                    316:                         $reservable_future) = 
                    317:                         &Apache::loncommon::get_future_slots($cnum,$cdom,$now,$symb);
                    318:                     if ((ref($reservable_now_order) eq 'ARRAY') && (ref($reservable_now) eq 'HASH')) {
                    319:                         if (@{$reservable_now_order} > 0) {
                    320:                             $slotstatus = 'RESERVABLE';
                    321:                             $datemsg = $reservable_now->{$reservable_now_order->[-1]}{'endreserve'};
                    322:                         }
                    323:                     }
                    324:                     unless ($slotstatus eq 'RESERVABLE') {
                    325:                         if ((ref($reservable_future_order) eq 'ARRAY') && (ref($reservable_future) eq 'HASH')) {
                    326:                             if (@{$reservable_future_order} > 0) {
                    327:                                 $slotstatus = 'RESERVABLE_LATER';
                    328:                                 $datemsg = $reservable_future->{$reservable_future_order->[0]}{'startreserve'};
                    329:                             }
                    330:                         }
                    331:                     }
                    332:                 }
                    333:             }
                    334:         }
                    335:         return ($slotstatus,$datemsg);
1.252     albertel  336:     }
                    337: 
1.226     albertel  338:     if ($slotstatus eq 'NOT_IN_A_SLOT' 
                    339: 	&& $checkedin ) {
                    340: 
1.231     albertel  341: 	if ($got_grade) {
1.209     albertel  342: 	    return ('SHOW_ANSWER');
                    343: 	} else {
                    344: 	    return ('WAITING_FOR_GRADE');
                    345: 	}
1.226     albertel  346: 
1.207     albertel  347:     }
1.255     albertel  348: 
1.235     albertel  349:     if ( $is_correct) {
1.255     albertel  350: 	if ($type eq 'problem') {
                    351: 	    return ($status);
                    352: 	}
1.235     albertel  353: 	return ('SHOW_ANSWER');
                    354:     }
1.255     albertel  355: 
1.225     albertel  356:     if ( $status eq 'CANNOT_ANSWER' && 
                    357: 	 ($slotstatus ne 'NEEDS_CHECKIN' && $slotstatus ne 'NOT_IN_A_SLOT')) {
                    358: 	return ($status,$datemsg);
                    359:     }
                    360: 
1.206     albertel  361:     return ($slotstatus,$datemsg,$slot_name,$returned_slot);
1.198     albertel  362: }
1.200     albertel  363: 
1.301     jms       364: # JB, 9/24/2002: Any changes in this function may require a change
                    365: # in lonnavmaps::resource::getDateStatus.
1.53      www       366: sub check_access {
1.145     albertel  367:     my ($id) = @_;
                    368:     my $date ='';
                    369:     my $status;
                    370:     my $datemsg = '';
                    371:     my $lastdate = '';
                    372:     my $type;
                    373:     my $passed;
                    374: 
1.204     albertel  375:     if ($env{'request.state'} eq "construct") {
                    376: 	if ($env{'form.problemstate'}) {
                    377: 	    if ($env{'form.problemstate'} =~ /^CANNOT_ANSWER/) {
1.277     albertel  378: 		if ( ! ($env{'form.problemstate'} eq 'CANNOT_ANSWER_correct' 
                    379: 			&& &hide_problem_status())) {
1.168     albertel  380: 		    return ('CANNOT_ANSWER',
1.174     www       381: 			    &mt('is in this state due to author settings.'));
1.167     albertel  382: 		}
1.165     albertel  383: 	    } else {
1.204     albertel  384: 		return ($env{'form.problemstate'},
1.174     www       385: 			&mt('is in this state due to author settings.'));
1.165     albertel  386: 	    }
                    387: 	}
1.145     albertel  388: 	&Apache::lonxml::debug("in construction ignoring dates");
                    389: 	$status='CAN_ANSWER';
1.146     albertel  390: 	$datemsg=&mt('is in under construction');
1.163     albertel  391: #	return ($status,$datemsg);
1.145     albertel  392:     }
                    393: 
                    394:     &Apache::lonxml::debug("checking for part :$id:");
                    395:     &Apache::lonxml::debug("time:".time);
1.152     albertel  396: 
1.261     albertel  397:     my ($symb)=&Apache::lonnet::whichuser();
1.212     albertel  398:     &Apache::lonxml::debug("symb:".$symb);
                    399:     #if ($env{'request.state'} ne "construct" && $symb ne '') {
1.204     albertel  400:     if ($env{'request.state'} ne "construct") {
1.288     raeburn   401:         my $idacc = &Apache::lonnet::EXT("resource.$id.acc");
1.297     raeburn   402: 	my $allowed=&Apache::loncommon::check_ip_acc($idacc);
1.163     albertel  403: 	if (!$allowed && ($Apache::lonhomework::browse ne 'F')) {
                    404: 	    $status='INVALID_ACCESS';
                    405: 	    $date=&mt("can not be accessed from your location.");
1.145     albertel  406: 	    return($status,$date);
                    407: 	}
1.327     raeburn   408: 	if ($env{'form.grade_imsexport'}) {
                    409:             if (($env{'request.course.id'}) && 
                    410:                 (&Apache::lonnet::allowed('mdc',$env{'request.course.id'}))) {
                    411:                 return ('SHOW_ANSWER');
                    412:             }
                    413:         }
1.226     albertel  414: 	foreach my $temp ("opendate","duedate","answerdate") {
1.163     albertel  415: 	    $lastdate = $date;
1.247     albertel  416: 	    if ($temp eq 'duedate') {
                    417: 		$date = &due_date($id);
                    418: 	    } else {
                    419: 		$date = &Apache::lonnet::EXT("resource.$id.$temp");
                    420: 	    }
                    421: 	    
1.163     albertel  422: 	    my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type");
                    423: 	    if ($thistype =~ /^(con_lost|no_such_host)/ ||
                    424: 		$date     =~ /^(con_lost|no_such_host)/) {
                    425: 		$status='UNAVAILABLE';
                    426: 		$date=&mt("may open later.");
                    427: 		return($status,$date);
                    428: 	    }
                    429: 	    if ($thistype eq 'date_interval') {
                    430: 		if ($temp eq 'opendate') {
                    431: 		    $date=&Apache::lonnet::EXT("resource.$id.duedate")-$date;
                    432: 		}
                    433: 		if ($temp eq 'answerdate') {
                    434: 		    $date=&Apache::lonnet::EXT("resource.$id.duedate")+$date;
                    435: 		}
1.145     albertel  436: 	    }
1.163     albertel  437: 	    &Apache::lonxml::debug("found :$date: for :$temp:");
                    438: 	    if ($date eq '') {
                    439: 		$date = &mt("an unknown date"); $passed = 0;
                    440: 	    } elsif ($date eq 'con_lost') {
                    441: 		$date = &mt("an indeterminate date"); $passed = 0;
                    442: 	    } else {
                    443: 		if (time < $date) { $passed = 0; } else { $passed = 1; }
1.274     www       444: 		$date = &Apache::lonlocal::locallocaltime($date);
1.145     albertel  445: 	    }
1.163     albertel  446: 	    if (!$passed) { $type=$temp; last; }
1.145     albertel  447: 	}
1.163     albertel  448: 	&Apache::lonxml::debug("have :$type:$passed:");
                    449: 	if ($passed) {
                    450: 	    $status='SHOW_ANSWER';
                    451: 	    $datemsg=$date;
                    452: 	} elsif ($type eq 'opendate') {
                    453: 	    $status='CLOSED';
1.343     bisitz    454: 	    $datemsg = &mt('will open on [_1]',$date);
1.163     albertel  455: 	} elsif ($type eq 'duedate') {
                    456: 	    $status='CAN_ANSWER';
1.343     bisitz    457: 	    $datemsg = &mt('is due at [_1]',$date);
1.163     albertel  458: 	} elsif ($type eq 'answerdate') {
                    459: 	    $status='CLOSED';
1.343     bisitz    460: 	    $datemsg = &mt('was due on [_1], and answers will be available on [_2]',
                    461:                                $lastdate,$date);
1.145     albertel  462: 	}
                    463:     }
1.212     albertel  464:     if ($status eq 'CAN_ANSWER' ||
                    465: 	(($Apache::lonhomework::browse eq 'F') && ($status eq 'CLOSED'))) {
1.145     albertel  466: 	#check #tries, and if correct.
                    467: 	my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
                    468: 	my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
                    469: 	if ( $tries eq '' ) { $tries = '0'; }
1.164     albertel  470: 	if ( $maxtries eq '' && 
1.204     albertel  471: 	     $env{'request.state'} ne 'construct') { $maxtries = '2'; } 
1.164     albertel  472: 	if ($maxtries && $tries >= $maxtries) { $status = 'CANNOT_ANSWER'; }
1.145     albertel  473: 	# if (correct and show prob status) or excused then CANNOT_ANSWER
1.331     raeburn   474: 	if ( ($Apache::lonhomework::history{"resource.$id.solved"}=~/^correct/)
                    475: 	      && (&show_problem_status()) ) {
1.333     raeburn   476:             if (($Apache::lonhomework::history{"resource.$id.awarded"} >= 1) ||
                    477:                 (&Apache::lonnet::EXT("resource.$id.retrypartial") !~/^1|on|yes$/i)) {
1.331     raeburn   478: 	        $status = 'CANNOT_ANSWER';
                    479:             }
                    480:         } elsif ($Apache::lonhomework::history{"resource.$id.solved"}=~/^excused/) {
1.145     albertel  481: 	    $status = 'CANNOT_ANSWER';
                    482: 	}
1.285     albertel  483: 	if ($status eq 'CANNOT_ANSWER'
                    484: 	    && &show_answer_problem_status()) {
                    485: 	    $status = 'SHOW_ANSWER';
                    486: 	}
1.121     albertel  487:     }
1.181     albertel  488:     if ($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER') {
1.286     albertel  489: 	my @interval=&Apache::lonnet::EXT("resource.$id.interval");
                    490: 	&Apache::lonxml::debug("looking for interval @interval");
                    491: 	if ($interval[0]) {
                    492: 	    my $first_access=&Apache::lonnet::get_first_access($interval[1]);
1.177     albertel  493: 	    &Apache::lonxml::debug("looking for accesstime $first_access");
                    494: 	    if (!$first_access) {
                    495: 		$status='NOT_YET_VIEWED';
1.247     albertel  496: 		my $due_date = &due_date($id);
1.256     albertel  497: 		my $seconds_left = $due_date - time;
1.286     albertel  498: 		if ($seconds_left > $interval[0] || $due_date eq '') {
                    499: 		    $seconds_left = $interval[0];
1.256     albertel  500: 		}
                    501: 		$datemsg=&seconds_to_human_length($seconds_left);
1.177     albertel  502: 	    }
                    503: 	}
                    504:     }
1.247     albertel  505: 
1.133     albertel  506:   #if (($status ne 'CLOSED') && ($Apache::lonhomework::type eq 'exam') &&
                    507:   #    (!$Apache::lonhomework::history{"resource.0.outtoken"})) {
                    508:   #    return ('UNCHECKEDOUT','needs to be checked out');
                    509:   #}
1.54      www       510: 
1.145     albertel  511:     &Apache::lonxml::debug("sending back :$status:$datemsg:");
                    512:     if (($Apache::lonhomework::browse eq 'F') && ($status eq 'CLOSED')) {
                    513: 	&Apache::lonxml::debug("should be allowed to browse a resource when closed");
                    514: 	$status='CAN_ANSWER';
1.146     albertel  515: 	$datemsg=&mt('is closed but you are allowed to view it');
1.145     albertel  516:     }
1.106     albertel  517: 
1.145     albertel  518:     return ($status,$datemsg);
1.20      albertel  519: }
1.301     jms       520: # this should work exactly like the copy in lonnavmaps.pm
1.246     albertel  521: sub due_date {
1.250     albertel  522:     my ($part_id,$symb,$udom,$uname)=@_;
1.246     albertel  523:     my $date;
1.286     albertel  524:     my @interval= &Apache::lonnet::EXT("resource.$part_id.interval",$symb,
1.250     albertel  525: 				       $udom,$uname);
1.286     albertel  526:     &Apache::lonxml::debug("looking for interval $part_id $symb @interval");
1.250     albertel  527:     my $due_date= &Apache::lonnet::EXT("resource.$part_id.duedate",$symb,
                    528: 				       $udom,$uname);
1.247     albertel  529:     &Apache::lonxml::debug("looking for due_date $part_id $symb $due_date");
1.286     albertel  530:     if ($interval[0] =~ /\d+/) {
                    531: 	my $first_access=&Apache::lonnet::get_first_access($interval[1],$symb);
                    532: 	&Apache::lonxml::debug("looking for first_access $first_access ($interval[1])");
1.247     albertel  533: 	if (defined($first_access)) {
1.286     albertel  534: 	    my $interval = $first_access+$interval[0];
1.283     albertel  535: 	    $date = (!$due_date || $interval < $due_date) ? $interval
                    536:                                                           : $due_date;
1.247     albertel  537: 	} else {
                    538: 	    $date = $due_date;
                    539: 	}
                    540:     } else {
                    541: 	$date = $due_date;
1.246     albertel  542:     }
1.345     musolffc  543:     return $date;
1.246     albertel  544: }
                    545: 
1.192     albertel  546: sub seconds_to_human_length {
                    547:     my ($length)=@_;
                    548: 
                    549:     my $seconds=$length%60; $length=int($length/60);
                    550:     my $minutes=$length%60; $length=int($length/60);
                    551:     my $hours=$length%24;   $length=int($length/24);
                    552:     my $days=$length;
                    553: 
                    554:     my $timestr;
                    555:     if ($days > 0) { $timestr.=&mt('[quant,_1,day]',$days); }
                    556:     if ($hours > 0) { $timestr.=($timestr?", ":"").
                    557: 			  &mt('[quant,_1,hour]',$hours); }
                    558:     if ($minutes > 0) { $timestr.=($timestr?", ":"").
                    559: 			    &mt('[quant,_1,minute]',$minutes); }
                    560:     if ($seconds > 0) { $timestr.=($timestr?", ":"").
                    561: 			    &mt('[quant,_1,second]',$seconds); }
                    562:     return $timestr;
                    563: }
                    564: 
1.41      albertel  565: sub showhash {
1.145     albertel  566:     my (%hash) = @_;
                    567:     &showhashsubset(\%hash,'.');
                    568:     return '';
1.79      albertel  569: }
                    570: 
1.106     albertel  571: sub showarray {
                    572:     my ($array)=@_;
                    573:     my $string="(";
                    574:     foreach my $elm (@{ $array }) {
1.193     albertel  575: 	if (ref($elm) eq 'ARRAY') {
                    576: 	    $string.=&showarray($elm);
                    577: 	} elsif (ref($elm) eq 'HASH') {
                    578: 	    $string.= "HASH --- \n<br />";
                    579: 	    $string.= &showhashsubset($elm,'.');
1.106     albertel  580: 	} else {
                    581: 	    $string.="$elm,"
                    582: 	}
                    583:     }
                    584:     chop($string);
                    585:     $string.=")";
                    586:     return $string;
                    587: }
                    588: 
1.79      albertel  589: sub showhashsubset {
1.145     albertel  590:     my ($hash,$keyre) = @_;
                    591:     my $resultkey;
1.346     raeburn   592:     foreach $resultkey (sort(keys(%$hash))) {
1.193     albertel  593: 	if ($resultkey !~ /$keyre/) { next; }
                    594: 	if (ref($$hash{$resultkey})  eq 'ARRAY' ) {
                    595: 	    &Apache::lonxml::debug("$resultkey ---- ".
                    596: 				   &showarray($$hash{$resultkey}));
                    597: 	} elsif (ref($$hash{$resultkey}) eq 'HASH' ) {
                    598: 	    &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
                    599: 	    &showhashsubset($$hash{$resultkey},'.');
                    600: 	} else {
                    601: 	    &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
1.145     albertel  602: 	}
                    603:     }
                    604:     &Apache::lonxml::debug("\n<br />restored values^</br>\n");
                    605:     return '';
1.41      albertel  606: }
                    607: 
                    608: sub setuppermissions {
1.204     albertel  609:     $Apache::lonhomework::browse= &Apache::lonnet::allowed('bre',$env{'request.filename'});
1.337     raeburn   610:     unless ($Apache::lonhomework::browse eq 'F') {
                    611:         $Apache::lonhomework::browse=&Apache::lonnet::allowed('bro',$env{'request.filename'}); 
                    612:     }
1.204     albertel  613:     my $viewgrades = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.145     albertel  614:     if (! $viewgrades && 
1.204     albertel  615: 	exists($env{'request.course.sec'}) && 
                    616: 	$env{'request.course.sec'} !~ /^\s*$/) {
                    617: 	$viewgrades = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}.
                    618:                                                '/'.$env{'request.course.sec'});
1.145     albertel  619:     }
1.244     albertel  620:     $Apache::lonhomework::viewgrades = $viewgrades;
                    621: 
1.185     albertel  622:     if ($Apache::lonhomework::browse eq 'F' && 
1.204     albertel  623: 	$env{'form.devalidatecourseresdata'} eq 'on') {
1.261     albertel  624: 	my (undef,$courseid) = &Apache::lonnet::whichuser();
1.204     albertel  625: 	&Apache::lonnet::devalidatecourseresdata($env{"course.$courseid.num"},
                    626: 					      $env{"course.$courseid.domain"});
1.185     albertel  627:     }
1.244     albertel  628: 
1.205     albertel  629:     my $modifygrades = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
                    630:     if (! $modifygrades && 
                    631: 	exists($env{'request.course.sec'}) && 
                    632: 	$env{'request.course.sec'} !~ /^\s*$/) {
                    633: 	$modifygrades = 
                    634: 	    &Apache::lonnet::allowed('mgr',$env{'request.course.id'}.
                    635: 				     '/'.$env{'request.course.sec'});
                    636:     }
                    637:     $Apache::lonhomework::modifygrades = $modifygrades;
1.244     albertel  638: 
                    639:     my $queuegrade = &Apache::lonnet::allowed('mqg',$env{'request.course.id'});
                    640:     if (! $queuegrade && 
                    641: 	exists($env{'request.course.sec'}) && 
                    642: 	$env{'request.course.sec'} !~ /^\s*$/) {
                    643: 	$queuegrade = 
                    644: 	    &Apache::lonnet::allowed('qgr',$env{'request.course.id'}.
                    645: 				     '/'.$env{'request.course.sec'});
                    646:     }
                    647:     $Apache::lonhomework::queuegrade = $queuegrade;
1.205     albertel  648:     return '';
1.41      albertel  649: }
                    650: 
1.253     albertel  651: sub unset_permissions {
                    652:     undef($Apache::lonhomework::queuegrade);
                    653:     undef($Apache::lonhomework::modifygrades);
                    654:     undef($Apache::lonhomework::viewgrades);
                    655:     undef($Apache::lonhomework::browse);
                    656: }
                    657: 
1.41      albertel  658: sub setupheader {
1.120     albertel  659:     my $request=$_[0];
1.197     albertel  660:     &Apache::loncommon::content_type($request,'text/html');
1.120     albertel  661:     if (!$Apache::lonxml::debug && ($ENV{'REQUEST_METHOD'} eq 'GET')) {
                    662: 	&Apache::loncommon::no_cache($request);
                    663:     }
1.196     albertel  664: #    $request->set_last_modified(&Apache::lonnet::metadata($request->uri,
                    665: #							  'lastrevisiondate'));
1.120     albertel  666:     $request->send_http_header;
                    667:     return OK if $request->header_only;
                    668:     return ''
1.41      albertel  669: }
1.35      albertel  670: 
1.47      albertel  671: sub handle_save_or_undo {
1.338     raeburn   672:     my ($request,$problem,$result,$getobjref) = @_;
1.323     www       673: 
1.145     albertel  674:     my $file    = &Apache::lonnet::filelocation("",$request->uri);
                    675:     my $filebak =$file.".bak";
                    676:     my $filetmp =$file.".tmp";
                    677:     my $error=0;
1.323     www       678:     if (($env{'form.problemmode'} eq 'undo') || ($env{'form.problemmode'} eq 'undoxml')) {
1.145     albertel  679: 	my $error=0;
1.284     albertel  680: 	if (!&File::Copy::copy($file,$filetmp)) { $error=1; }
                    681: 	if ((!$error) && (!&File::Copy::copy($filebak,$file))) { $error=1; }
                    682: 	if ((!$error) && (!&File::Copy::move($filetmp,$filebak))) { $error=1; }
1.145     albertel  683: 	if (!$error) {
1.266     albertel  684: 	    &Apache::lonxml::info("<p><b>".
                    685: 				  &mt("Undid changes, Switched [_1] and [_2]",
                    686: 				      '<span class="LC_filename">'.$filebak.
                    687: 				      '</span>',
                    688: 				      '<span class="LC_filename">'.$file.
                    689: 				      '</span>')."</b></p>");
1.145     albertel  690: 	} else {
1.266     albertel  691: 	    &Apache::lonxml::info("<p><span class=\"LC_error\">".
                    692: 				  &mt("Unable to undo, unable to switch [_1] and [_2]",
                    693: 				      '<span class="LC_filename">'.
                    694: 				      $filebak.'</span>',
                    695: 				      '<span class="LC_filename">'.
                    696: 				      $file.'</span>')."</span></p>");
1.145     albertel  697: 	    $error=1;
                    698: 	}
1.52      albertel  699:     } else {
1.262     banghart  700:         &Apache::lonnet::correct_line_ends($result);
1.323     www       701: 
1.145     albertel  702: 	my $fs=Apache::File->new(">$filebak");
                    703: 	if (defined($fs)) {
                    704: 	    print $fs $$problem;
                    705: 	} else {
1.266     albertel  706: 	    &Apache::lonxml::info("<span class=\"LC_error\">".
                    707: 				  &mt("Unable to make backup [_1]",
                    708: 				      '<span class="LC_filename">'.
                    709: 				      $filebak.'</span>')."</span>");
1.145     albertel  710: 	    $error=2;
                    711: 	}
                    712: 	my $fh=Apache::File->new(">$file");
                    713: 	if (defined($fh)) {
                    714: 	    print $fh $$result;
1.338     raeburn   715:             if (ref($getobjref) eq 'SCALAR') {
                    716:                 if ($file =~ m{([^/]+)\.(html?)$}) {
                    717:                     my $fname = $1;
                    718:                     my $ext = $2;
                    719:                     my $path = $file;
                    720:                     $path =~ s/\Q$fname\E\.\Q$ext\E$//; 
                    721:                     my (%allfiles,%codebase);
                    722:                     &Apache::lonnet::extract_embedded_items($file,\%allfiles,
                    723:                                                            \%codebase,$result);
                    724:                     if (keys(%allfiles) > 0) {
                    725:                         my $url = $request->uri;
                    726:                         my $state = <<STATE;
                    727:     <input type="hidden" name="action" value="upload_embedded" />
                    728:     <input type="hidden" name="url" value="$url" />
                    729: STATE
                    730:                         $$getobjref = "<h3>".&mt("Reference Warning")."</h3>".
                    731:                                       "<p>".&mt("Completed upload of the file. This file contained references to other files.")."</p>".
                    732:                                       "<p>".&mt("Please select the locations from which the referenced files are to be uploaded.")."</p>".
                    733:                                       &Apache::loncommon::ask_for_embedded_content($url,$state,\%allfiles,\%codebase,
                    734:                                       {'error_on_invalid_names'   => 1,
                    735:                                        'ignore_remote_references' => 1,});
                    736:                     }
                    737:                 }
                    738:             }
1.145     albertel  739: 	} else {
1.266     albertel  740: 	    &Apache::lonxml::info('<span class="LC_error">'.
                    741: 				  &mt("Unable to write to [_1]",
                    742: 				      '<span class="LC_filename">'.
                    743: 				      $file.'</span>').
                    744: 				  '</span>');
1.145     albertel  745: 	    $error|=4;
                    746: 	}
1.52      albertel  747:     }
1.145     albertel  748:     return $error;
1.64      albertel  749: }
                    750: 
1.101     albertel  751: sub analyze_header {
                    752:     my ($request) = @_;
1.289     raeburn   753:     my $js = &Apache::structuretags::setmode_javascript();
1.312     bisitz    754: 
                    755:     # Breadcrumbs
1.330     raeburn   756:     my $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri),
1.338     raeburn   757:                    'text' => 'Authoring Space'},
1.312     bisitz    758:                   {'href' => '',
                    759:                    'text' => 'Problem Testing'},
                    760:                   {'href' => '',
                    761:                    'text' => 'Analyzing a problem'}];
                    762: 
1.238     albertel  763:     my $result =
1.312     bisitz    764:         &Apache::loncommon::start_page('Analyzing a problem',
                    765:                                        $js,
                    766:                                        {'bread_crumbs' => $brcrum,})
1.311     bisitz    767:        .&Apache::loncommon::head_subbox(
                    768:                 &Apache::loncommon::CSTR_pageheader());
1.238     albertel  769:     $result .= 
1.347     golterma  770: 	    '<form name="lonhomework" method="post" action="'.
1.204     albertel  771: 	    &HTML::Entities::encode($env{'request.uri'},'<>&"').'">'.
1.289     raeburn   772:             '<input type="hidden" name="problemmode" value="'.
                    773:             $env{'form.problemmode'}.'" />'.
1.179     albertel  774: 	    &Apache::structuretags::remember_problem_state().'
1.278     albertel  775:             <div class="LC_edit_problem_analyze_header">
1.289     raeburn   776:             <input type="button" name="submitmode" value="'.&mt("EditXML").'" '.
                    777:             'onclick="javascript:setmode(this.form,'."'editxml'".')" />
                    778:             <input type="button" name="submitmode" value="'.&mt('Edit').'" '.
                    779:             'onclick="javascript:setmode(this.form,'."'edit'".')" />
1.313     bisitz    780:             <hr />
1.289     raeburn   781:             <input type="button" name="submitmode" value="'.&mt("View").'" '.
                    782:             'onclick="javascript:setmode(this.form,'."'view'".')" />
1.313     bisitz    783:             <hr />
1.347     golterma  784:             </div>'
                    785:             .&Apache::lonxml::message_location().
                    786:             '</form>';
1.171     albertel  787:     &Apache::lonxml::add_messages(\$result);
1.101     albertel  788:     $request->print($result);
                    789:     $request->rflush();
                    790: }
                    791: 
1.109     albertel  792: sub analyze_footer {
                    793:     my ($request) = @_;
1.237     albertel  794:     $request->print(&Apache::loncommon::end_page());
1.109     albertel  795:     $request->rflush();
                    796: }
                    797: 
1.74      albertel  798: sub analyze {
1.101     albertel  799:     my ($request,$file) = @_;
                    800:     &Apache::lonxml::debug("Analyze");
                    801:     my $result;
                    802:     my %overall;
1.219     www       803:     my %seedexample;
1.101     albertel  804:     my %allparts;
1.204     albertel  805:     my $rndseed=$env{'form.rndseed'};
1.101     albertel  806:     &analyze_header($request);
1.114     albertel  807:     my %prog_state=
1.335     www       808: 	&Apache::lonhtmlcommon::Create_PrgWin($request,$env{'form.numtoanalyze'});
1.204     albertel  809:     for(my $i=1;$i<$env{'form.numtoanalyze'}+1;$i++) {
1.335     www       810: 	&Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state,'last problem');
1.182     albertel  811: 	if (&Apache::loncommon::connection_aborted($request)) { return; }
1.219     www       812:         my $thisseed=$i+$rndseed;
1.101     albertel  813: 	my $subresult=&Apache::lonnet::ssi($request->uri,
                    814: 					   ('grade_target' => 'analyze'),
1.219     www       815: 					   ('rndseed' => $thisseed));
1.101     albertel  816: 	(my $garbage,$subresult)=split(/_HASH_REF__/,$subresult,2);
                    817: 	my %analyze=&Apache::lonnet::str2hash($subresult);
1.114     albertel  818: 	my @parts;
1.336     raeburn   819:         if (ref($analyze{'parts'}) eq 'ARRAY') {
1.114     albertel  820: 	    @parts=@{ $analyze{'parts'} };
                    821: 	}
1.101     albertel  822: 	foreach my $part (@parts) {
                    823: 	    if (!exists($allparts{$part})) {$allparts{$part}=1;};
1.109     albertel  824: 	    if ($analyze{$part.'.type'} eq 'numericalresponse'	||
                    825: 		$analyze{$part.'.type'} eq 'stringresponse'	||
                    826: 		$analyze{$part.'.type'} eq 'formularesponse'   ) {
1.263     albertel  827: 		foreach my $name (keys(%{ $analyze{$part.'.answer'} })) {
                    828: 		    my $i=0;
                    829: 		    foreach my $answer_part (@{ $analyze{$part.'.answer'}{$name} }) {
                    830: 			push( @{ $overall{$part.'.answer'}[$i] },
                    831: 			      $answer_part);
                    832: 			my $concatanswer= join("\0",@{ $answer_part });
                    833: 			if (($concatanswer eq '') || ($concatanswer=~/^\@/)) {
1.266     albertel  834: 			    $answer_part = ['<span class="LC_error">'.&mt('Error').'</span>'];
1.263     albertel  835: 			}
                    836: 			$seedexample{join("\0",$part,$i,@{$answer_part})}=
                    837: 			    $thisseed;
                    838: 			$i++;
                    839: 		    }
1.219     www       840: 		}
1.275     albertel  841: 		if (!keys(%{ $analyze{$part.'.answer'} })) {
                    842: 		    my $answer_part = 
                    843: 			['<span class="LC_error">'.&mt('Error').'</span>'];
                    844: 		    $seedexample{join("\0",$part,0,@{$answer_part})}=
                    845: 			$thisseed;
                    846: 		    push( @{ $overall{$part.'.answer'}[0] },
                    847: 			  $answer_part);
                    848: 		}
1.101     albertel  849: 	    }
                    850: 	}
                    851:     }
1.335     www       852:     &Apache::lonhtmlcommon::Update_PrgWin($request,\%prog_state,&mt('Analyzing Results'));
1.313     bisitz    853:     $request->print('<hr />'
1.308     bisitz    854:                    .'<h3>'
                    855:                    .&mt('List of possible answers')
                    856:                    .'</h3>'
                    857:     );
1.134     albertel  858:     foreach my $part (sort(keys(%allparts))) {
1.336     raeburn   859:         if ((ref($overall{$part.'.answer'}) eq 'ARRAY') &&
                    860:             (@{$overall{$part.'.answer'}} > 0)) {
1.263     albertel  861: 	    for (my $i=0;$i<scalar(@{ $overall{$part.'.answer'} });$i++) {
                    862: 		my $num_cols=scalar(@{ $overall{$part.'.answer'}[$i][0] });
1.308     bisitz    863:                 $request->print(&Apache::loncommon::start_data_table()
                    864:                                .&Apache::loncommon::start_data_table_header_row()
                    865:                                .'<th colspan="'.($num_cols+1).'">'
                    866:                                .&mt('Part').' '.$part
                    867:                 );
1.263     albertel  868: 		if (scalar(@{ $overall{$part.'.answer'} }) > 1) {
1.308     bisitz    869: 		    $request->print(' '.&mt('Answer [_1]',$i+1));
1.263     albertel  870: 		}
1.308     bisitz    871: 		$request->print('</th>'
                    872:                                .&Apache::loncommon::end_data_table_header_row()
                    873:                 );
1.263     albertel  874: 		my %frequency;
                    875: 		foreach my $answer (sort {$a->[0] <=> $b->[0]} (@{ $overall{$part.'.answer'}[$i] })) {
                    876: 		    $frequency{join("\0",@{ $answer })}++;
                    877: 		}
1.308     bisitz    878:                 $request->print(&Apache::loncommon::start_data_table_header_row()
                    879:                                .'<th colspan="'.($num_cols).'">'.&mt('Answer').'</th>'
                    880:                                .'<th>'.&mt('Frequency').'<br />'
                    881:                                .'('.&mt('click for example').')</th>'
                    882:                                .&Apache::loncommon::end_data_table_header_row()
                    883:                 );
1.263     albertel  884: 		foreach my $answer (sort {(split("\0",$a))[0] <=> (split("\0",$b))[0]} (keys(%frequency))) {
1.308     bisitz    885:                     $request->print(&Apache::loncommon::start_data_table_row()
                    886:                                    .'<td>'
                    887:                                    .join('</td><td>',split("\0",$answer))
                    888: 				   .'</td>'
                    889:                                    .'<td>'
                    890:                                    .'<a href="'.$request->uri.'?rndseed='.$seedexample{join("\0",$part,$i,$answer)}.'">'.$frequency{$answer}.'</a>'
                    891: 				   .'</td>'
                    892:                                    .&Apache::loncommon::end_data_table_row()
                    893:                     );
1.263     albertel  894: 		}
1.308     bisitz    895:                 $request->print(&Apache::loncommon::end_data_table());
1.109     albertel  896: 	    }
                    897: 	} else {
1.307     bisitz    898:             $request->print('<p class="LC_warning">'
                    899:                            .&mt('Response [_1] is not analyzable at this time.',$part)
                    900: 			   .'</p>'
                    901:             );
1.101     albertel  902: 	}
                    903:     }
1.130     albertel  904:     if (scalar(keys(%allparts)) == 0 ) {
1.307     bisitz    905:         $request->print('<p class="LC_warning">'
                    906:                        .&mt('Found no analyzable responses in this problem.'
                    907:                            .' Currently only Numerical, Formula and String response styles are supported.')
                    908:                        .'</p>'
                    909:         );
1.130     albertel  910:     }
1.114     albertel  911:     &Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state);
1.109     albertel  912:     &analyze_footer($request);
1.101     albertel  913:     &Apache::lonhomework::showhash(%overall);
                    914:     return $result;
1.74      albertel  915: }
                    916: 
1.277     albertel  917: {
                    918:     my $show_problem_status;
                    919:     sub reset_show_problem_status {
                    920: 	undef($show_problem_status);
                    921:     }
                    922: 
                    923:     sub set_show_problem_status {
                    924: 	my ($new_status) = @_;
                    925: 	$show_problem_status = lc($new_status);
                    926:     }
                    927: 
                    928:     sub hide_problem_status {
                    929: 	return ($show_problem_status eq 'no'
                    930: 		|| $show_problem_status eq 'no_feedback_ever');
                    931:     }
                    932: 
                    933:     sub show_problem_status {
                    934: 	return ($show_problem_status eq 'yes'
1.285     albertel  935: 		|| $show_problem_status eq 'answer'
1.277     albertel  936: 		|| $show_problem_status eq '');
                    937:     }
                    938:     
                    939:     sub show_some_problem_status {
                    940: 	return ($show_problem_status eq 'no');
                    941:     }
                    942: 
                    943:     sub show_no_problem_status {
                    944: 	return ($show_problem_status eq 'no_feedback_ever');
                    945:     }
1.285     albertel  946:   
                    947:     sub show_answer_problem_status {
                    948: 	return ($show_problem_status eq 'answer');
                    949:     }
1.277     albertel  950: }
                    951: 
1.64      albertel  952: sub editxmlmode {
1.145     albertel  953:     my ($request,$file) = @_;
                    954:     my $result;
                    955:     my $problem=&Apache::lonnet::getfile($file);
                    956:     if ($problem eq -1) {
1.305     bisitz    957: 	&Apache::lonxml::error(
1.328     bisitz    958:             '<p class="LC_error">'
1.305     bisitz    959:            .&mt('Unable to find [_1]',
                    960:                 '<span class="LC_filename">'.$file.'</span>')
1.328     bisitz    961:            .'</p>');
1.305     bisitz    962: 
1.145     albertel  963: 	$problem='';
                    964:     }
1.323     www       965:     if (($env{'form.problemmode'} eq 'saveeditxml') ||
1.347     golterma  966:         ($env{'form.problemmode'} eq 'saveviewxml') ||
1.323     www       967:         ($env{'form.problemmode'} eq 'undoxml')) {
1.145     albertel  968: 	my $error=&handle_save_or_undo($request,\$problem,
1.204     albertel  969: 				       \$env{'form.editxmltext'});
1.145     albertel  970: 	if (!$error) { $problem=&Apache::lonnet::getfile($file); }
                    971:     }
1.204     albertel  972:     &Apache::lonhomework::showhashsubset(\%env,'^form');
1.323     www       973:     if ($env{'form.problemmode'} eq 'saveviewxml') {
1.204     albertel  974: 	&Apache::lonhomework::showhashsubset(\%env,'^form');
1.289     raeburn   975: 	$env{'form.problemmode'}='view';
1.145     albertel  976: 	&renderpage($request,$file);
                    977:     } else {
                    978: 	my ($rows,$cols) = &Apache::edit::textarea_sizes(\$problem);
                    979: 	if ($cols > 80) { $cols = 80; }
                    980: 	if ($cols < 70) { $cols = 70; }
                    981: 	if ($rows < 20) { $rows = 20; }
1.269     albertel  982: 	my $js =
                    983: 	    &Apache::edit::js_change_detection(). 
1.289     raeburn   984: 	    &Apache::loncommon::resize_textarea_js().
1.296     raeburn   985:             &Apache::structuretags::setmode_javascript().
1.298     foxr      986:             &Apache::lonhtmlcommon::dragmath_js("EditMathPopup");
1.312     bisitz    987: 
                    988:     # Breadcrumbs
1.330     raeburn   989:     my $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri),
1.338     raeburn   990:                    'text' => 'Authoring Space'},
1.312     bisitz    991:                   {'href' => '',
                    992:                    'text' => 'Problem Editing'}];
                    993: 
1.238     albertel  994: 	my $start_page = 
1.269     albertel  995: 	    &Apache::loncommon::start_page(&mt("EditXML [_1]",$file),$js,
                    996: 					   {'no_auto_mt_title' => 1,
1.318     droeschl  997: 					    'only_body'        => 0,
1.269     albertel  998: 					    'add_entries'      => {
                    999: 						'onresize' => q[resize_textarea('LC_editxmltext','LC_aftertextarea')],
                   1000: 						'onload'   => q[resize_textarea('LC_editxmltext','LC_aftertextarea')],
1.323     www      1001:                                                                   },
1.312     bisitz   1002:                                                 'bread_crumbs' => $brcrum,
1.323     www      1003:                                              });
1.311     bisitz   1004: 
                   1005:     $result=$start_page
                   1006:            .&Apache::loncommon::head_subbox(
                   1007:                 &Apache::loncommon::CSTR_pageheader());
                   1008: 	$result.=&renderpage($request,$file,['no_output_web'],1).
1.310     bisitz   1009:             '<form '.&Apache::edit::form_change_detection().' name="lonhomework" method="post" action="'.
1.204     albertel 1010: 	    &HTML::Entities::encode($env{'request.uri'},'<>&"').'">'.
1.179     albertel 1011: 	    &Apache::structuretags::remember_problem_state().'
1.347     golterma 1012:             <div class="LC_edit_problem_header">
                   1013:               <div class="LC_edit_problem_header_title">'.
                   1014:                 &mt('Problem Editing').' '.&Apache::loncommon::help_open_topic('Problem_Editor_XML_Index').
                   1015:               '</div><div class="LC_edit_actionbar" id="actionbar">';
                   1016: 
1.352     droeschl 1017:     $result.='<input type="hidden" name="problemmode" value="saveedit" />'.
1.348     droeschl 1018:                   &Apache::structuretags::problem_edit_buttons('editxml');
1.352     droeschl 1019:     $result.='<div>';
1.347     golterma 1020: 
1.352     droeschl 1021:     $result .= '<ol class="LC_primary_menu" style="display:inline-block;font-size:90%;vertical-align:middle;">';
                   1022: 
                   1023:     unless ($env{'environment.nocodemirror'}) {
                   1024:         # dropdown menus
                   1025:         $result .= Apache::lonmenu::create_submenu("#", "", 
                   1026:             &mt("Problem Templates"), template_dropdown_datastructure());
                   1027: 
                   1028:         $result .= Apache::lonmenu::create_submenu("#", "", 
                   1029:             &mt("Response Types"), responseblock_dropdown_datastructure());
                   1030: 
                   1031:         $result .= Apache::lonmenu::create_submenu("#", "", 
                   1032:             &mt("Conditional Blocks"), conditional_scripting_datastructure());
                   1033: 
                   1034:         $result .= Apache::lonmenu::create_submenu("#", "", 
                   1035:             &mt("Miscellaneous"), misc_datastructure());
                   1036:     }
1.351     droeschl 1037: 
                   1038:     $result .= Apache::lonmenu::create_submenu("#", "", 
                   1039:         &mt("Help") . ' <img src="/adm/help/help.png" alt="' . &mt("Help") .
                   1040:         '" style="vertical-align:text-bottom; height: auto; margin:0; "/>', 
1.352     droeschl 1041:         helpmenu_datastructure(),"");
1.351     droeschl 1042: 
                   1043:     $result.="</ol></div>";
1.323     www      1044:          
1.352     droeschl 1045:     $result .= '</div></div>' . 
                   1046:         &Apache::lonxml::message_location() .
                   1047:         &Apache::loncommon::xmleditor_js() .
                   1048:         '<textarea ' . &Apache::edit::element_change_detection() .
                   1049:         ' rows="'.$rows.'" cols="'.$cols.'" style="width:100%" ' .
                   1050:         ' name="editxmltext" id="LC_editxmltext">' .
                   1051:         &HTML::Entities::encode($problem,'<>&"') .
                   1052:         '</textarea> <div id="LC_aftertextarea"> </div> </form>';
                   1053: 
                   1054:     my $resource = $env{'request.ambiguous'};
                   1055:     unless($env{'environment.nocodemirror'}){
                   1056:         $result .= '<link rel="stylesheet" href="/adm/codemirror/codemirror-combined-xml.css">
                   1057:         <script src="/adm/codemirror/codemirror-compressed-xml.js"></script>
                   1058:         <script>
                   1059:             CodeMirror.defineMode("mixedmode", function(config) {
                   1060:                 return CodeMirror.multiplexingMode(
                   1061:                     CodeMirror.getMode(config, "xml"),
                   1062:                     {
                   1063:                         open: "\<script type=\"loncapa/perl\"\>", close: "\</script\>",
                   1064:                         mode: CodeMirror.getMode(config, "perl"),
                   1065:                         delimStyle: "tag",
                   1066:                     }
                   1067:               );
                   1068:             });
                   1069:             var cm = CodeMirror.fromTextArea(document.getElementById("LC_editxmltext"),
                   1070:             {
                   1071:                 mode: "mixedmode",
                   1072:                 lineWrapping: true,
                   1073:                 lineNumbers: true,
                   1074:                 tabSize: 4,
                   1075:                 indentUnit: 4,
                   1076: 
                   1077:                 autoCloseTags: true,
                   1078:                 autoCloseBrackets: true,
                   1079:                 height: "auto",
                   1080:                 styleActiveLine: true,
                   1081:                 
                   1082:                 extraKeys: {
                   1083:                     "Tab": "indentMore",
                   1084:                     "Shift-Tab": "indentLess",
                   1085:                 }
                   1086:             });
                   1087:             restoreScrollPosition("'.$resource.'");
                   1088:         </script>';
                   1089:     }
                   1090: 
                   1091:     $result .= &Apache::loncommon::end_page();
                   1092:     &Apache::lonxml::add_messages(\$result);
                   1093:     $request->print($result);
1.145     albertel 1094:     }
                   1095:     return '';
1.47      albertel 1096: }
1.189     albertel 1097: 
1.301     jms      1098: #
                   1099: #    Render the page in whatever target desired.
                   1100: #
1.41      albertel 1101: sub renderpage {
1.213     albertel 1102:     my ($request,$file,$targets,$return_string) = @_;
1.52      albertel 1103: 
1.211     albertel 1104:     my @targets = @{$targets || [&get_target()]};
1.204     albertel 1105:     &Apache::lonhomework::showhashsubset(\%env,'form.');
1.145     albertel 1106:     &Apache::lonxml::debug("Running targets ".join(':',@targets));
1.268     albertel 1107: 
1.171     albertel 1108:     my $overall_result;
1.145     albertel 1109:     foreach my $target (@targets) {
1.183     albertel 1110: 	# FIXME need to do something intelligent when a problem goes
                   1111:         # from viewable to not viewable due to map conditions
                   1112: 	#&setuppermissions();
                   1113: 	#if (   $Apache::lonhomework::browse ne '2'
                   1114: 	#    && $Apache::lonhomework::browse ne 'F' ) {
                   1115: 	#    $request->print(" You most likely shouldn't see me.");
                   1116: 	#}
1.145     albertel 1117: 	#my $t0 = [&gettimeofday()];
1.211     albertel 1118: 	my $output=1;
                   1119: 	if ($target eq 'no_output_web') {
                   1120: 	    $target = 'web'; $output=0;
                   1121: 	}
1.145     albertel 1122: 	my $problem=&Apache::lonnet::getfile($file);
1.222     albertel 1123: 	my $result;
1.145     albertel 1124: 	if ($problem eq -1) {
1.260     albertel 1125: 	    $problem='';
1.222     albertel 1126: 	    my $filename=(split('/',$file))[-1];
1.260     albertel 1127: 	    my $error =
1.347     golterma 1128: 		'<p class="LC_error">'
                   1129:                .&mt('Unable to find [_1]',
                   1130: 			   '<span class="LC_filename">'.$filename.'</span>')
                   1131: 		."</p>";
1.260     albertel 1132: 	    $result.=
                   1133: 		&Apache::loncommon::simple_error_page($request,'Not available',
1.340     bisitz   1134: 						      $error,{'no_auto_mt_msg' => 1});
1.260     albertel 1135: 	    return;
1.145     albertel 1136: 	}
1.52      albertel 1137: 
1.145     albertel 1138: 	my %mystyle;
                   1139: 	if ($target eq 'analyze') { %Apache::lonhomework::analyze=(); }
                   1140: 	if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); }
1.204     albertel 1141: 	if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%env,'^form');}
1.145     albertel 1142: 
                   1143: 	&Apache::lonxml::debug("Should be parsing now");
1.222     albertel 1144: 	$result .= &Apache::lonxml::xmlparse($request, $target, $problem,
                   1145: 					     &setup_vars($target),%mystyle);
1.273     albertel 1146: 	&finished_parsing();
1.214     albertel 1147: 	if (!$output) { $result = ''; }
1.145     albertel 1148: 	#$request->print("Result follows:");
                   1149: 	if ($target eq 'modified') {
                   1150: 	    &handle_save_or_undo($request,\$problem,\$result);
                   1151: 	} else {
                   1152: 	    if ($target eq 'analyze') {
                   1153: 		$result=&Apache::lonnet::hashref2str(\%Apache::lonhomework::analyze);
                   1154: 		undef(%Apache::lonhomework::analyze);
                   1155: 	    }
                   1156: 	    #my $td=&tv_interval($t0);
                   1157: 	    #if ( $Apache::lonxml::debug) {
                   1158: 	    #$result =~ s:</body>::;
                   1159: 	    #$result.="<br />Spent $td seconds processing target $target\n</body>";
                   1160: 	    #}
1.171     albertel 1161: #	    $request->print($result);
                   1162: 	    $overall_result.=$result;
                   1163: #	    $request->rflush();
1.145     albertel 1164: 	}
                   1165: 	#$request->print(":Result ends");
                   1166: 	#my $td=&tv_interval($t0);
1.52      albertel 1167:     }
1.213     albertel 1168:     if (!$return_string) {
                   1169: 	&Apache::lonxml::add_messages(\$overall_result);
                   1170: 	$request->print($overall_result);   
                   1171: 	$request->rflush();   
                   1172:     } else {
                   1173: 	return $overall_result;
                   1174:     }
1.41      albertel 1175: }
                   1176: 
1.273     albertel 1177: sub finished_parsing {
                   1178:     undef($Apache::lonhomework::parsing_a_problem);
                   1179:     undef($Apache::lonhomework::parsing_a_task);
                   1180: }
                   1181: 
1.347     golterma 1182: # function extracted from get_template_html
                   1183: # returns "key" -> list
                   1184: # key: path of template
                   1185: # value 1: title
                   1186: # value 2: category
                   1187: # value 3: name of help topic ???
                   1188: sub get_template_list{
                   1189:     my ($extension) = @_;
                   1190:     
                   1191:     my @files = glob($Apache::lonnet::perlvar{'lonIncludes'}.
                   1192:                      '/templates/*.'.$extension);
                   1193:     @files = map {[$_,&mt(&Apache::lonnet::metadata($_, 'title')),
                   1194:                       (&Apache::lonnet::metadata($_, 'category')?&mt(&Apache::lonnet::metadata($_, 'category')):&mt('Miscellaneous')),
                   1195:                       &mt(&Apache::lonnet::metadata($_, 'help'))]} (@files);
                   1196:     @files = sort {$a->[2].$a->[1] cmp $b->[2].$b->[1]} (@files);
                   1197:     return @files;
                   1198: }
                   1199: 
                   1200: sub get_template_html {
1.282     albertel 1201:     my ($extension) = @_;
1.145     albertel 1202:     my $result;
                   1203:     my @allnames;
                   1204:     &Apache::lonxml::debug("Looking for :$extension:");
1.282     albertel 1205:     my $glob_extension  = $extension;
                   1206:     if ($extension eq 'survey' || $extension eq 'exam') {
                   1207: 	$glob_extension = 'problem';
                   1208:     }
1.347     golterma 1209:     my @files = &get_template_list($extension);
1.287     raeburn  1210:     my ($midpoint,$seconddiv,$numfiles);
1.341     bisitz   1211:     my @noexamplelink = ('blank.problem','blank.library','script.library');
1.287     raeburn  1212:     $numfiles = 0;
                   1213:     foreach my $file (@files) {
                   1214:         next if ($file->[1] !~ /\S/);
                   1215:         $numfiles ++;
                   1216:     }
                   1217:     if ($numfiles > 0) {
                   1218:         $result = '<div class="LC_left_float">';
                   1219:         $midpoint = int($numfiles/2);
                   1220:         if ($numfiles%2) {
                   1221:             $midpoint ++;
                   1222:         }
                   1223:     }
                   1224:     my $count = 0;
1.292     www      1225:     my $currentcategory='';
1.314     bisitz   1226:     my $first = 1;
1.329     raeburn  1227:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.282     albertel 1228:     foreach my $file (@files) {
                   1229: 	next if ($file->[1] !~ /\S/);
1.292     www      1230:         if ($file->[2] ne $currentcategory) {
                   1231:            $currentcategory=$file->[2];
                   1232:            if ((!$seconddiv) && ($count >= $midpoint)) {
1.314     bisitz   1233:                $result .= '</div></div>'."\n".'<div class="LC_left_float">'."\n";
1.292     www      1234:                $seconddiv = 1;
1.314     bisitz   1235:            } elsif (!$first) {
                   1236:                $result.='</div>'."\n";
                   1237:            } else {
                   1238:                $first = 0;
1.292     www      1239:            }
1.314     bisitz   1240:            $result.= '<div class="LC_Box">'."\n"
                   1241:                     .'<h3 class="LC_hcell">'.$currentcategory.'</h3>'."\n";
1.293     www      1242:            $count++;
1.292     www      1243:         }
1.282     albertel 1244: 	$result .=
                   1245: 	    '<label><input type="radio" name="template" value="'.$file->[0].'" />'.
1.292     www      1246: 	    $file->[1].'</label>';
                   1247:         if ($file->[3]) {
                   1248:            $result.=&Apache::loncommon::help_open_topic($file->[3]);
                   1249:         }
1.341     bisitz   1250:         # Provide example link
1.292     www      1251:         my $filename=$file->[0];
1.329     raeburn  1252:         $filename=~s{^\Q$londocroot\E}{};
1.344     raeburn  1253:         if (!(grep($filename =~ /\Q$_\E$/,@noexamplelink))) {
                   1254:             $result .= ' <span class="LC_fontsize_small">'
                   1255:                       .&Apache::loncommon::modal_link(
                   1256:                            $filename.'?inhibitmenu=yes',&mt('Example'),600,420,'sample')
                   1257:                       .'</span>';
                   1258:         }
1.341     bisitz   1259:         $result .= '<br />'."\n";
1.287     raeburn  1260:         $count ++;
                   1261:     }
                   1262:     if ($numfiles > 0) {
1.314     bisitz   1263:         $result .= '</div></div>'."\n".'<div class="LC_clear_float_footer"></div>'."\n";
1.42      albertel 1264:     }
1.145     albertel 1265:     return $result;
1.42      albertel 1266: }
                   1267: 
                   1268: sub newproblem {
1.65      matthew  1269:     my ($request) = @_;
1.282     albertel 1270: 
1.347     golterma 1271: 	if ($env{'form.mode'} eq 'blank'){
                   1272:         my $dest = &Apache::lonnet::filelocation("",$request->uri);
                   1273:         &File::Copy::copy('/home/httpd/html/res/adm/includes/templates/blank.problem',$dest);
                   1274:         &renderpage($request,$dest);
                   1275:         return;
                   1276:     }
1.282     albertel 1277:     if ($env{'form.template'}) {
                   1278: 	my $file = $env{'form.template'};
1.65      matthew  1279: 	my $dest = &Apache::lonnet::filelocation("",$request->uri);
1.282     albertel 1280: 	&File::Copy::copy($file,$dest);
1.65      matthew  1281: 	&renderpage($request,$dest);
1.282     albertel 1282: 	return;
                   1283:     }
                   1284: 
                   1285:     my ($extension) = ($request->uri =~ m/\.(\w+)$/);
                   1286:     &Apache::lonxml::debug("Looking for :$extension:");
1.347     golterma 1287:     my $templatelist=&get_template_html($extension);
1.282     albertel 1288:     if ($env{'form.newfile'} && !$templatelist) {
                   1289: 	# no templates found
1.131     albertel 1290: 	my $templatefilename =
1.258     albertel 1291: 	    $request->dir_config('lonIncludes').'/templates/blank.'.$extension;
1.131     albertel 1292: 	&Apache::lonxml::debug("$templatefilename");
                   1293: 	my $dest = &Apache::lonnet::filelocation("",$request->uri);
1.282     albertel 1294: 	&File::Copy::copy($templatefilename,$dest);
1.131     albertel 1295: 	&renderpage($request,$dest);
1.85      albertel 1296:     } else {
1.176     albertel 1297: 	my $url=&HTML::Entities::encode($request->uri,'<>&"');
1.65      matthew  1298: 	my $dest = &Apache::lonnet::filelocation("",$request->uri);
1.128     albertel 1299: 	my $errormsg;
1.85      albertel 1300: 	my $instructions;
1.330     raeburn  1301:         my $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri),
1.338     raeburn  1302:                        'text' => 'Authoring Space'},
1.312     bisitz   1303:                       {'href' => '',
                   1304:                        'text' => "Create New $extension"}];
1.240     albertel 1305: 	my $start_page = 
1.312     bisitz   1306:             &Apache::loncommon::start_page("Create New $extension",
                   1307:                                            undef,
                   1308:                                            {'bread_crumbs' => $brcrum,});
1.311     bisitz   1309: 	$request->print(
                   1310:         $start_page
                   1311:        .&Apache::loncommon::head_subbox(
                   1312:                 &Apache::loncommon::CSTR_pageheader())
                   1313:        .'<h1>'.&mt("Creating a new $extension resource.")."</h1>
1.128     albertel 1314: $errormsg
1.258     albertel 1315: ".&mt("The requested file [_1] currently does not exist.",
1.329     raeburn  1316:       '<span class="LC_filename">'.$url.'</span>').'
1.314     bisitz   1317: <p class="LC_info">
                   1318: '.&mt("To create a new $extension, select a template from the".
                   1319:       " list below. Then click on the \"Create $extension\" button.").'
                   1320: </p><div><form action="'.$url.'" method="post">');
1.258     albertel 1321: 
1.85      albertel 1322: 	if (defined($templatelist)) {
1.282     albertel 1323: 	    $request->print($templatelist);
1.85      albertel 1324: 	}
1.282     albertel 1325: 	$request->print('<br /><input type="submit" name="newfile" value="'.
                   1326: 			&mt("Create $extension").'" />');
1.314     bisitz   1327: 	$request->print('</form></div>'.&Apache::loncommon::end_page());
1.65      matthew  1328:     }
1.282     albertel 1329:     return;
1.42      albertel 1330: }
                   1331: 
1.268     albertel 1332: sub update_construct_style {
                   1333:     if ($env{'request.state'} eq "construct"
1.289     raeburn  1334: 	&& $env{'form.problemmode'} eq 'view' 
1.268     albertel 1335: 	&&  defined($env{'form.submitted'})
                   1336: 	&& !defined($env{'form.resetdata'})
                   1337: 	&& !defined($env{'form.newrandomization'})) {
                   1338: 	if ((!$env{'form.style_file'} && $env{'construct.style'})
                   1339: 	    ||$env{'form.clear_style_file'}) {
1.303     raeburn  1340: 	    &Apache::lonnet::delenv('construct.style');
1.268     albertel 1341: 	} elsif ($env{'form.style_file'} 
                   1342: 	    && $env{'construct.style'} ne $env{'form.style_file'}) {
1.291     raeburn  1343: 	    &Apache::lonnet::appenv({'construct.style' => 
                   1344: 				        $env{'form.style_file'}});
1.268     albertel 1345: 	}
                   1346:     }
                   1347: }
                   1348: 
                   1349: 
1.41      albertel 1350: sub handler {
1.145     albertel 1351:     #my $t0 = [&gettimeofday()];
                   1352:     my $request=$_[0];
1.223     albertel 1353:     $Apache::lonxml::request=$request;
1.204     albertel 1354:     $Apache::lonxml::debug=$env{'user.debug'};
                   1355:     $env{'request.uri'}=$request->uri;
1.180     albertel 1356:     &setuppermissions();
1.193     albertel 1357: 
1.145     albertel 1358:     my $file=&Apache::lonnet::filelocation("",$request->uri);
                   1359: 
                   1360:     #check if we know where we are
1.350     raeburn  1361:     if ($env{'request.course.fn'} && !&Apache::lonnet::symbread('','',1,1)) {
1.145     albertel 1362: 	# if we are browsing we might not be able to know where we are
1.173     albertel 1363: 	if ($Apache::lonhomework::browse ne 'F' && 
1.204     albertel 1364: 	    $env{'request.state'} ne "construct") {
1.145     albertel 1365: 	    #should know where we are, so ask
1.253     albertel 1366: 	    &unset_permissions();
                   1367: 	    $request->internal_redirect('/adm/ambiguous');
                   1368: 	    return OK;
1.145     albertel 1369: 	}
                   1370:     }
1.253     albertel 1371:     if (&setupheader($request)) {
                   1372: 	&unset_permissions();
                   1373: 	return OK;
                   1374:     }
1.244     albertel 1375:     &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:$Apache::lonhomework::modifygrades:$Apache::lonhomework::queuegrade");
1.204     albertel 1376:     &Apache::lonxml::debug("Problem Mode ".$env{'form.problemmode'});
1.261     albertel 1377:     my ($symb) = &Apache::lonnet::whichuser();
1.145     albertel 1378:     &Apache::lonxml::debug('symb is '.$symb);
1.204     albertel 1379:     if ($env{'request.state'} eq "construct") {
1.145     albertel 1380: 	if ( -e $file ) {
                   1381: 	    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                   1382: 						    ['problemmode']);
1.204     albertel 1383: 	    if (!(defined $env{'form.problemmode'})) {
1.145     albertel 1384: 		#first visit to problem in construction space
1.289     raeburn  1385: 		$env{'form.problemmode'}= 'view';
1.145     albertel 1386: 		&renderpage($request,$file);
1.323     www      1387: 	    } elsif (($env{'form.problemmode'} eq 'editxml') || 
                   1388:                      ($env{'form.problemmode'} eq 'saveeditxml') ||
                   1389:                      ($env{'form.problemmode'} eq 'saveviewxml') ||
                   1390:                      ($env{'form.problemmode'} eq 'undoxml')) {
1.145     albertel 1391: 		&editxmlmode($request,$file);
1.289     raeburn  1392: 	    } elsif ($env{'form.problemmode'} eq 'calcanswers') {
1.145     albertel 1393: 		&analyze($request,$file);
                   1394: 	    } else {
1.268     albertel 1395: 		&update_construct_style();
1.145     albertel 1396: 		&renderpage($request,$file);
                   1397: 	    }
                   1398: 	} else {
1.347     golterma 1399: 		&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                   1400: 						    ['mode']);
1.145     albertel 1401: 	    # requested file doesn't exist in contruction space
                   1402: 	    &newproblem($request);
                   1403: 	}
                   1404:     } else {
                   1405: 	# just render the page normally outside of construction space
                   1406: 	&Apache::lonxml::debug("not construct");
1.52      albertel 1407: 	&renderpage($request,$file);
1.41      albertel 1408:     }
1.145     albertel 1409:     #my $td=&tv_interval($t0);
                   1410:     #&Apache::lonxml::debug("Spent $td seconds processing");
                   1411:     # always turn off debug messages
                   1412:     $Apache::lonxml::debug=0;
1.253     albertel 1413:     &unset_permissions();
1.145     albertel 1414:     return OK;
1.52      albertel 1415: 
1.1       albertel 1416: }
                   1417: 
1.352     droeschl 1418: sub template_dropdown_datastructure {
                   1419:     # gathering the all templates and their path, title, category and help topic
                   1420:     my @templates = get_template_list('problem');
                   1421:     # template category => title
                   1422:     my %tmplthash = ();
                   1423:     # template title => path
                   1424:     my %tmpltcontent = ();
                   1425: 	
                   1426:     foreach my $template (@templates){
                   1427:         # put in hash if the template is not empty
                   1428:         unless ($template->[1] eq ''){
                   1429:             push(@{$tmplthash{$template->[2]}}, $template->[1]);
                   1430:             push(@{$tmpltcontent{$template->[1]}},$template->[0]);
                   1431:         }
                   1432:     }
                   1433: 
                   1434: 	my $catList = [];
                   1435:     foreach my $cat (sort keys %tmplthash) {
                   1436: 		my $catItems = [];
                   1437:         foreach my $title (sort @{$tmplthash{$cat}}) {
                   1438:             my $path = $tmpltcontent{$title}->[0];
                   1439:             my $code;
                   1440:             open(FH, "<$path");
                   1441:             while(<FH>){
                   1442:                 $code.= $_ unless $_ =~ /(<problem>)|(<\/problem>)/;
                   1443:             }
                   1444:             close(FH);
                   1445: 
                   1446: 			if ($code ne '') {				
                   1447:                 my $href = 'javascript:insertText(\'' . &convert_for_js(&HTML::Entities::encode($code,'<>&"')) . '\')';
                   1448: 				my $currItem = [$href, $title, undef];
                   1449: 				push @{$catItems}, $currItem;
                   1450: 			}
                   1451:         }
                   1452: 		push @{$catList}, [$catItems, $cat, undef];
                   1453:     }
                   1454: 
                   1455:     return $catList;
                   1456: }
                   1457: 
                   1458: sub responseblock_dropdown_datastructure {
                   1459: 	
                   1460: 	my $mathCat = [
                   1461: 		[
                   1462: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_formularesponse())) . "\')", &mt("Formula Response"), undef],
                   1463: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_functionplotresponse())) . "\')", &mt("Function Plot Response"), undef],
                   1464: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_mathresponse())) . "\')", &mt("Math Response"), undef],
                   1465: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_numericalresponse())) . "\')", &mt("Numerical Response"), undef]
                   1466: 		], 
                   1467: 		&mt("Math"), 
                   1468: 		undef
                   1469: 	];
                   1470: 
                   1471: 	my $miscCat = [		
                   1472: 		[
                   1473:             ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_imageresponse())) . "\')", &mt("Click on Image"), undef],
                   1474:             ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_customresponse())) . "\')", &mt("Custom Response"), undef],
                   1475:             ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_externalresponse())) . "\')", &mt("External Response"), undef],
                   1476:             ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_matchresponse())) . "\')", &mt("Match Two Lists"), undef],
                   1477:             ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_radiobuttonresponse())) . "\')", &mt("One out of N statements"), undef],
                   1478:             ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_optionresponse())) . "\')", &mt("Select from Options"), undef], 
                   1479: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_rankresponse())) . "\')", &mt("Rank Values"), undef]
                   1480: 		],
                   1481: 		&mt("Miscellaneous"),
                   1482: 		undef
                   1483: 	];
                   1484: 
                   1485: 	my $chemCat = [
                   1486: 		[
                   1487: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_reactionresponse())) . "\')", &mt("Chemical Reaction"), undef],
                   1488: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_organicresponse())) . "\')", &mt("Organic Chemical Structure"), undef]
                   1489: 		],
                   1490: 		&mt("Chemistry"),
                   1491: 		undef
                   1492: 	];
                   1493: 
                   1494: 	my $textCat = [
                   1495: 		[
                   1496: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_stringresponse())) . "\')", &mt("String Response"), undef],
                   1497: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_essayresponse())) . "\')", &mt("Essay"), undef]
                   1498: 		],
                   1499: 		&mt("Text"),
                   1500: 		undef
                   1501: 	];
                   1502: 
                   1503:     return [$mathCat, $miscCat, $chemCat, $textCat];
                   1504: }
                   1505: 
                   1506: 
                   1507: sub conditional_scripting_datastructure {
                   1508: # TODO: corresponding routines should be used for the javascript:insertText parts
                   1509: # instead of the placeholder routine default_xml_tag with the tags
                   1510: # e.g. &default_xml_tag("postanswerdate") should be replaced with a routine which
                   1511: # returns the corresponding content for this case
                   1512: 
                   1513: #TODO translated is currently temporarily here, another solution should be found where the
                   1514: # needed string can be retrieved
                   1515: 
                   1516: 	my $translatedTag = '
                   1517: <translated>
                   1518:     <lang which="en"></lang>
                   1519:     <lang which="default"></lang>
                   1520: </translated>';
                   1521:     return [
                   1522: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode($translatedTag)) . "\')", &mt("Translated Block"), undef],
                   1523: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("block"))) . "\')", &mt("Conditional Block"), undef],
                   1524: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("postanswerdate"))) . "\')", &mt("After Answer Date Block"), undef],
                   1525: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("preduedate"))) . "\')", &mt("Before Due Date Block"), undef],
                   1526: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("solved"))) . "\')", &mt("Block For After Solved"), undef],
                   1527: 			["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("notsolved"))) . "\')", &mt("Block For When Not Solved"), undef]
                   1528:         ];
                   1529: }
                   1530: 
                   1531: sub misc_datastructure {
                   1532:     return [
                   1533:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_img())) . "\')", &mt("Image"), undef],
                   1534:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::lonplot::insert_gnuplot())) . "\')", &mt("GNU Plot"), undef],
                   1535:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_organicstructure())) . "\')", &mt("Organic Structure"), undef],
                   1536:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_script())) . "\')", &mt("Script Block"), undef],
                   1537:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("allow"))) . "\')", &mt("File Dependencies"), undef],
                   1538:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("import"))) . "\')", &mt("Import a File"), undef],
1.353   ! droeschl 1539:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::londefdef::insert_meta())) . "\')", &mt("Custom Metadata"), undef],
        !          1540:         ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("part"))) . "\')", &mt("Problem Part"), undef]
1.352     droeschl 1541:     ];
                   1542: }
                   1543: 
                   1544: # helper routine for the datastructure building subroutines
                   1545: sub default_xml_tag {
                   1546: 	my ($tag) = @_;
                   1547: 	return "\n<$tag></$tag>";
                   1548: }
                   1549: 
                   1550: 
                   1551: sub helpmenu_datastructure {
                   1552: 
                   1553: 	my $width = 500;
                   1554: 	my $height = 600;
                   1555: 
                   1556: 	my $helpers = [
                   1557: 		['Problem_LON-CAPA_Functions', &mt('Script Functions')],
                   1558: 		['Greek_Symbols', &mt('Greek Symbols')],
                   1559:  		['Other_Symbols', &mt('Other Symbols')],
                   1560: 		['Authoring_Output_Tags', &mt('Output Tags')],
                   1561: 		['Authoring_Multilingual_Problems', 
                   1562: 			&mt('How to create problems in different languages')]
                   1563: 	];
                   1564: 
                   1565: 	my $help_structure = [];
                   1566: 
                   1567: 	foreach my $count (0..(scalar(@{$helpers})-1)) {
                   1568: 		my $filename = $helpers->[$count]->[0];
                   1569: 		my $title = $helpers->[$count]->[1];
                   1570: 		my $href = &HTML::Entities::encode("javascript:openMyModal('/adm/help/$filename.hlp',$width,$height,'yes');");
                   1571: 		push @{$help_structure}, [$href, $title, undef];
                   1572: 	}
                   1573: 
                   1574: 	return $help_structure;
                   1575: }
                   1576: 
                   1577: # we need substitution to not break javascript code
                   1578: sub convert_for_js {
                   1579:     my $return = shift;
                   1580:         $return =~ s|script|ESCAPEDSCRIPT|g;
                   1581:         $return =~ s|\\|\\\\|g;
                   1582:         $return =~ s|\n|\\r\\n|g;
                   1583:         $return =~ s|'|\\'|g;
                   1584: 		$return =~ s|&#39;|\\&#39;|g;
                   1585:     return $return;
                   1586: }
                   1587: 
1.1       albertel 1588: 1;
                   1589: __END__

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.