--- loncom/homework/lonhomework.pm 2011/09/09 16:56:35 1.328
+++ loncom/homework/lonhomework.pm 2015/09/14 13:45:19 1.357
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Homework handler
#
-# $Id: lonhomework.pm,v 1.328 2011/09/09 16:56:35 bisitz Exp $
+# $Id: lonhomework.pm,v 1.357 2015/09/14 13:45:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -49,8 +49,10 @@ use Apache::matchresponse();
use Apache::chemresponse();
use Apache::functionplotresponse();
use Apache::drawimage();
+use Apache::loncapamath();
use Apache::Constants qw(:common);
use Apache::loncommon();
+use Apache::lonparmset();
use Apache::lonlocal;
use Time::HiRes qw( gettimeofday tv_interval );
use HTML::Entities();
@@ -163,7 +165,7 @@ sub get_target {
}
}
#
-# End of Construction Space
+# End of Authoring Space
#
}
#
@@ -208,12 +210,12 @@ sub proctor_checked_in {
}
sub check_slot_access {
- my ($id,$type)=@_;
+ my ($id,$type,$symb)=@_;
# does it pass normal muster
- my ($status,$datemsg)=&check_access($id);
+ my ($status,$datemsg)=&check_access($id,$symb);
- my $useslots = &Apache::lonnet::EXT("resource.0.useslots");
+ my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb);
if ($useslots ne 'resource' && $useslots ne 'map'
&& $useslots ne 'map_map') {
return ($status,$datemsg);
@@ -237,8 +239,8 @@ sub check_slot_access {
}
}
- 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) {
@@ -246,20 +248,24 @@ sub check_slot_access {
# }
my $slotstatus='NOT_IN_A_SLOT';
my ($returned_slot,$slot_name);
+ my $now = time;
+ my $num_usable_slots = 0;
foreach my $slot (@slots) {
$slot =~ s/(^\s*|\s*$)//g;
&Apache::lonxml::debug("getting $slot");
my %slot=&Apache::lonnet::get_slot($slot);
&Apache::lonhomework::showhash(%slot);
- if ($slot{'starttime'} < time &&
- $slot{'endtime'} > time &&
+ next if ($slot{'endtime'} < $now);
+ $num_usable_slots ++;
+ 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 ($slotstatus eq 'NEEDS_CHECKIN' &&
&proctor_checked_in($slot_name,$returned_slot,$type)) {
@@ -299,11 +305,38 @@ 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 NOT_IN_SLOT).
- if (!defined($slot_name)
- && $checkedin
- && $type eq 'problem') {
- return ($slotstatus);
+ # (which will be one of: NOT_IN_A_SLOT, RESERVABLE, RESERVABLE_LATER, or NOTRESERVABLE.
+ if (!defined($slot_name) && $type eq 'problem') {
+ 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'};
+ 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) {
+ $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'};
+ }
+ }
+ }
+ }
+ }
+ }
+ return ($slotstatus,$datemsg);
}
if ($slotstatus eq 'NOT_IN_A_SLOT'
@@ -335,7 +368,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) = @_;
+ my ($id,$symb) = @_;
my $date ='';
my $status;
my $datemsg = '';
@@ -365,11 +398,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';
@@ -385,12 +420,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';
@@ -399,10 +434,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:");
@@ -422,33 +457,33 @@ sub check_access {
$datemsg=$date;
} elsif ($type eq 'opendate') {
$status='CLOSED';
- $datemsg = &mt("will open on")." $date";
+ $datemsg = &mt('will open on [_1]',$date);
} elsif ($type eq 'duedate') {
$status='CAN_ANSWER';
- $datemsg = &mt("is due at")." $date";
+ $datemsg = &mt('is due at [_1]',$date);
} elsif ($type eq 'answerdate') {
$status='CLOSED';
- $datemsg = &mt("was due on")." $lastdate".&mt(", and answers will be available on")." $date";
+ $datemsg = &mt('was due on [_1], and answers will be available on [_2]',
+ $lastdate,$date);
}
}
if ($status eq 'CAN_ANSWER' ||
(($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'; }
- $Apache::lonhomework::results{'resource.'.$id.'.maxtries'}=$maxtries;
if ($maxtries && $tries >= $maxtries) { $status = 'CANNOT_ANSWER'; }
# if (correct and show prob status) or excused then CANNOT_ANSWER
- if(($Apache::lonhomework::history{"resource.$id.solved"}=~/^correct/
- &&
- &show_problem_status()
- &&
- $Apache::lonhomework::history{"resource.$id.awarded"}==1)
- ||
- $Apache::lonhomework::history{"resource.$id.solved"}=~/^excused/) {
+ 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)) {
+ $status = 'CANNOT_ANSWER';
+ }
+ } elsif ($Apache::lonhomework::history{"resource.$id.solved"}=~/^excused/) {
$status = 'CANNOT_ANSWER';
}
if ($status eq 'CANNOT_ANSWER'
@@ -457,14 +492,14 @@ 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]);
+ 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];
@@ -479,7 +514,6 @@ sub check_access {
# return ('UNCHECKEDOUT','needs to be checked out');
#}
-
&Apache::lonxml::debug("sending back :$status:$datemsg:");
if (($Apache::lonhomework::browse eq 'F') && ($status eq 'CLOSED')) {
&Apache::lonxml::debug("should be allowed to browse a resource when closed");
@@ -512,7 +546,7 @@ sub due_date {
} else {
$date = $due_date;
}
- return $date
+ return $date;
}
sub seconds_to_human_length {
@@ -561,7 +595,7 @@ sub showarray {
sub showhashsubset {
my ($hash,$keyre) = @_;
my $resultkey;
- foreach $resultkey (sort keys %$hash) {
+ foreach $resultkey (sort(keys(%$hash))) {
if ($resultkey !~ /$keyre/) { next; }
if (ref($$hash{$resultkey}) eq 'ARRAY' ) {
&Apache::lonxml::debug("$resultkey ---- ".
@@ -579,6 +613,9 @@ sub showhashsubset {
sub setuppermissions {
$Apache::lonhomework::browse= &Apache::lonnet::allowed('bre',$env{'request.filename'});
+ unless ($Apache::lonhomework::browse eq 'F') {
+ $Apache::lonhomework::browse=&Apache::lonnet::allowed('bro',$env{'request.filename'});
+ }
my $viewgrades = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
if (! $viewgrades &&
exists($env{'request.course.sec'}) &&
@@ -638,7 +675,7 @@ sub setupheader {
}
sub handle_save_or_undo {
- my ($request,$problem,$result) = @_;
+ my ($request,$problem,$result,$getobjref) = @_;
my $file = &Apache::lonnet::filelocation("",$request->uri);
my $filebak =$file.".bak";
@@ -681,6 +718,30 @@ sub handle_save_or_undo {
my $fh=Apache::File->new(">$file");
if (defined($fh)) {
print $fh $$result;
+ if (ref($getobjref) eq 'SCALAR') {
+ if ($file =~ m{([^/]+)\.(html?)$}) {
+ my $fname = $1;
+ my $ext = $2;
+ my $path = $file;
+ $path =~ s/\Q$fname\E\.\Q$ext\E$//;
+ my (%allfiles,%codebase);
+ &Apache::lonnet::extract_embedded_items($file,\%allfiles,
+ \%codebase,$result);
+ if (keys(%allfiles) > 0) {
+ my $url = $request->uri;
+ my $state = <
".&mt("Completed upload of the file. This file contained references to other files.")."
". + "".&mt("Please select the locations from which the referenced files are to be uploaded.")."
". + &Apache::loncommon::ask_for_embedded_content($url,$state,\%allfiles,\%codebase, + {'error_on_invalid_names' => 1, + 'ignore_remote_references' => 1,}); + } + } + } } else { &Apache::lonxml::info(''. &mt("Unable to write to [_1]", @@ -698,8 +759,8 @@ sub analyze_header { my $js = &Apache::structuretags::setmode_javascript(); # Breadcrumbs - my $brcrum = [{'href' => &Apache::loncommon::authorspace(), - 'text' => 'Construction Space'}, + my $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri), + 'text' => 'Authoring Space'}, {'href' => '', 'text' => 'Problem Testing'}, {'href' => '', @@ -712,8 +773,7 @@ sub analyze_header { .&Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader()); $result .= - &Apache::lonxml::message_location().' - '; + ' + .&Apache::lonxml::message_location(). + ''; &Apache::lonxml::add_messages(\$result); $request->print($result); $request->rflush(); @@ -750,13 +811,9 @@ sub analyze { my $rndseed=$env{'form.rndseed'}; &analyze_header($request); my %prog_state= - &Apache::lonhtmlcommon::Create_PrgWin($request,&mt('Analyze Progress'), - &mt('Getting Problem Variants'), - $env{'form.numtoanalyze'}, - 'inline',undef); + &Apache::lonhtmlcommon::Create_PrgWin($request,$env{'form.numtoanalyze'}); for(my $i=1;$i<$env{'form.numtoanalyze'}+1;$i++) { - &Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state, - &mt('last problem')); + &Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state,'last problem'); if (&Apache::loncommon::connection_aborted($request)) { return; } my $thisseed=$i+$rndseed; my $subresult=&Apache::lonnet::ssi($request->uri, @@ -765,7 +822,7 @@ sub analyze { (my $garbage,$subresult)=split(/_HASH_REF__/,$subresult,2); my %analyze=&Apache::lonnet::str2hash($subresult); my @parts; - if (defined(@{ $analyze{'parts'} })) { + if (ref($analyze{'parts'}) eq 'ARRAY') { @parts=@{ $analyze{'parts'} }; } foreach my $part (@parts) { @@ -798,15 +855,15 @@ sub analyze { } } } - &Apache::lonhtmlcommon::Update_PrgWin($request,\%prog_state, - &mt('Analyzing Results')); + &Apache::lonhtmlcommon::Update_PrgWin($request,\%prog_state,&mt('Analyzing Results')); $request->print('
'.&mt("To create a new $extension, select a template from the".
" list below. Then click on the \"Create $extension\" button.").'
@@ -1211,10 +1352,47 @@ 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;
+ } else {
+ my $now = time;
+ my $first_access=&Apache::lonnet::get_first_access($interval[1],$symb);
+ if ($first_access > 0) {
+ my ($timelimit) = split(/_/,$interval[0]);
+ 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'});
+ return $result;
+ }
+ }
+ }
+ }
+ return;
+}
sub handler {
#my $t0 = [&gettimeofday()];
my $request=$_[0];
+
$Apache::lonxml::request=$request;
$Apache::lonxml::debug=$env{'user.debug'};
$env{'request.uri'}=$request->uri;
@@ -1223,7 +1401,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()) {
+ 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") {
@@ -1237,6 +1415,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();
@@ -1261,10 +1440,18 @@ sub handler {
&renderpage($request,$file);
}
} else {
+ &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 doneButton 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);
@@ -1278,5 +1465,175 @@ 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(