--- loncom/homework/lonhomework.pm 2015/05/16 23:29:17 1.353 +++ loncom/homework/lonhomework.pm 2023/04/02 03:16:28 1.375 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Homework handler # -# $Id: lonhomework.pm,v 1.353 2015/05/16 23:29:17 droeschl Exp $ +# $Id: lonhomework.pm,v 1.375 2023/04/02 03:16:28 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -49,15 +49,23 @@ use Apache::matchresponse(); use Apache::chemresponse(); use Apache::functionplotresponse(); use Apache::drawimage(); +use Apache::loncapamath(); +use Apache::loncourseuser(); +use Apache::grades(); use Apache::Constants qw(:common); use Apache::loncommon(); +use Apache::lonparmset(); +use Apache::lonnavmaps(); use Apache::lonlocal; +use LONCAPA qw(:DEFAULT :match); +use LONCAPA::ltiutils(); use Time::HiRes qw( gettimeofday tv_interval ); use HTML::Entities(); use File::Copy(); # FIXME - improve commenting +my $registered_cleanup; BEGIN { &Apache::lonxml::register_insert(); @@ -188,7 +196,7 @@ sub proctor_checked_in { if ($type eq 'Task') { my $version=$Apache::lonhomework::history{'resource.0.version'}; $key ="resource.$version.0.checkedin"; - } elsif ($type eq 'problem') { + } elsif (($type eq 'problem') || ($type eq 'tool')) { $key ='resource.0.checkedin'; } # backward compatability, used to be username@domain, @@ -203,24 +211,57 @@ sub proctor_checked_in { return 1; } } - return 0; } sub check_slot_access { - my ($id,$type)=@_; + my ($id,$type,$symb,$partlist)=@_; # does it pass normal muster - my ($status,$datemsg)=&check_access($id); - - my $useslots = &Apache::lonnet::EXT("resource.0.useslots"); + my ($status,$datemsg)=&check_access($id,$symb); + + my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb); if ($useslots ne 'resource' && $useslots ne 'map' && $useslots ne 'map_map') { return ($status,$datemsg); } - if ($status eq 'SHOW_ANSWER' || - $status eq 'CLOSED' || + my $checkin = 'resource.0.checkedin'; + my $version; + if ($type eq 'Task') { + $version=$Apache::lonhomework::history{'resource.version'}; + $checkin = "resource.$version.0.checkedin"; + } + my $checkedin = $Apache::lonhomework::history{$checkin}; + my ($returned_slot,$slot_name,$checkinslot,$ipused,$blockip,$now,$ip, + $consumed_uniq); + $now = time; + $ip=$ENV{'REMOTE_ADDR'} || $env{'request.host'}; + + if ($checkedin) { + $checkinslot = $Apache::lonhomework::history{"$checkin.slot"}; + my %slot=&Apache::lonnet::get_slot($checkinslot); + $consumed_uniq = $slot{'uniqueperiod'}; + if ($slot{'iptied'}) { + $ipused = $Apache::lonhomework::history{"$checkin.ip"}; + unless (($ip ne '') && + (($ipused eq $ip) || ($ENV{'REMOTE_ADDR'} eq '127.0.0.1'))) { + $blockip = $slot{'iptied'}; + $slot_name = $checkinslot; + $returned_slot = \%slot; + } + } + } + + if ($status eq 'SHOW_ANSWER') { + if ($blockip eq 'answer') { + return ('NEED_DIFFERENT_IP','',$slot_name,$returned_slot,$ipused); + } else { + return ($status,$datemsg); + } + } + + if ($status eq 'CLOSED' || $status eq 'INVALID_ACCESS' || $status eq 'UNAVAILABLE') { return ($status,$datemsg); @@ -228,26 +269,38 @@ sub check_slot_access { if ($env{'request.state'} eq "construct") { return ($status,$datemsg); } - + if ($type eq 'Task') { - my $version=$Apache::lonhomework::history{'resource.version'}; - if ($Apache::lonhomework::history{"resource.$version.0.checkedin"} && + if ($checkedin && $Apache::lonhomework::history{"resource.$version.0.status"} eq 'pass') { - return ('SHOW_ANSWER'); - } + if ($blockip eq 'answer') { + return ('NEED_DIFFERENT_IP','',$slot_name,$returned_slot,$ipused); + } else { + return ('SHOW_ANSWER'); + } + } + } elsif (($type eq 'problem') && + ($Apache::lonhomework::browse eq 'F') && + ($ENV{'REMOTE_ADDR'} eq '127.0.0.1') && + ($env{'form.grade_courseid'} eq $env{'request.course.id'}) && + (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}))) { + return ($status,$datemsg); } - my $availablestudent = &Apache::lonnet::EXT("resource.0.availablestudent"); - my $available = &Apache::lonnet::EXT("resource.0.available"); + my $availablestudent = &Apache::lonnet::EXT("resource.0.availablestudent",$symb); + my $available = &Apache::lonnet::EXT("resource.0.available",$symb); my @slots= (split(':',$availablestudent),split(':',$available)); # if (!@slots) { # return ($status,$datemsg); # } + undef($returned_slot); + undef($slot_name); my $slotstatus='NOT_IN_A_SLOT'; - my ($returned_slot,$slot_name); - my $now = time; my $num_usable_slots = 0; + if (!$symb) { + ($symb) = &Apache::lonnet::whichuser(); + } foreach my $slot (@slots) { $slot =~ s/(^\s*|\s*$)//g; &Apache::lonxml::debug("getting $slot"); @@ -258,12 +311,41 @@ sub check_slot_access { if ($slot{'starttime'} < $now && $slot{'endtime'} > $now && &Apache::loncommon::check_ip_acc($slot{'ip'})) { - &Apache::lonxml::debug("$slot is good"); - $slotstatus='NEEDS_CHECKIN'; - $returned_slot=\%slot; - $slot_name=$slot; - last; - } + if ($slot{'iptied'}) { + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + if ($slot eq $checkinslot) { + if ($ip eq $ipused) { + &Apache::lonxml::debug("$slot is good"); + $slotstatus ='NEEDS_CHECKIN'; + } else { + $slotstatus = 'NEED_DIFFERENT_IP'; + $slot_name = $slot; + $returned_slot = \%slot; + last; + } + } elsif ($ip) { + my $uniqkey = "$slot\0$symb\0$ip"; + my %used_ip = &Apache::lonnet::get('slot_uniqueips',[$uniqkey],$cdom,$cnum); + if ($used_ip{$uniqkey}) { + $slotstatus = 'NEED_DIFFERENT_IP'; + } else { + &Apache::lonxml::debug("$slot is good"); + $slotstatus ='NEEDS_CHECKIN'; + } + } + } + } else { + &Apache::lonxml::debug("$slot is good"); + $slotstatus='NEEDS_CHECKIN'; + } + if ($slotstatus eq 'NEEDS_CHECKIN') { + $returned_slot=\%slot; + $slot_name=$slot; + last; + } + } } if ($slotstatus eq 'NEEDS_CHECKIN' && &proctor_checked_in($slot_name,$returned_slot,$type)) { @@ -271,7 +353,7 @@ sub check_slot_access { $slotstatus=$status; } - my ($is_correct,$got_grade,$checkedin); + my ($is_correct,$got_grade); if ($type eq 'Task') { my $version=$Apache::lonhomework::history{'resource.0.version'}; $got_grade = @@ -280,13 +362,49 @@ sub check_slot_access { $is_correct = ($Apache::lonhomework::history{"resource.$version.0.status"} eq 'pass' || $Apache::lonhomework::history{"resource.0.solved"} =~ /^correct_/ ); - $checkedin = - $Apache::lonhomework::history{"resource.$version.0.checkedin"}; - } elsif ($type eq 'problem') { - $got_grade = 1; - $checkedin = $Apache::lonhomework::history{"resource.0.checkedin"}; - $is_correct = - ($Apache::lonhomework::history{"resource.0.solved"} =~/^correct_/); + } elsif (($type eq 'problem') || ($type eq 'tool')) { + if ((ref($partlist) eq 'ARRAY') && (@{$partlist} > 0)) { + my ($numcorrect,$numgraded) = (0,0); + foreach my $part (@{$partlist}) { + my $currtries = $Apache::lonhomework::history{"resource.$part.tries"}; + my $maxtries = &Apache::lonnet::EXT("resource.$part.maxtries",$symb); + my $probstatus = &Apache::structuretags::get_problem_status($part); + my $earlyout; + unless (($probstatus eq 'no') || + ($probstatus eq 'no_feedback_ever')) { + if ($Apache::lonhomework::history{"resource.$part.solved"} =~/^correct_/) { + $numcorrect ++; + } else { + $earlyout = 1; + } + } + if ($currtries == $maxtries) { + $earlyout = 1; + } else { + $numgraded ++; + } + last if ($earlyout); + } + my $numparts = scalar(@{$partlist}); + if ($numparts == $numcorrect) { + $is_correct = 1; + } + if ($numparts == $numgraded) { + $got_grade = 1; + } + } else { + my $currtries = $Apache::lonhomework::history{"resource.0.tries"}; + my $maxtries = &Apache::lonnet::EXT("resource.0.maxtries",$symb); + my $probstatus = &Apache::structuretags::get_problem_status('0'); + unless (($probstatus eq 'no') || + ($probstatus eq 'no_feedback_ever')) { + $is_correct = + ($Apache::lonhomework::history{"resource.0.solved"} =~/^correct_/); + } + unless (($currtries == $maxtries) || ($is_correct)) { + $got_grade = 1; + } + } } &Apache::lonxml::debug(" slot is $slotstatus checkedin ($checkedin) got_grade ($got_grade) is_correct ($is_correct)"); @@ -303,33 +421,13 @@ sub check_slot_access { # However, the problem is not closed, and potentially, another slot might be # used to gain access to it to work on it, until the due date is reached, and the # problem then becomes CLOSED. Therefore return the slotstatus - - # (which will be one of: NOT_IN_A_SLOT, RESERVABLE, RESERVABLE_LATER, or NOTRESERVABLE. - if (!defined($slot_name) && $type eq 'problem') { + # (which will be one of: NOT_IN_A_SLOT, RESERVABLE, RESERVABLE_LATER, or NOTRESERVABLE). + + if (!defined($slot_name) && (($type eq 'problem') || ($type eq 'tool'))) { if ($slotstatus eq 'NOT_IN_A_SLOT') { if (!$num_usable_slots) { - if ($env{'request.course.id'}) { - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my ($symb)=&Apache::lonnet::whichuser(); - $slotstatus = 'NOTRESERVABLE'; - my ($reservable_now_order,$reservable_now,$reservable_future_order, - $reservable_future) = - &Apache::loncommon::get_future_slots($cnum,$cdom,$now,$symb); - if ((ref($reservable_now_order) eq 'ARRAY') && (ref($reservable_now) eq 'HASH')) { - if (@{$reservable_now_order} > 0) { - $slotstatus = 'RESERVABLE'; - $datemsg = $reservable_now->{$reservable_now_order->[-1]}{'endreserve'}; - } - } - unless ($slotstatus eq 'RESERVABLE') { - if ((ref($reservable_future_order) eq 'ARRAY') && (ref($reservable_future) eq 'HASH')) { - if (@{$reservable_future_order} > 0) { - $slotstatus = 'RESERVABLE_LATER'; - $datemsg = $reservable_future->{$reservable_future_order->[0]}{'startreserve'}; - } - } - } - } + ($slotstatus,$datemsg) = &check_reservable_slot($slotstatus,$symb,$now,$checkedin, + $consumed_uniq); } } return ($slotstatus,$datemsg); @@ -339,32 +437,111 @@ sub check_slot_access { && $checkedin ) { if ($got_grade) { - return ('SHOW_ANSWER'); + if ($blockip eq 'answer') { + return ('NEED_DIFFERENT_IP','',$slot_name,$returned_slot,$ipused); + } else { + return ('SHOW_ANSWER'); + } } else { return ('WAITING_FOR_GRADE'); } } - if ( $is_correct) { - if ($type eq 'problem') { + if (($is_correct) && ($blockip ne 'answer')) { + if (($type eq 'problem') || ($type eq 'tool')) { return ($status); } return ('SHOW_ANSWER'); } if ( $status eq 'CANNOT_ANSWER' && - ($slotstatus ne 'NEEDS_CHECKIN' && $slotstatus ne 'NOT_IN_A_SLOT')) { + ($slotstatus ne 'NEEDS_CHECKIN' && $slotstatus ne 'NOT_IN_A_SLOT' && + $slotstatus ne 'NEED_DIFFERENT_IP') ) { return ($status,$datemsg); } + return ($slotstatus,$datemsg,$slot_name,$returned_slot,$ipused); +} - return ($slotstatus,$datemsg,$slot_name,$returned_slot); +sub check_reservable_slot { + my ($slotstatus,$symb,$now,$checkedin,$consumed_uniq) = @_; + my $datemsg; + if ($slotstatus eq 'NOT_IN_A_SLOT') { + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + unless ($symb) { + ($symb)=&Apache::lonnet::whichuser(); + } + $slotstatus = 'NOTRESERVABLE'; + my ($reservable_now_order,$reservable_now,$reservable_future_order, + $reservable_future) = + &Apache::loncommon::get_future_slots($cnum,$cdom,$now,$symb); + if ((ref($reservable_now_order) eq 'ARRAY') && (ref($reservable_now) eq 'HASH')) { + if (@{$reservable_now_order} > 0) { + if ((!$checkedin) || (ref($consumed_uniq) ne 'ARRAY')) { + $slotstatus = 'RESERVABLE'; + $datemsg = $reservable_now->{$reservable_now_order->[-1]}{'endreserve'}; + } else { + my ($uniqstart,$uniqend,$useslot); + if (ref($consumed_uniq) eq 'ARRAY') { + ($uniqstart,$uniqend)=@{$consumed_uniq}; + } + foreach my $slot (reverse(@{$reservable_now_order})) { + if ($reservable_now->{$slot}{'uniqueperiod'} =~ /^(\d+)\,(\d+)$/) { + my ($new_uniq_start,$new_uniq_end) = ($1,$2); + next if (! + ($uniqstart < $new_uniq_start && $uniqend < $new_uniq_start) || + ($uniqstart > $new_uniq_end && $uniqend > $new_uniq_end )); + } + $useslot = $slot; + last; + } + if ($useslot) { + $slotstatus = 'RESERVABLE'; + $datemsg = $reservable_now->{$useslot}{'endreserve'}; + } + } + } + } + unless ($slotstatus eq 'RESERVABLE') { + if ((ref($reservable_future_order) eq 'ARRAY') && (ref($reservable_future) eq 'HASH')) { + if (@{$reservable_future_order} > 0) { + if ((!$checkedin) || (ref($consumed_uniq) ne 'ARRAY')) { + $slotstatus = 'RESERVABLE_LATER'; + $datemsg = $reservable_future->{$reservable_future_order->[0]}{'startreserve'}; + } else { + my ($uniqstart,$uniqend,$useslot); + if (ref($consumed_uniq) eq 'ARRAY') { + ($uniqstart,$uniqend)=@{$consumed_uniq}; + } + foreach my $slot (@{$reservable_future_order}) { + if ($reservable_future->{$slot}{'uniqueperiod'} =~ /^(\d+),(\d+)$/) { + my ($new_uniq_start,$new_uniq_end) = ($1,$2); + next if (! + ($uniqstart < $new_uniq_start && $uniqend < $new_uniq_start) || + ($uniqstart > $new_uniq_end && $uniqend > $new_uniq_end )); + } + $useslot = $slot; + last; + } + if ($useslot) { + $slotstatus = 'RESERVABLE_LATER'; + $datemsg = $reservable_future->{$useslot}{'startreserve'}; + } + } + } + } + } + } + } + return ($slotstatus,$datemsg); } # JB, 9/24/2002: Any changes in this function may require a change # in lonnavmaps::resource::getDateStatus. sub check_access { - my ($id) = @_; + my ($id,$symb) = @_; my $date =''; my $status; my $datemsg = ''; @@ -394,11 +571,13 @@ sub check_access { &Apache::lonxml::debug("checking for part :$id:"); &Apache::lonxml::debug("time:".time); - my ($symb)=&Apache::lonnet::whichuser(); + unless ($symb) { + ($symb)=&Apache::lonnet::whichuser(); + } &Apache::lonxml::debug("symb:".$symb); #if ($env{'request.state'} ne "construct" && $symb ne '') { if ($env{'request.state'} ne "construct") { - my $idacc = &Apache::lonnet::EXT("resource.$id.acc"); + my $idacc = &Apache::lonnet::EXT("resource.$id.acc",$symb); my $allowed=&Apache::loncommon::check_ip_acc($idacc); if (!$allowed && ($Apache::lonhomework::browse ne 'F')) { $status='INVALID_ACCESS'; @@ -414,12 +593,12 @@ sub check_access { foreach my $temp ("opendate","duedate","answerdate") { $lastdate = $date; if ($temp eq 'duedate') { - $date = &due_date($id); + $date = &due_date($id,$symb); } else { - $date = &Apache::lonnet::EXT("resource.$id.$temp"); + $date = &Apache::lonnet::EXT("resource.$id.$temp",$symb); } - my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type"); + my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type",$symb); if ($thistype =~ /^(con_lost|no_such_host)/ || $date =~ /^(con_lost|no_such_host)/) { $status='UNAVAILABLE'; @@ -428,10 +607,10 @@ sub check_access { } if ($thistype eq 'date_interval') { if ($temp eq 'opendate') { - $date=&Apache::lonnet::EXT("resource.$id.duedate")-$date; + $date=&Apache::lonnet::EXT("resource.$id.duedate",$symb)-$date; } if ($temp eq 'answerdate') { - $date=&Apache::lonnet::EXT("resource.$id.duedate")+$date; + $date=&Apache::lonnet::EXT("resource.$id.duedate",$symb)+$date; } } &Apache::lonxml::debug("found :$date: for :$temp:"); @@ -465,7 +644,7 @@ sub check_access { (($Apache::lonhomework::browse eq 'F') && ($status eq 'CLOSED'))) { #check #tries, and if correct. my $tries = $Apache::lonhomework::history{"resource.$id.tries"}; - my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries"); + my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries",$symb); if ( $tries eq '' ) { $tries = '0'; } if ( $maxtries eq '' && $env{'request.state'} ne 'construct') { $maxtries = '2'; } @@ -474,7 +653,7 @@ sub check_access { if ( ($Apache::lonhomework::history{"resource.$id.solved"}=~/^correct/) && (&show_problem_status()) ) { if (($Apache::lonhomework::history{"resource.$id.awarded"} >= 1) || - (&Apache::lonnet::EXT("resource.$id.retrypartial") !~/^1|on|yes$/i)) { + (&Apache::lonnet::EXT("resource.$id.retrypartial",$symb) !~/^1|on|yes$/i)) { $status = 'CANNOT_ANSWER'; } } elsif ($Apache::lonhomework::history{"resource.$id.solved"}=~/^excused/) { @@ -486,17 +665,18 @@ sub check_access { } } if ($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER') { - my @interval=&Apache::lonnet::EXT("resource.$id.interval"); + my @interval=&Apache::lonnet::EXT("resource.$id.interval",$symb); &Apache::lonxml::debug("looking for interval @interval"); - if ($interval[0]) { - my $first_access=&Apache::lonnet::get_first_access($interval[1]); + if ($interval[0]=~ /^\d+/) { + my $first_access=&Apache::lonnet::get_first_access($interval[1],$symb); &Apache::lonxml::debug("looking for accesstime $first_access"); if (!$first_access) { $status='NOT_YET_VIEWED'; - my $due_date = &due_date($id); + my $due_date = &due_date($id,$symb); my $seconds_left = $due_date - time; - if ($seconds_left > $interval[0] || $due_date eq '') { - $seconds_left = $interval[0]; + my ($timelimit) = ($interval[0] =~ /^(\d+)/); + if ($seconds_left > $timelimit || $due_date eq '') { + $seconds_left = $timelimit; } $datemsg=&seconds_to_human_length($seconds_left); } @@ -531,7 +711,8 @@ sub due_date { my $first_access=&Apache::lonnet::get_first_access($interval[1],$symb); &Apache::lonxml::debug("looking for first_access $first_access ($interval[1])"); if (defined($first_access)) { - my $interval = $first_access+$interval[0]; + my ($timelimit) = ($interval[0] =~ /^(\d+)/); + my $interval = $first_access+$timelimit; $date = (!$due_date || $interval < $due_date) ? $interval : $due_date; } else { @@ -616,6 +797,9 @@ sub setuppermissions { $env{'request.course.sec'} !~ /^\s*$/) { $viewgrades = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}. '/'.$env{'request.course.sec'}); + if ($viewgrades) { + $Apache::lonhomework::viewgradessec = $env{'request.course.sec'}; + } } $Apache::lonhomework::viewgrades = $viewgrades; @@ -633,6 +817,9 @@ sub setuppermissions { $modifygrades = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}. '/'.$env{'request.course.sec'}); + if ($modifygrades) { + $Apache::lonhomework::modifygradessec = $env{'request.course.sec'}; + } } $Apache::lonhomework::modifygrades = $modifygrades; @@ -651,7 +838,9 @@ sub setuppermissions { sub unset_permissions { undef($Apache::lonhomework::queuegrade); undef($Apache::lonhomework::modifygrades); + undef($Apache::lonhomework::modifygradessec); undef($Apache::lonhomework::viewgrades); + undef($Apache::lonhomework::viewgradessec); undef($Apache::lonhomework::browse); } @@ -1099,7 +1288,7 @@ sub editxmlmode { # Render the page in whatever target desired. # sub renderpage { - my ($request,$file,$targets,$return_string) = @_; + my ($request,$file,$targets,$return_string,$donebuttonmsg,$viewasuser,$symb) = @_; my @targets = @{$targets || [&get_target()]}; &Apache::lonhomework::showhashsubset(\%env,'form.'); @@ -1140,6 +1329,10 @@ sub renderpage { if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); } if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%env,'^form');} + if (($target eq 'web') && ($viewasuser ne '') && ($symb ne '')) { + $env{'request.user_in_effect'} = $viewasuser; + } + &Apache::lonxml::debug("Should be parsing now"); $result .= &Apache::lonxml::xmlparse($request, $target, $problem, &setup_vars($target),%mystyle); @@ -1152,7 +1345,12 @@ sub renderpage { if ($target eq 'analyze') { $result=&Apache::lonnet::hashref2str(\%Apache::lonhomework::analyze); undef(%Apache::lonhomework::analyze); - } + } elsif ($target eq 'web') { + if ($donebuttonmsg) { + $result =~ s{}{}; + $result.= &Apache::loncommon::confirmwrapper(&Apache::lonhtmlcommon::confirm_success($donebuttonmsg,1))."\n"; + } + } #my $td=&tv_interval($t0); #if ( $Apache::lonxml::debug) { #$result =~ s:::; @@ -1160,15 +1358,23 @@ sub renderpage { #} # $request->print($result); $overall_result.=$result; + if (($target eq 'web') && ($viewasuser ne '') && ($symb ne '')) { + my ($vuname,$vudom) = split(/:/,$viewasuser); + $overall_result .= &Apache::grades::view_as_user($symb,$vuname,$vudom). + ''; + } # $request->rflush(); } + if (($target eq 'web') && ($viewasuser ne '') && ($symb ne '')) { + undef($env{'request.user_in_effect'}); + } #$request->print(":Result ends"); #my $td=&tv_interval($t0); } if (!$return_string) { &Apache::lonxml::add_messages(\$overall_result); $request->print($overall_result); - $request->rflush(); + $request->rflush(); } else { return $overall_result; } @@ -1268,18 +1474,39 @@ sub get_template_html { sub newproblem { my ($request) = @_; - if ($env{'form.mode'} eq 'blank'){ + if ($env{'form.mode'} eq 'blank'){ my $dest = &Apache::lonnet::filelocation("",$request->uri); - &File::Copy::copy('/home/httpd/html/res/adm/includes/templates/blank.problem',$dest); + my $templatefilename = + $request->dir_config('lonIncludes').'/templates/blank.problem'; + &File::Copy::copy($templatefilename,$dest); &renderpage($request,$dest); return; } + my $errormsg; if ($env{'form.template'}) { - my $file = $env{'form.template'}; - my $dest = &Apache::lonnet::filelocation("",$request->uri); - &File::Copy::copy($file,$dest); - &renderpage($request,$dest); - return; + my $file; + my ($extension) = ($env{'form.template'} =~ /\.(\w+)$/); + if ($extension) { + my @files = &get_template_list($extension); + foreach my $poss (@files) { + if (ref($poss) eq 'ARRAY') { + if ($env{'form.template'} eq $poss->[0]) { + $file = $env{'form.template'}; + last; + } + } + } + if ($file) { + my $dest = &Apache::lonnet::filelocation("",$request->uri); + &File::Copy::copy($file,$dest); + &renderpage($request,$dest); + return; + } else { + $errormsg = '

