--- loncom/homework/lonhomework.pm 2019/02/19 15:38:36 1.344.2.8.4.3 +++ loncom/homework/lonhomework.pm 2015/04/15 04:11:20 1.350 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Homework handler # -# $Id: lonhomework.pm,v 1.344.2.8.4.3 2019/02/19 15:38:36 raeburn Exp $ +# $Id: lonhomework.pm,v 1.350 2015/04/15 04:11:20 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -208,12 +208,12 @@ sub proctor_checked_in { } sub check_slot_access { - my ($id,$type,$symb,$partlist)=@_; + my ($id,$type)=@_; # does it pass normal muster - my ($status,$datemsg)=&check_access($id,$symb); + my ($status,$datemsg)=&check_access($id); - my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb); + my $useslots = &Apache::lonnet::EXT("resource.0.useslots"); if ($useslots ne 'resource' && $useslots ne 'map' && $useslots ne 'map_map') { return ($status,$datemsg); @@ -237,8 +237,8 @@ sub check_slot_access { } } - my $availablestudent = &Apache::lonnet::EXT("resource.0.availablestudent",$symb); - my $available = &Apache::lonnet::EXT("resource.0.available",$symb); + my $availablestudent = &Apache::lonnet::EXT("resource.0.availablestudent"); + my $available = &Apache::lonnet::EXT("resource.0.available"); my @slots= (split(':',$availablestudent),split(':',$available)); # if (!@slots) { @@ -248,9 +248,6 @@ sub check_slot_access { my ($returned_slot,$slot_name); my $now = time; my $num_usable_slots = 0; - unless ($symb) { - ($symb) = &Apache::lonnet::whichuser(); - } foreach my $slot (@slots) { $slot =~ s/(^\s*|\s*$)//g; &Apache::lonxml::debug("getting $slot"); @@ -260,7 +257,7 @@ sub check_slot_access { $num_usable_slots ++; if ($slot{'starttime'} < $now && $slot{'endtime'} > $now && - &Apache::loncommon::check_slotip_acc($slot{'ip'})) { + &Apache::loncommon::check_ip_acc($slot{'ip'})) { &Apache::lonxml::debug("$slot is good"); $slotstatus='NEEDS_CHECKIN'; $returned_slot=\%slot; @@ -274,10 +271,9 @@ sub check_slot_access { $slotstatus=$status; } - my ($is_correct,$got_grade,$checkin,$checkinslot,$checkedin,$consumed_uniq); + my ($is_correct,$got_grade,$checkedin); if ($type eq 'Task') { my $version=$Apache::lonhomework::history{'resource.0.version'}; - $checkin = "resource.$version.0.checkedin"; $got_grade = ($Apache::lonhomework::history{"resource.$version.0.status"} =~ /^(?:pass|fail)$/); @@ -287,57 +283,10 @@ sub check_slot_access { $checkedin = $Apache::lonhomework::history{"resource.$version.0.checkedin"}; } elsif ($type eq 'problem') { - $checkin = 'resource.0.checkedin'; - $checkedin = $Apache::lonhomework::history{$checkin}; - } - if ($checkedin) { - $checkinslot = $Apache::lonhomework::history{"$checkin.slot"}; - my %slot=&Apache::lonnet::get_slot($checkinslot); - $consumed_uniq = $slot{'uniqueperiod'}; - } - if ($type eq 'problem') { - 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) || ($is_correct)) { - $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; - } - } + $got_grade = 1; + $checkedin = $Apache::lonhomework::history{"resource.0.checkedin"}; + $is_correct = + ($Apache::lonhomework::history{"resource.0.solved"} =~/^correct_/); } &Apache::lonxml::debug(" slot is $slotstatus checkedin ($checkedin) got_grade ($got_grade) is_correct ($is_correct)"); @@ -361,63 +310,22 @@ sub check_slot_access { 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) { - 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'}; - } - } + $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) { - 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'}; - } - } + $slotstatus = 'RESERVABLE_LATER'; + $datemsg = $reservable_future->{$reservable_future_order->[0]}{'startreserve'}; } } } @@ -456,7 +364,7 @@ sub check_slot_access { # JB, 9/24/2002: Any changes in this function may require a change # in lonnavmaps::resource::getDateStatus. sub check_access { - my ($id,$symb) = @_; + my ($id) = @_; my $date =''; my $status; my $datemsg = ''; @@ -486,13 +394,11 @@ sub check_access { &Apache::lonxml::debug("checking for part :$id:"); &Apache::lonxml::debug("time:".time); - unless ($symb) { - ($symb)=&Apache::lonnet::whichuser(); - } + my ($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",$symb); + my $idacc = &Apache::lonnet::EXT("resource.$id.acc"); my $allowed=&Apache::loncommon::check_ip_acc($idacc); if (!$allowed && ($Apache::lonhomework::browse ne 'F')) { $status='INVALID_ACCESS'; @@ -508,12 +414,12 @@ sub check_access { foreach my $temp ("opendate","duedate","answerdate") { $lastdate = $date; if ($temp eq 'duedate') { - $date = &due_date($id,$symb); + $date = &due_date($id); } else { - $date = &Apache::lonnet::EXT("resource.$id.$temp",$symb); + $date = &Apache::lonnet::EXT("resource.$id.$temp"); } - my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type",$symb); + my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type"); if ($thistype =~ /^(con_lost|no_such_host)/ || $date =~ /^(con_lost|no_such_host)/) { $status='UNAVAILABLE'; @@ -522,10 +428,10 @@ sub check_access { } if ($thistype eq 'date_interval') { if ($temp eq 'opendate') { - $date=&Apache::lonnet::EXT("resource.$id.duedate",$symb)-$date; + $date=&Apache::lonnet::EXT("resource.$id.duedate")-$date; } if ($temp eq 'answerdate') { - $date=&Apache::lonnet::EXT("resource.$id.duedate",$symb)+$date; + $date=&Apache::lonnet::EXT("resource.$id.duedate")+$date; } } &Apache::lonxml::debug("found :$date: for :$temp:"); @@ -559,7 +465,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",$symb); + my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries"); if ( $tries eq '' ) { $tries = '0'; } if ( $maxtries eq '' && $env{'request.state'} ne 'construct') { $maxtries = '2'; } @@ -568,7 +474,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",$symb) !~/^1|on|yes$/i)) { + (&Apache::lonnet::EXT("resource.$id.retrypartial") !~/^1|on|yes$/i)) { $status = 'CANNOT_ANSWER'; } } elsif ($Apache::lonhomework::history{"resource.$id.solved"}=~/^excused/) { @@ -580,14 +486,14 @@ sub check_access { } } if ($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER') { - my @interval=&Apache::lonnet::EXT("resource.$id.interval",$symb); + my @interval=&Apache::lonnet::EXT("resource.$id.interval"); &Apache::lonxml::debug("looking for interval @interval"); if ($interval[0]) { - my $first_access=&Apache::lonnet::get_first_access($interval[1],$symb); + my $first_access=&Apache::lonnet::get_first_access($interval[1]); &Apache::lonxml::debug("looking for accesstime $first_access"); if (!$first_access) { $status='NOT_YET_VIEWED'; - my $due_date = &due_date($id,$symb); + my $due_date = &due_date($id); my $seconds_left = $due_date - time; if ($seconds_left > $interval[0] || $due_date eq '') { $seconds_left = $interval[0]; @@ -861,7 +767,7 @@ sub analyze_header { .&Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader()); $result .= - '
'; + .&Apache::lonxml::message_location(). + ''; &Apache::lonxml::add_messages(\$result); $request->print($result); $request->rflush(); @@ -1056,9 +962,8 @@ sub editxmlmode { $problem=''; } - if (($env{'form.problemmode'} eq 'saveeditxml') || - ($env{'form.problemmode'} eq 'saveviewxml') || + ($env{'form.problemmode'} eq 'saveviewxml') || ($env{'form.problemmode'} eq 'undoxml')) { my $error=&handle_save_or_undo($request,\$problem, \$env{'form.editxmltext'}); @@ -1107,85 +1012,70 @@ sub editxmlmode {' + .&mt('Unable to find [_1]', + ''.$filename.'') + ."
"; $result.= &Apache::loncommon::simple_error_page($request,'Not available', $error,{'no_auto_mt_msg' => 1}); @@ -1272,21 +1164,20 @@ sub finished_parsing { undef($Apache::lonhomework::parsing_a_task); } - # function extracted from get_template_html # returns "key" -> list # key: path of template # value 1: title # value 2: category # value 3: name of help topic ??? -sub get_template_list { +sub get_template_list{ my ($extension) = @_; - + my @files = glob($Apache::lonnet::perlvar{'lonIncludes'}. - '/templates/*.'.$extension); + '/templates/*.'.$extension); @files = map {[$_,&mt(&Apache::lonnet::metadata($_, 'title')), (&Apache::lonnet::metadata($_, 'category')?&mt(&Apache::lonnet::metadata($_, 'category')):&mt('Miscellaneous')), - &mt(&Apache::lonnet::metadata($_, 'help'))]} (@files); + &mt(&Apache::lonnet::metadata($_, 'help'))]} (@files); @files = sort {$a->[2].$a->[1] cmp $b->[2].$b->[1]} (@files); return @files; } @@ -1298,7 +1189,7 @@ sub get_template_html { &Apache::lonxml::debug("Looking for :$extension:"); my $glob_extension = $extension; if ($extension eq 'survey' || $extension eq 'exam') { - $glob_extension = 'problem'; + $glob_extension = 'problem'; } my @files = &get_template_list($extension); my ($midpoint,$seconddiv,$numfiles); @@ -1362,39 +1253,18 @@ 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); - my $templatefilename = - $request->dir_config('lonIncludes').'/templates/blank.problem'; - &File::Copy::copy($templatefilename,$dest); + &File::Copy::copy('/home/httpd/html/res/adm/includes/templates/blank.problem',$dest); &renderpage($request,$dest); return; } - my $errormsg; if ($env{'form.template'}) { - 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 $file = $env{'form.template'}; + my $dest = &Apache::lonnet::filelocation("",$request->uri); + &File::Copy::copy($file,$dest); + &renderpage($request,$dest); + return; } my ($extension) = ($request->uri =~ m/\.(\w+)$/); @@ -1411,6 +1281,7 @@ 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'}, @@ -1460,41 +1331,6 @@ 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"); - if (@interval > 1) { - if ($interval[1] eq 'course') { - return; - } else { - my $now = time; - my $first_access=&Apache::lonnet::get_first_access($interval[1],$symb); - if ($first_access > 0) { - if ($first_access+$interval[0] > $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'}); - return $result; - } - } - } - } - return; -} sub handler { #my $t0 = [&gettimeofday()]; @@ -1507,7 +1343,7 @@ sub handler { my $file=&Apache::lonnet::filelocation("",$request->uri); #check if we know where we are - if ($env{'request.course.fn'} && !&Apache::lonnet::symbread('','',1,1)) { + if ($env{'request.course.fn'} && !&Apache::lonnet::symbread('','',1,1)) { # if we are browsing we might not be able to know where we are if ($Apache::lonhomework::browse ne 'F' && $env{'request.state'} ne "construct") { @@ -1545,18 +1381,12 @@ sub handler { &renderpage($request,$file); } } else { - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['mode']); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['mode']); # requested file doesn't exist in contruction space &newproblem($request); } } else { - # Set the event timer to zero if the "done button" was clicked. The button is - # part of the LCdoneButton form created in lonmenu.pm - if ($symb && $env{'form.LC_interval_done'} eq 'true') { - &zero_timer($symb); - undef($env{'form.LC_interval_done'}); - } # just render the page normally outside of construction space &Apache::lonxml::debug("not construct"); &renderpage($request,$file); @@ -1570,179 +1400,5 @@ sub handler { } -sub template_dropdown_datastructure { - # gathering the all templates and their path, title, category and help topic - my @templates = get_template_list('problem'); - # template category => title - my %tmplthash = (); - # template title => path - my %tmpltcontent = (); - - foreach my $template (@templates){ - # put in hash if the template is not empty - unless ($template->[1] eq ''){ - push(@{$tmplthash{$template->[2]}}, $template->[1]); - push(@{$tmpltcontent{$template->[1]}},$template->[0]); - } - } - - my $catList = []; - foreach my $cat (sort keys %tmplthash) { - my $catItems = []; - foreach my $title (sort @{$tmplthash{$cat}}) { - my $path = $tmpltcontent{$title}->[0]; - my $code; - open(FH, "<$path"); - while(