--- loncom/homework/lonhomework.pm 2024/02/27 17:10:23 1.344.2.10.4.7 +++ loncom/homework/lonhomework.pm 2015/02/21 21:53:34 1.349 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Homework handler # -# $Id: lonhomework.pm,v 1.344.2.10.4.7 2024/02/27 17:10:23 raeburn Exp $ +# $Id: lonhomework.pm,v 1.349 2015/02/21 21:53:34 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -49,22 +49,15 @@ use Apache::matchresponse(); use Apache::chemresponse(); use Apache::functionplotresponse(); use Apache::drawimage(); -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(); @@ -162,19 +155,9 @@ sub get_target { return ('web','answer'); } elsif (($env{'form.problemmode'} eq 'saveedit') || ($env{'form.problemmode'} eq 'undo')) { - my %editors = &Apache::loncommon::permitted_editors(); - if ($editors{'edit'}) { - return ('modified','no_output_web','edit'); - } else { - return ('web'); - } + return ('modified','no_output_web','edit'); } elsif ($env{'form.problemmode'} eq 'edit') { - my %editors = &Apache::loncommon::permitted_editors(); - if ($editors{'edit'}) { - return ('no_output_web','edit'); - } else { - return ('web'); - } + return ('no_output_web','edit'); } else { return ('web'); } @@ -205,7 +188,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') || ($type eq 'tool')) { + } elsif ($type eq 'problem') { $key ='resource.0.checkedin'; } # backward compatability, used to be username@domain, @@ -220,16 +203,17 @@ sub proctor_checked_in { return 1; } } + return 0; } 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 $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb); + my ($status,$datemsg)=&check_access($id); + + my $useslots = &Apache::lonnet::EXT("resource.0.useslots"); if ($useslots ne 'resource' && $useslots ne 'map' && $useslots ne 'map_map') { return ($status,$datemsg); @@ -251,16 +235,10 @@ sub check_slot_access { $Apache::lonhomework::history{"resource.$version.0.status"} eq 'pass') { 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",$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) { @@ -270,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"); @@ -296,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)$/); @@ -308,58 +282,11 @@ sub check_slot_access { || $Apache::lonhomework::history{"resource.0.solved"} =~ /^correct_/ ); $checkedin = $Apache::lonhomework::history{"resource.$version.0.checkedin"}; - } elsif (($type eq 'problem') || ($type eq 'tool')) { - $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') || ($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; - } - } + } elsif ($type eq 'problem') { + $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)"); @@ -376,71 +303,29 @@ 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') || ($type eq 'tool'))) { + # (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'}; + 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'}; } } } @@ -462,7 +347,7 @@ sub check_slot_access { } if ( $is_correct) { - if (($type eq 'problem') || ($type eq 'tool')) { + if ($type eq 'problem') { return ($status); } return ('SHOW_ANSWER'); @@ -479,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 = ''; @@ -509,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'; @@ -531,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'; @@ -545,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:"); @@ -582,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'; } @@ -591,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/) { @@ -603,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]; @@ -733,9 +616,6 @@ 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; @@ -753,9 +633,6 @@ 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; @@ -774,9 +651,7 @@ 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); } @@ -875,7 +750,7 @@ STATE sub analyze_header { my ($request) = @_; - my $js = &Apache::lonxml::setmode_javascript(); + my $js = &Apache::structuretags::setmode_javascript(); # Breadcrumbs my $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri), @@ -891,32 +766,24 @@ sub analyze_header { {'bread_crumbs' => $brcrum,}) .&Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader()); - my %lt = &Apache::lonlocal::texthash( - edit => 'Edit', - editxml => 'EditXML', - ); $result .= - '
'. ''. &Apache::structuretags::remember_problem_state().' -
'; - my %editors = &Apache::loncommon::permitted_editors(); - foreach my $item ('editxml','edit') { - next unless ($editors{$item}); - $result .= ''. - "\n"; - } - $result .= - '
+
+ + +
' - .&Apache::lonxml::message_location().' - '; + .&Apache::lonxml::message_location(). + ''; &Apache::lonxml::add_messages(\$result); $request->print($result); $request->rflush(); @@ -1115,7 +982,7 @@ sub editxmlmode { my $js = &Apache::edit::js_change_detection(). &Apache::loncommon::resize_textarea_js(). - &Apache::lonxml::setmode_javascript(). + &Apache::structuretags::setmode_javascript(). &Apache::lonhtmlcommon::dragmath_js("EditMathPopup"); # Breadcrumbs @@ -1145,86 +1012,70 @@ sub editxmlmode {
'. &mt('Problem Editing').' '.&Apache::loncommon::help_open_topic('Problem_Editor_XML_Index'). - '
'; + '
'; - $result.=''. + $result.=''. &Apache::structuretags::problem_edit_buttons('editxml'); - $result.='
'; + $result.='
'; - $result .= '
    '; - - my $nocodemirror = &Apache::loncommon::nocodemirror(); - unless ($nocodemirror) { - # dropdown menus - $result .= Apache::lonmenu::create_submenu("#", "", - &mt("Problem Templates"), template_dropdown_datastructure()); - - $result .= Apache::lonmenu::create_submenu("#", "", - &mt("Response Types"), responseblock_dropdown_datastructure()); - - $result .= Apache::lonmenu::create_submenu("#", "", - &mt("Conditional Blocks"), conditional_scripting_datastructure()); - - $result .= Apache::lonmenu::create_submenu("#", "", - &mt("Miscellaneous"), misc_datastructure()); - } - - $result .= Apache::lonmenu::create_submenu("#", "", - &mt("Help") . ' ' . &mt(', - helpmenu_datastructure(),""); - - $result.="