'.&mt('Invalid template file.').'

'; + } + } else { + $errormsg = '

'.&mt('Invalid template file; template needs to be a .problem, .library, or .task file.').'

'; + } } my ($extension) = ($request->uri =~ m/\.(\w+)$/); @@ -1296,7 +1523,6 @@ sub newproblem { } else { my $url=&HTML::Entities::encode($request->uri,'<>&"'); my $dest = &Apache::lonnet::filelocation("",$request->uri); - my $errormsg; my $instructions; my $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri), 'text' => 'Authoring Space'}, @@ -1346,10 +1572,75 @@ sub update_construct_style { } } +# +# Sets interval for current user so time left will be zero, either for the entire folder +# containing the current resource, or just the resource, depending on value of first item +# in interval array retrieved from EXT("resource.0.interval"); +# +sub zero_timer { + my ($symb) = @_; + my ($hastimeleft,$first_access,$now); + my @interval=&Apache::lonnet::EXT("resource.0.interval",$symb); + if (@interval > 1) { + if ($interval[1] eq 'course') { + return ('fail',&mt('Ending of timed events not supported for intervals set course-wide')); + } else { + my $now = time; + my $first_access=&Apache::lonnet::get_first_access($interval[1],$symb); + if ($first_access > 0) { + my ($timelimit,$donesuffix) = split(/_/,$interval[0],2); + if ($donesuffix =~ /^done(?:|\:[^\:]+\:)(.*)$/) { + my ($dummy,$proctor,$secret) = split(/_/,$1); + if (($proctor) && ($secret ne '')) { + my $key = $env{'form.LC_interval_done_proctorpass'}; + $key =~ s/^\s+//; + $key =~ s/\s+$//; + if ($env{'form.LC_interval_done_proctorpass'} ne $secret) { + return ('fail', + &mt('Incorrect key entered by proctor')); + } + } + if ($first_access+$timelimit > $now) { + my $done_time = $now - $first_access; + my $snum = 1; + if ($interval[1] eq 'map') { + $snum = 2; + } + my $result = + &Apache::lonparmset::storeparm_by_symb_inner($symb,'0_interval', + $snum,$done_time, + 'date_interval', + $env{'user.name'}, + $env{'user.domain'}); + if ($result eq '') { + # Record action in "User Notes" + &Apache::lonmsg::store_instructor_comment( + 'Pressed Done button for symb:
'.$symb, + $env{'user.name'}, $env{'user.domain'}); + return ('ok'); + } else { + return ('fail',&mt('Error ending timed event: [_1]',$result)); + } + } else { + return ('fail',&mt('Timed event already ended')); + } + } else { + return ('fail',&mt('Timed event can not be ended before the time limit')); + } + } else { + return ('fail',&mt('Timer not yet started for this timed event')); + } + } + } else { + return ('fail',&mt('No timer in use')); + } + return(); +} sub handler { #my $t0 = [&gettimeofday()]; my $request=$_[0]; + $Apache::lonxml::request=$request; $Apache::lonxml::debug=$env{'user.debug'}; $env{'request.uri'}=$request->uri; @@ -1372,6 +1663,7 @@ sub handler { &unset_permissions(); return OK; } + &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:$Apache::lonhomework::modifygrades:$Apache::lonhomework::queuegrade"); &Apache::lonxml::debug("Problem Mode ".$env{'form.problemmode'}); my ($symb) = &Apache::lonnet::whichuser(); @@ -1402,9 +1694,49 @@ sub handler { &newproblem($request); } } else { + # Set the event timer to zero if the "done button" was clicked. The button is + # part of the doneButton form created in lonmenu.pm + my ($donebuttonresult,$donemsg,$viewasuser); + if ($symb && $env{'form.LC_interval_done'} eq 'true') { + ($donebuttonresult,$donemsg) = &zero_timer($symb); + undef($env{'form.LC_interval_done'}); + undef($env{'form.LC_interval_done_proctorpass'}); + } + if (($env{'form.LC_viewas'} ne '') && $symb && $env{'request.course.id'} && + ($Apache::lonhomework::viewgrades || $Apache::lonhomework::modifygrades)) { + if ($env{'form.LC_viewas'} =~ /^($match_username):($match_domain)$/) { + my ($possuname,$possudom) = ($1,$2); + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my ($canview,$posssec); + if ($env{'request.course.sec'} ne '') { + if ($Apache::lonhomework::modifygradessec eq $env{'request.course.sec'}) { + $canview = 'section'; + $posssec = $env{'request.course.sec'}; + } elsif ($Apache::lonhomework::viewgradessec eq $env{'request.course.sec'}) { + $canview = 'section'; + $posssec = $env{'request.course.sec'}; + } + } + my $crstype = &Apache::loncommon::course_type(); + if (&Apache::loncourseuser::is_course_user($possudom,$possuname,$cdom,$cnum, + $canview,$crstype,$posssec)) { + $viewasuser = $possuname.':'.$possudom; + } + } + undef($env{'form.LC_viewas'}); + } # just render the page normally outside of construction space &Apache::lonxml::debug("not construct"); - &renderpage($request,$file); + undef(@Apache::lonhomework::ltipassback); + &renderpage($request,$file,undef,undef,$donemsg,$viewasuser,$symb); + if (@Apache::lonhomework::ltipassback) { + unless ($registered_cleanup) { + my $handlers = $request->get_handlers('PerlCleanupHandler'); + $request->set_handlers('PerlCleanupHandler' => + [\&do_ltipassback,@{$handlers}]); + } + } } #my $td=&tv_interval($t0); #&Apache::lonxml::debug("Spent $td seconds processing"); @@ -1550,16 +1882,15 @@ sub default_xml_tag { sub helpmenu_datastructure { - my $width = 500; - my $height = 600; - + # filename, title, width, height my $helpers = [ - ['Problem_LON-CAPA_Functions', &mt('Script Functions')], - ['Greek_Symbols', &mt('Greek Symbols')], - ['Other_Symbols', &mt('Other Symbols')], - ['Authoring_Output_Tags', &mt('Output Tags')], - ['Authoring_Multilingual_Problems', - &mt('How to create problems in different languages')] + ['Problem_LON-CAPA_Functions.hlp', &mt('Script Functions'), 800, 600], + ['Greek_Symbols.hlp', &mt('Greek Symbols'), 500, 600], + ['Other_Symbols.hlp', &mt('Other Symbols'), 500, 600], + ['Authoring_Output_Tags.hlp', &mt('Output Tags'), 800, 600], + ['Authoring_Multilingual_Problems.hlp', + &mt('How to create problems in different languages'), 800, 600], + ['loncapa.html', &mt('Language reference'), 800, 600], ]; my $help_structure = []; @@ -1567,7 +1898,15 @@ sub helpmenu_datastructure { foreach my $count (0..(scalar(@{$helpers})-1)) { my $filename = $helpers->[$count]->[0]; my $title = $helpers->[$count]->[1]; - my $href = &HTML::Entities::encode("javascript:openMyModal('/adm/help/$filename.hlp',$width,$height,'yes');"); + my $width = $helpers->[$count]->[2]; + my $height = $helpers->[$count]->[3]; + if ($width eq '') { + $width = 500; + } + if ($height eq '') { + $height = 600; + } + my $href = &HTML::Entities::encode("javascript:openMyModal('/adm/help/$filename',$width,$height,'yes');"); push @{$help_structure}, [$href, $title, undef]; } @@ -1585,5 +1924,84 @@ sub convert_for_js { return $return; } +sub do_ltipassback { + if (@Apache::lonhomework::ltipassback) { + foreach my $item (@Apache::lonhomework::ltipassback) { + if (ref($item) eq 'HASH') { + if ((ref($item->{'lti'}) eq 'HASH') && ($item->{'cid'} =~ /^($match_domain)_($match_courseid)$/)) { + my ($cdom,$cnum) = ($1,$2); + my $ckey = $item->{'lti'}->{'key'}; + my $secret = $item->{'lti'}->{'secret'}; + my $msgformat = $item->{'lti'}->{'passbackformat'}; + my $sigmethod = 'HMAC-SHA1'; + my $id = $item->{'pbid'}; + my $url = $item->{'pburl'}; + my $scope = $item->{'scope'}; + my $map = $item->{'ltimap'}; + my $symb = $item->{'ltisymb'}; + my $uname = $item->{'uname'}; + my $udom = $item->{'udom'}; + my $scoretype = $item->{'format'}; + my ($total,$possible); + if ($scope eq 'resource') { + $total = $item->{'total'}; + $possible = $item->{'possible'}; + } elsif ($scope eq 'map') { + ($total,$possible) = &get_lti_score($uname,$udom,$map); + } elsif ($scope eq 'course') { + ($total,$possible) = &get_lti_score($uname,$udom); + } + if (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '') && ($possible)) { + &LONCAPA::ltiutils::send_grade($id,$url,$ckey,$secret,$scoretype,$sigmethod, + $msgformat,$total,$possible); + } + } + } + } + undef(@Apache::lonhomework::ltipassback); + } +} + +sub get_lti_score { + my ($uname,$udom,$mapurl) = @_; + my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom); + if (ref($navmap)) { + my $iterator; + if ($mapurl ne '') { + my $map = $navmap->getResourceByUrl($mapurl); + my $firstres = $map->map_start(); + my $finishres = $map->map_finish(); + $iterator = $navmap->getIterator($firstres,$finishres,undef,1); + } else { + $iterator = $navmap->getIterator(undef,undef,undef,1); + } + if (ref($iterator)) { + my $depth = 1; + my $total = 0; + my $possible = 0; + $iterator->next(); # ignore first BEGIN_MAP + my $curRes = $iterator->next(); + while ( $depth > 0 ) { + if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} + if ($curRes == $iterator->END_MAP()) { $depth--; } + if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout) { + my $parts = $curRes->parts(); + foreach my $part (@{$parts}) { + next if ($curRes->solved($part) eq 'excused'); + $total += $curRes->weight($part) * $curRes->awarded($part); + $possible += $curRes->weight($part); + } + } + $curRes = $iterator->next(); + } + if ($total > $possible) { + $total = $possible; + } + return ($total,$possible); + } + } + return; +} + 1; __END__ 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.