"; - - $result .= '
' . - &Apache::lonxml::message_location() . - &Apache::loncommon::xmleditor_js() . - '
'; - - my $resource = $env{'request.ambiguous'}; - unless ($nocodemirror) { - $result .= ' - - '; - } - - $result .= &Apache::loncommon::end_page(); - &Apache::lonxml::add_messages(\$result); - $request->print($result); + unless ($env{'environment.nocodemirror'}) { + # dropdown menues + $result .= '
    '. + &Apache::lonmenu::create_submenu("#", "", &mt("Insert Menu"), &Apache::structuretags::insert_menu_datastructure(),"").'
'; + } + $result .= '
    '. + Apache::lonmenu::create_submenu("#", "", &mt("Help"), &Apache::structuretags::helpmenu_datastructure(),"").'
'; + $result.="
"; + + $result.='
'.&Apache::lonxml::message_location(). + &Apache::loncommon::xmleditor_js(). + ' +
+
+ '; + my $resource = $env{'request.ambiguous'}; + unless($env{'environment.nocodemirror'}){ + + $result .= ' + + '; + } + $result .= &Apache::loncommon::end_page(); + &Apache::lonxml::add_messages(\$result); + $request->print($result); } return ''; } @@ -1233,7 +1084,7 @@ sub editxmlmode { # Render the page in whatever target desired. # sub renderpage { - my ($request,$file,$targets,$return_string,$donebuttonmsg,$viewasuser,$symb) = @_; + my ($request,$file,$targets,$return_string) = @_; my @targets = @{$targets || [&get_target()]}; &Apache::lonhomework::showhashsubset(\%env,'form.'); @@ -1259,8 +1110,10 @@ sub renderpage { $problem=''; my $filename=(split('/',$file))[-1]; my $error = - &mt('Unable to find [_1]', - ''.$filename.''); + '

' + .&mt('Unable to find [_1]', + ''.$filename.'') + ."

"; $result.= &Apache::loncommon::simple_error_page($request,'Not available', $error,{'no_auto_mt_msg' => 1}); @@ -1272,10 +1125,6 @@ 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); @@ -1288,11 +1137,6 @@ 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) { @@ -1301,23 +1145,15 @@ 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->print($overall_result); + $request->rflush(); } else { return $overall_result; } @@ -1334,14 +1170,14 @@ sub finished_parsing { # 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; } @@ -1353,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); @@ -1417,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+)$/); @@ -1466,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'}, @@ -1515,70 +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",$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()]; @@ -1591,9 +1343,9 @@ 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()) { # if we are browsing we might not be able to know where we are - if ($Apache::lonhomework::browse ne 'F' && + if ($Apache::lonhomework::browse ne 'F' && $env{'request.state'} ne "construct") { #should know where we are, so ask &unset_permissions(); @@ -1605,7 +1357,6 @@ 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(); @@ -1622,13 +1373,7 @@ sub handler { ($env{'form.problemmode'} eq 'saveeditxml') || ($env{'form.problemmode'} eq 'saveviewxml') || ($env{'form.problemmode'} eq 'undoxml')) { - my %editors = &Apache::loncommon::permitted_editors(); - if (($editors{'xml'}) || ($env{'form.problemmode'} eq 'saveviewxml') || ($env{'form.problemmode'} eq 'undoxml')) { - &editxmlmode($request,$file); - } else { - &update_construct_style(); - &renderpage($request,$file); - } + &editxmlmode($request,$file); } elsif ($env{'form.problemmode'} eq 'calcanswers') { &analyze($request,$file); } else { @@ -1636,55 +1381,15 @@ 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 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"); - 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}]); - } - } + &renderpage($request,$file); } #my $td=&tv_interval($t0); #&Apache::lonxml::debug("Spent $td seconds processing"); @@ -1695,263 +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(){ - $code.= $_ unless $_ =~ /()|(<\/problem>)/; - } - close(FH); - - if ($code ne '') { - my $href = 'javascript:insertText(\'' . &convert_for_js(&HTML::Entities::encode($code,'<>&"')) . '\')'; - my $currItem = [$href, $title, undef]; - push @{$catItems}, $currItem; - } - } - push @{$catList}, [$catItems, $cat, undef]; - } - - return $catList; -} - -sub responseblock_dropdown_datastructure { - - my $mathCat = [ - [ - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_formularesponse())) . "\')", &mt("Formula Response"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_functionplotresponse())) . "\')", &mt("Function Plot Response"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_mathresponse())) . "\')", &mt("Math Response"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_numericalresponse())) . "\')", &mt("Numerical Response"), undef] - ], - &mt("Math"), - undef - ]; - - my $miscCat = [ - [ - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_imageresponse())) . "\')", &mt("Click on Image"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_customresponse())) . "\')", &mt("Custom Response"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_externalresponse())) . "\')", &mt("External Response"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_matchresponse())) . "\')", &mt("Match Two Lists"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_radiobuttonresponse())) . "\')", &mt("One out of N statements"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_optionresponse())) . "\')", &mt("Select from Options"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_rankresponse())) . "\')", &mt("Rank Values"), undef] - ], - &mt("Miscellaneous"), - undef - ]; - - my $chemCat = [ - [ - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_reactionresponse())) . "\')", &mt("Chemical Reaction"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_organicresponse())) . "\')", &mt("Organic Chemical Structure"), undef] - ], - &mt("Chemistry"), - undef - ]; - - my $textCat = [ - [ - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_stringresponse())) . "\')", &mt("String Response"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_essayresponse())) . "\')", &mt("Essay"), undef] - ], - &mt("Text"), - undef - ]; - - return [$mathCat, $miscCat, $chemCat, $textCat]; -} - - -sub conditional_scripting_datastructure { -# TODO: corresponding routines should be used for the javascript:insertText parts -# instead of the placeholder routine default_xml_tag with the tags -# e.g. &default_xml_tag("postanswerdate") should be replaced with a routine which -# returns the corresponding content for this case - -#TODO translated is currently temporarily here, another solution should be found where the -# needed string can be retrieved - - my $translatedTag = ' - - - -'; - return [ - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode($translatedTag)) . "\')", &mt("Translated Block"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("block"))) . "\')", &mt("Conditional Block"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("postanswerdate"))) . "\')", &mt("After Answer Date Block"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("preduedate"))) . "\')", &mt("Before Due Date Block"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("solved"))) . "\')", &mt("Block For After Solved"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("notsolved"))) . "\')", &mt("Block For When Not Solved"), undef] - ]; -} - -sub misc_datastructure { - return [ - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_img())) . "\')", &mt("Image"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::lonplot::insert_gnuplot())) . "\')", &mt("GNU Plot"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_organicstructure())) . "\')", &mt("Organic Structure"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::edit::insert_script())) . "\')", &mt("Script Block"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("allow"))) . "\')", &mt("File Dependencies"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("import"))) . "\')", &mt("Import a File"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&Apache::londefdef::insert_meta())) . "\')", &mt("Custom Metadata"), undef], - ["javascript:insertText(\'" . &convert_for_js(&HTML::Entities::encode(&default_xml_tag("part"))) . "\')", &mt("Problem Part"), undef] - ]; -} - -# helper routine for the datastructure building subroutines -sub default_xml_tag { - my ($tag) = @_; - return "\n<$tag>"; -} - -sub helpmenu_datastructure { - - # filename, title, width, height - my $helpers = [ - ['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('Languages'), 800, 600], - ]; - - my $help_structure = []; - - foreach my $count (0..(scalar(@{$helpers})-1)) { - my $filename = $helpers->[$count]->[0]; - my $title = $helpers->[$count]->[1]; - 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]; - } - - return $help_structure; -} - -# we need substitution to not break javascript code -sub convert_for_js { - my $return = shift; - $return =~ s|script|ESCAPEDSCRIPT|g; - $return =~ s|\\|\\\\|g; - $return =~ s|\n|\\r\\n|g; - $return =~ s|'|\\'|g; - $return =~ s|'|\\'|g; - 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 $msgformat = $item->{'lti'}->{'passbackformat'}; - my $sigmethod = 'HMAC-SHA1'; - my $ltinum = $item->{'ltinum'}; - my $id = $item->{'pbid'}; - my $url = $item->{'pburl'}; - my $type = $item->{'pbtype'}; - my $scope = $item->{'scope'}; - my $map = $item->{'pbmap'}; - my $symb = $item->{'pbsymb'}; - my $uname = $item->{'uname'}; - my $udom = $item->{'udom'}; - my $keynum = $item->{'lti'}->{'cipher'}; - my $crsdef = $item->{'crsdef'}; - my $scoretype = $item->{'format'}; - my ($total,$possible); - if ($scope eq 'resource') { - $total = $item->{'total'}; - $possible = $item->{'possible'}; - } elsif (($scope eq 'map') || ($scope eq 'nonrec')) { - ($total,$possible) = &get_lti_score($uname,$udom,$map,$scope); - } elsif ($scope eq 'course') { - ($total,$possible) = &get_lti_score($uname,$udom); - } - if (($id ne '') && ($url ne '') && ($possible)) { - &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible); - } - } - } - } - undef(@Apache::lonhomework::ltipassback); - } -} - -sub get_lti_score { - my ($uname,$udom,$mapurl,$scope) = @_; - 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(); - my $recursive = 1; - if ($scope eq 'nonrec') { - $recursive = 0; - } - $iterator = $navmap->getIterator($firstres,$finishres,undef,$recursive); - } 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__