[BACK]Return to lonhomework.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/lonhomework.pm between versions 1.207 and 1.252

version 1.207, 2005/05/10 20:29:26 version 1.252, 2006/06/20 05:10:00
Line 86  sub get_target { Line 86  sub get_target {
  } elsif ( defined($env{'form.grade_target'}  )    } elsif ( defined($env{'form.grade_target'}  ) 
   && ($Apache::lonhomework::viewgrades eq 'F' )) {    && ($Apache::lonhomework::viewgrades eq 'F' )) {
     return ($env{'form.grade_target'});      return ($env{'form.grade_target'});
    } elsif ( $env{'form.grade_target'} eq 'webgrade'
     && ($Apache::lonhomework::queuegrade eq 'F' )) {
       return ($env{'form.grade_target'});
  }   }
  if ($env{'form.webgrade'} &&   if ($env{'form.webgrade'} &&
     $Apache::lonhomework::modifygrades eq 'F') {      ($Apache::lonhomework::modifygrades eq 'F'
        || $Apache::lonhomework::queuegrade eq 'F' )) {
     return ('grade','webgrade');      return ('grade','webgrade');
  }   }
  if ( defined($env{'form.submitted'}) &&   if ( defined($env{'form.submitted'}) &&
Line 124  sub get_target { Line 128  sub get_target {
     if ( $env{'form.submit'} eq &mt('Submit Changes and View') ) {      if ( $env{'form.submit'} eq &mt('Submit Changes and View') ) {
  return ('modified','web','answer');   return ('modified','web','answer');
     } else {      } else {
  return ('modified','edit');   return ('modified','no_output_web','edit');
     }      }
  } else {   } else {
     return ('edit');      return ('no_output_web','edit');
  }   }
     } else {      } else {
  return ('web');   return ('web');
Line 143  sub setup_vars { Line 147  sub setup_vars {
 #  return ';$external::target='.$target.';';  #  return ';$external::target='.$target.';';
 }  }
   
 sub send_header {  
     my ($request)= @_;  
     $request->print(&Apache::lontexconvert::header());  
 #  $request->print('<form name='.$env{'form.request.prefix'}.'lonhomework method="POST" action="'.$request->uri.'">');  
 }  
   
 sub createmenu {  sub createmenu {
     my ($which,$request)=@_;      my ($which,$request)=@_;
     if ($which eq 'grade') {      if ($which eq 'grade') {
Line 159  sub createmenu { Line 157  sub createmenu {
     }      }
 }  }
   
 sub send_footer {  
     my ($request)= @_;  
 #  $request->print('</form>');  
     $request->print(&Apache::lontexconvert::footer());  
 }  
   
 sub proctor_checked_in {  sub proctor_checked_in {
     my ($slot_name,$slot)=@_;      my ($slot_name,$slot,$type)=@_;
     my @allowed=split(",",$slot->{'proctor'});      my @possible_proctors=split(",",$slot->{'proctor'});
     foreach my $possible (@allowed) {       
  if ($Apache::lonhomework::history{'resource.checkedin'} eq $possible &&      return 1 if (!@possible_proctors);
     $Apache::lonhomework::history{'resource.checkedin.slot'} eq   
         $slot_name ) {      my $key;
       if ($type eq 'Task') {
    my $version=$Apache::lonhomework::history{'resource.0.version'};
    $key ="resource.$version.0.checkedin";
       } elsif ($type eq 'problem') {
    $key ='resource.0.checkedin';
       }
       # backward compatability, used to be username@domain, 
       # now is username:domain
       my $who = $Apache::lonhomework::history{$key};
       if ($who !~ /:/) {
    $who =~ tr/@/:/;
       }     
       foreach my $possible (@possible_proctors) { 
    if ($who eq $possible
       && $Apache::lonhomework::history{$key.'.slot'} eq $slot_name) {
     return 1;      return 1;
  }   }
     }      }
       
     return 0;      return 0;
 }  }
   
 $Apache::lonxml::browse='';  $Apache::lonxml::browse='';
 sub check_ip_acc {  sub check_ip_acc {
     my ($acc)=@_;      my ($acc)=@_;
     if (!defined($acc) || $acc =~ /^\s*$/) { return 1; }      &Apache::lonxml::debug("acc is $acc");
       if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { 
    return 1;
       }
     my $allowed=0;      my $allowed=0;
     my $ip=$ENV{'REMOTE_ADDR'};      my $ip=$ENV{'REMOTE_ADDR'};
     my $name;      my $name;
     foreach my $pattern (split(',',$acc)) {      foreach my $pattern (split(',',$acc)) {
    $pattern =~ s/^\s*//;
    $pattern =~ s/\s*$//;
  if ($pattern =~ /\*$/) {   if ($pattern =~ /\*$/) {
     #35.8.*      #35.8.*
     $pattern=~s/\*//;      $pattern=~s/\*//;
Line 225  sub check_ip_acc { Line 238  sub check_ip_acc {
     return $allowed;      return $allowed;
 }  }
   
 sub check_task_access {  sub check_slot_access {
       my ($id,$type)=@_;
   
     # does it pass normal muster      # does it pass normal muster
     # yes we really do want the default args passing      my ($status,$datemsg)=&check_access($id);
     my ($status,$datemsg)=&check_access;      
       my $useslots = &Apache::lonnet::EXT("resource.0.useslots");
       if ($useslots ne 'resource' && $useslots ne 'map' 
    && $useslots ne 'map_map') {
    return ($status,$datemsg);
       }
   
     if ($status eq 'SHOW_ANSWER' ||      if ($status eq 'SHOW_ANSWER' ||
  $status eq 'CLOSED' ||   $status eq 'CLOSED' ||
  $status eq 'CANNOT_ANSWER' ||  
  $status eq 'INVALID_ACCESS' ||   $status eq 'INVALID_ACCESS' ||
  $status eq 'UNAVAILABLE') {   $status eq 'UNAVAILABLE') {
  return ($status,$datemsg);   return ($status,$datemsg);
Line 240  sub check_task_access { Line 260  sub check_task_access {
  return ($status,$datemsg);   return ($status,$datemsg);
     }      }
           
     if ($Apache::lonhomework::history{'resource.checkedin'}) {      if ($type eq 'Task') {
  if ($Apache::lonhomework::history{'resource.status'} eq 'pass' ||   my $version=$Apache::lonhomework::history{'resource.version'};
     $Apache::lonhomework::history{'resource.status'} eq 'fail') {   if ($Apache::lonhomework::history{"resource.$version.0.checkedin"} &&
       $Apache::lonhomework::history{"resource.$version.0.status"} eq 'pass') {
     return ('SHOW_ANSWER');      return ('SHOW_ANSWER');
  }   }
     }      }
     my ($id)=@_;  
     my @slots=split(':',&Apache::lonnet::EXT("resource.$id.available"));      my @slots=
    (split(':',&Apache::lonnet::EXT("resource.0.availablestudent")),
    split(':',&Apache::lonnet::EXT("resource.0.available")));
   
 #    if (!@slots) {  #    if (!@slots) {
 # return ($status,$datemsg);  # return ($status,$datemsg);
 #    }  #    }
     my $slotstatus='NOT_IN_A_SLOT';      my $slotstatus='NOT_IN_A_SLOT';
     my ($returned_slot,$slot_name);      my ($returned_slot,$slot_name);
     foreach my $slot (sort(@slots)) {      foreach my $slot (@slots) {
    $slot =~ s/(^\s*|\s*$)//g;
  &Apache::lonxml::debug("getting $slot");   &Apache::lonxml::debug("getting $slot");
  my %slot=&Apache::lonnet::get_slot($slot);   my %slot=&Apache::lonnet::get_slot($slot);
  &Apache::lonhomework::showhash(%slot);   &Apache::lonhomework::showhash(%slot);
Line 268  sub check_task_access { Line 293  sub check_task_access {
  }   }
     }      }
     if ($slotstatus eq 'NEEDS_CHECKIN' &&      if ($slotstatus eq 'NEEDS_CHECKIN' &&
  &proctor_checked_in($slot_name,$returned_slot)) {   &proctor_checked_in($slot_name,$returned_slot,$type)) {
  &Apache::lonxml::debug("protoctor checked in");   &Apache::lonxml::debug("protoctor checked in");
  $slotstatus='CAN_ANSWER';   $slotstatus='CAN_ANSWER';
     }      }
     if ( ($slotstatus eq 'NOT_IN_A_SLOT' || $slotstatus eq 'NEEDS_CHECKIN') &&   
  $Apache::lonhomework::history{'resource.checkedin'}) {      my ($is_correct,$got_grade,$checkedin);
       if ($type eq 'Task') {
    my $version=$Apache::lonhomework::history{'resource.0.version'};
    $got_grade = 
       ($Apache::lonhomework::history{"resource.$version.0.status"} 
        =~ /^(?:pass|fail)$/);
    $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_/);
       }
       
       &Apache::lonxml::debug(" slot is $slotstatus checkedin ($checkedin) got_grade ($got_grade) is_correct ($is_correct)");
       
       # no slot is currently open, and has been checked in for this version
       # but hasn't got a grade, therefore must be awaiting a grade
       if (!defined($slot_name)
    && $checkedin 
    && !$got_grade) {
  return ('WAITING_FOR_GRADE');   return ('WAITING_FOR_GRADE');
     }      }
   
       # no slot is currently open, and has been checked in for this version
       # previous slot is therefore CLOSED, so therefore the problem is
       if (!defined($slot_name)
    && $checkedin 
    && $type eq 'problem') {
    return ('CLOSED',$datemsg);
       }
   
       if ($slotstatus eq 'NOT_IN_A_SLOT' 
    && $checkedin ) {
   
    if ($got_grade) {
       return ('SHOW_ANSWER');
    } else {
       return ('WAITING_FOR_GRADE');
    }
   
       }
       if ( $is_correct) {
    return ('SHOW_ANSWER');
       }
       if ( $status eq 'CANNOT_ANSWER' && 
    ($slotstatus ne 'NEEDS_CHECKIN' && $slotstatus ne 'NOT_IN_A_SLOT')) {
    return ($status,$datemsg);
       }
   
     return ($slotstatus,$datemsg,$slot_name,$returned_slot);      return ($slotstatus,$datemsg,$slot_name,$returned_slot);
 }  }
   
Line 287  sub check_access { Line 363  sub check_access {
     my $status;      my $status;
     my $datemsg = '';      my $datemsg = '';
     my $lastdate = '';      my $lastdate = '';
     my $temp;  
     my $type;      my $type;
     my $passed;      my $passed;
   
Line 313  sub check_access { Line 388  sub check_access {
     &Apache::lonxml::debug("checking for part :$id:");      &Apache::lonxml::debug("checking for part :$id:");
     &Apache::lonxml::debug("time:".time);      &Apache::lonxml::debug("time:".time);
   
       my ($symb)=&Apache::lonxml::whichuser();
       &Apache::lonxml::debug("symb:".$symb);
       #if ($env{'request.state'} ne "construct" && $symb ne '') {
     if ($env{'request.state'} ne "construct") {      if ($env{'request.state'} ne "construct") {
  my $allowed=&check_ip_acc(&Apache::lonnet::EXT("resource.$id.acc"));   my $allowed=&check_ip_acc(&Apache::lonnet::EXT("resource.$id.acc"));
  if (!$allowed && ($Apache::lonhomework::browse ne 'F')) {   if (!$allowed && ($Apache::lonhomework::browse ne 'F')) {
Line 321  sub check_access { Line 399  sub check_access {
     return($status,$date);      return($status,$date);
  }   }
   
  foreach $temp ("opendate","duedate","answerdate") {   foreach my $temp ("opendate","duedate","answerdate") {
     $lastdate = $date;      $lastdate = $date;
     $date = &Apache::lonnet::EXT("resource.$id.$temp");      if ($temp eq 'duedate') {
    $date = &due_date($id);
       } else {
    $date = &Apache::lonnet::EXT("resource.$id.$temp");
       }
       
     my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type");      my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type");
     if ($thistype =~ /^(con_lost|no_such_host)/ ||      if ($thistype =~ /^(con_lost|no_such_host)/ ||
  $date     =~ /^(con_lost|no_such_host)/) {   $date     =~ /^(con_lost|no_such_host)/) {
Line 365  sub check_access { Line 448  sub check_access {
     $datemsg = &mt("was due on")." $lastdate".&mt(", and answers will be available on")." $date";      $datemsg = &mt("was due on")." $lastdate".&mt(", and answers will be available on")." $date";
  }   }
     }      }
     if ($status eq 'CAN_ANSWER') {      if ($status eq 'CAN_ANSWER' ||
    (($Apache::lonhomework::browse eq 'F') && ($status eq 'CLOSED'))) {
  #check #tries, and if correct.   #check #tries, and if correct.
  my $tries = $Apache::lonhomework::history{"resource.$id.tries"};   my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
  my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");   my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
Line 390  sub check_access { Line 474  sub check_access {
     &Apache::lonxml::debug("looking for accesstime $first_access");      &Apache::lonxml::debug("looking for accesstime $first_access");
     if (!$first_access) {      if (!$first_access) {
  $status='NOT_YET_VIEWED';   $status='NOT_YET_VIEWED';
  $datemsg=&seconds_to_human_length($interval);   my $due_date = &due_date($id);
     } else {   $datemsg=&seconds_to_human_length($due_date-time);
  my $newdate=localtime($first_access+$interval);  
  if (time > ($first_access+$interval)) {  
     $status='CLOSED';  
     $datemsg = &mt("was due on")." $newdate".&mt(", and answers will be available on")." $date";  
  } else {  
     $datemsg = &mt("is due at")." $newdate";  
  }  
     }      }
  }   }
     }      }
   
   #if (($status ne 'CLOSED') && ($Apache::lonhomework::type eq 'exam') &&    #if (($status ne 'CLOSED') && ($Apache::lonhomework::type eq 'exam') &&
   #    (!$Apache::lonhomework::history{"resource.0.outtoken"})) {    #    (!$Apache::lonhomework::history{"resource.0.outtoken"})) {
   #    return ('UNCHECKEDOUT','needs to be checked out');    #    return ('UNCHECKEDOUT','needs to be checked out');
Line 417  sub check_access { Line 495  sub check_access {
   
     return ($status,$datemsg);      return ($status,$datemsg);
 }  }
   # this should work exactly like the copy in lonnavmaps.pm
   sub due_date {
       my ($part_id,$symb,$udom,$uname)=@_;
       my $date;
       my $interval= &Apache::lonnet::EXT("resource.$part_id.interval",$symb,
          $udom,$uname);
       &Apache::lonxml::debug("looking for interval $part_id $symb $interval");
       my $due_date= &Apache::lonnet::EXT("resource.$part_id.duedate",$symb,
          $udom,$uname);
       &Apache::lonxml::debug("looking for due_date $part_id $symb $due_date");
       if (defined($interval)) {
    my $first_access=&Apache::lonnet::get_first_access('map',$symb);
    if (defined($first_access)) {
       $interval = $first_access+$interval;
       $date = ($interval < $due_date)? $interval : $due_date;
    } else {
       $date = $due_date;
    }
       } else {
    $date = $due_date;
       }
       return $date
   }
   
 sub seconds_to_human_length {  sub seconds_to_human_length {
     my ($length)=@_;      my ($length)=@_;
Line 489  sub setuppermissions { Line 590  sub setuppermissions {
  $viewgrades = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}.   $viewgrades = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}.
                                                '/'.$env{'request.course.sec'});                                                 '/'.$env{'request.course.sec'});
     }      }
     $Apache::lonhomework::viewgrades = $viewgrades; # File global variable...dirt.      $Apache::lonhomework::viewgrades = $viewgrades;
   
     if ($Apache::lonhomework::browse eq 'F' &&       if ($Apache::lonhomework::browse eq 'F' && 
  $env{'form.devalidatecourseresdata'} eq 'on') {   $env{'form.devalidatecourseresdata'} eq 'on') {
  my (undef,$courseid) = &Apache::lonxml::whichuser();   my (undef,$courseid) = &Apache::lonxml::whichuser();
  &Apache::lonnet::devalidatecourseresdata($env{"course.$courseid.num"},   &Apache::lonnet::devalidatecourseresdata($env{"course.$courseid.num"},
       $env{"course.$courseid.domain"});        $env{"course.$courseid.domain"});
     }      }
   
     my $modifygrades = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});      my $modifygrades = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
     if (! $modifygrades &&       if (! $modifygrades && 
  exists($env{'request.course.sec'}) &&    exists($env{'request.course.sec'}) && 
Line 505  sub setuppermissions { Line 608  sub setuppermissions {
      '/'.$env{'request.course.sec'});       '/'.$env{'request.course.sec'});
     }      }
     $Apache::lonhomework::modifygrades = $modifygrades;      $Apache::lonhomework::modifygrades = $modifygrades;
   
       my $queuegrade = &Apache::lonnet::allowed('mqg',$env{'request.course.id'});
       if (! $queuegrade && 
    exists($env{'request.course.sec'}) && 
    $env{'request.course.sec'} !~ /^\s*$/) {
    $queuegrade = 
       &Apache::lonnet::allowed('qgr',$env{'request.course.id'}.
        '/'.$env{'request.course.sec'});
       }
       $Apache::lonhomework::queuegrade = $queuegrade;
     return '';      return '';
 }  }
   
Line 567  sub handle_save_or_undo { Line 680  sub handle_save_or_undo {
   
 sub analyze_header {  sub analyze_header {
     my ($request) = @_;      my ($request) = @_;
     my $bodytag='<body bgcolor="#ffffff">';      my $result =
     if ($env{'environment.remote'} eq 'off') {   &Apache::loncommon::start_page('Analyzing a problem',undef);
  $bodytag=&Apache::loncommon::bodytag();  
     }      $result .= 
     my $html=&Apache::lonxml::xmlbegin();   &Apache::lonxml::message_location().'
     my $result.=$html.'  
             <head><title>'.&mt("Analyzing a problem").'</title></head>  
             '.$bodytag.&Apache::lonxml::message_location().'  
             <form name="lonhomework" method="POST" action="'.              <form name="lonhomework" method="POST" action="'.
     &HTML::Entities::encode($env{'request.uri'},'<>&"').'">'.      &HTML::Entities::encode($env{'request.uri'},'<>&"').'">'.
     &Apache::structuretags::remember_problem_state().'      &Apache::structuretags::remember_problem_state().'
Line 591  sub analyze_header { Line 701  sub analyze_header {
   
 sub analyze_footer {  sub analyze_footer {
     my ($request) = @_;      my ($request) = @_;
     my $result='</body></html>';      $request->print(&Apache::loncommon::end_page());
     $request->print($result);  
     $request->rflush();      $request->rflush();
 }  }
   
Line 601  sub analyze { Line 710  sub analyze {
     &Apache::lonxml::debug("Analyze");      &Apache::lonxml::debug("Analyze");
     my $result;      my $result;
     my %overall;      my %overall;
       my %seedexample;
     my %allparts;      my %allparts;
     my $rndseed=$env{'form.rndseed'};      my $rndseed=$env{'form.rndseed'};
     &analyze_header($request);      &analyze_header($request);
Line 613  sub analyze { Line 723  sub analyze {
  &Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state,   &Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state,
  &mt('last problem'));   &mt('last problem'));
  if (&Apache::loncommon::connection_aborted($request)) { return; }   if (&Apache::loncommon::connection_aborted($request)) { return; }
           my $thisseed=$i+$rndseed;
  my $subresult=&Apache::lonnet::ssi($request->uri,   my $subresult=&Apache::lonnet::ssi($request->uri,
    ('grade_target' => 'analyze'),     ('grade_target' => 'analyze'),
    ('rndseed' => $i+$rndseed));     ('rndseed' => $thisseed));
  (my $garbage,$subresult)=split(/_HASH_REF__/,$subresult,2);   (my $garbage,$subresult)=split(/_HASH_REF__/,$subresult,2);
  my %analyze=&Apache::lonnet::str2hash($subresult);   my %analyze=&Apache::lonnet::str2hash($subresult);
  my @parts;   my @parts;
Line 627  sub analyze { Line 738  sub analyze {
     if ($analyze{$part.'.type'} eq 'numericalresponse' ||      if ($analyze{$part.'.type'} eq 'numericalresponse' ||
  $analyze{$part.'.type'} eq 'stringresponse' ||   $analyze{$part.'.type'} eq 'stringresponse' ||
  $analyze{$part.'.type'} eq 'formularesponse'   ) {   $analyze{$part.'.type'} eq 'formularesponse'   ) {
    my $concatanswer=join("\0",@{ $analyze{$part.'.answer'} });
    if (($concatanswer eq '') || ($concatanswer=~/^\@/)) {
       @{$analyze{$part.'.answer'}}=('<font color="red">'.&mt('Error').'</font>');
    }
  push( @{ $overall{$part.'.answer'} },   push( @{ $overall{$part.'.answer'} },
       [@{ $analyze{$part.'.answer'} }]);        [@{ $analyze{$part.'.answer'} }]);
                   $seedexample{join("\0",@{ $analyze{$part.'.answer'}})}=$thisseed;
     }      }
  }   }
     }      }
Line 638  sub analyze { Line 754  sub analyze {
     foreach my $part (sort(keys(%allparts))) {      foreach my $part (sort(keys(%allparts))) {
  if (defined(@{ $overall{$part.'.answer'} })) {   if (defined(@{ $overall{$part.'.answer'} })) {
     my $num_cols=scalar(@{ $overall{$part.'.answer'}->[0] });      my $num_cols=scalar(@{ $overall{$part.'.answer'}->[0] });
     $request->print('<table><tr><th colspan="'.($num_cols+1).'">'.&mt('Part').' '.$part.'</th></tr>');      $request->print('<table class="thinborder"><tr><th colspan="'.($num_cols+1).'">'.&mt('Part').' '.$part.'</th></tr>');
     my %frequency;      my %frequency;
     foreach my $answer (sort {$a->[0] <=> $b->[0]} (@{ $overall{$part.'.answer'} })) {      foreach my $answer (sort {$a->[0] <=> $b->[0]} (@{ $overall{$part.'.answer'} })) {
  $frequency{join("\0",@{ $answer })}++;   $frequency{join("\0",@{ $answer })}++;
     }      }
     $request->print('<tr><th colspan="'.($num_cols).'">'.&mt('Answer').'</th><th>'.&mt('Frequency').'</th></tr>');      $request->print('<tr><th colspan="'.($num_cols).'">'.&mt('Answer').'</th><th>'.&mt('Frequency').'<br />('
       .&mt('click for example').')</th></tr>');
     foreach my $answer (sort {(split("\0",$a))[0] <=> (split("\0",$b))[0]} (keys(%frequency))) {      foreach my $answer (sort {(split("\0",$a))[0] <=> (split("\0",$b))[0]} (keys(%frequency))) {
  $request->print('<tr><td align="right">'.   $request->print('<tr><td class="center">'.
  join('</td><td align="right">',split("\0",$answer)).   join('</td><td class="center">',split("\0",$answer)).
  '</td><td>('.$frequency{$answer}.   '</td><td class="center"><a href="'.$request->uri.'?rndseed='.$seedexample{$answer}.'">'.$frequency{$answer}.
  ')</td></tr>');   '</a></td></tr>');
     }      }
     $request->print('</table>');      $request->print('</table>');
  } else {   } else {
Line 657  sub analyze { Line 774  sub analyze {
  }   }
     }      }
     if (scalar(keys(%allparts)) == 0 ) {      if (scalar(keys(%allparts)) == 0 ) {
  $request->print('<p>'.&mt('Found no analyzable respones in this problem, currently only Numerical, Formula and String response styles are supported.').'</p>');   $request->print('<p>'.&mt('Found no analyzable responses in this problem, currently only Numerical, Formula and String response styles are supported.').'</p>');
     }      }
     &Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state);      &Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state);
     &analyze_footer($request);      &analyze_footer($request);
Line 695  sub editxmlmode { Line 812  sub editxmlmode {
  if ($cols > 80) { $cols = 80; }   if ($cols > 80) { $cols = 80; }
  if ($cols < 70) { $cols = 70; }   if ($cols < 70) { $cols = 70; }
  if ($rows < 20) { $rows = 20; }   if ($rows < 20) { $rows = 20; }
  my $bodytag='<body bgcolor="#ffffff">';   my $start_page = 
  if ($env{'environment.remote'} eq 'off') {      &Apache::loncommon::start_page("EditXML $file",
     $bodytag=&Apache::loncommon::bodytag();     &Apache::edit::js_change_detection());
  }  
  my $html=&Apache::lonxml::xmlbegin();   $result.=$start_page.
  $result.=$html.$bodytag.&Apache::lonxml::message_location().'      &renderpage($request,$file,['no_output_web'],1).
             <form name="lonhomework" method="POST" action="'.      &Apache::lonxml::message_location().'
               <form '.&Apache::edit::form_change_detection().' name="lonhomework" method="POST" action="'.
     &HTML::Entities::encode($env{'request.uri'},'<>&"').'">'.      &HTML::Entities::encode($env{'request.uri'},'<>&"').'">'.
     &Apache::structuretags::remember_problem_state().'      &Apache::structuretags::remember_problem_state().'
             <input type="hidden" name="problemmode" value="'.&mt('EditXML').'" />              <input type="hidden" name="problemmode" value="'.&mt('EditXML').'" />
             <input type="submit" name="problemmode" accesskey="d" value="'.&mt('Discard Edits and View').'" />              <input type="submit" name="problemmode" accesskey="d" value="'.&mt('Discard Edits and View').'" />
             <input type="submit" name="problemmode" accesskey="e" value="'.&mt('Edit').'" />              <input type="submit" '.&Apache::edit::submit_ask_anyway().'name="problemmode" accesskey="e" value="'.&mt('Edit').'" />
               <input type="submit" name="Undo" accesskey="u" value="'.&mt('undo').'" />
             <hr />              <hr />
             <input type="submit" name="submit" accesskey="s" value="'.&mt('Submit Changes').'" />              <input type="submit" name="submit" accesskey="s" value="'.&mt('Submit Changes').'" />
             <input type="submit" name="submit" accesskey="v" value="'.&mt('Submit Changes and View').'" />              <input type="submit" name="submit" accesskey="v" value="'.&mt('Submit Changes and View').'" />
             <input type="submit" name="Undo" accesskey="u" value="'.&mt('undo').'" />  
             <hr />              <hr />
             ' . $xml_help . '              ' . $xml_help . '
             <textarea style="width:100%" rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.              <textarea '.&Apache::edit::element_change_detection().' style="width:100%" rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.
     &HTML::Entities::encode($problem,'<>&"').'</textarea>      &HTML::Entities::encode($problem,'<>&"').'</textarea><br />
             </form></body></html>';              <input type="submit" name="submit" accesskey="s" value="'.&mt('Submit Changes').'" />
               <input type="submit" name="submit" accesskey="v" value="'.&mt('Submit Changes and View').'" />
               </form>'.&Apache::loncommon::end_page();
  &Apache::lonxml::add_messages(\$result);   &Apache::lonxml::add_messages(\$result);
  $request->print($result);   $request->print($result);
     }      }
Line 726  sub editxmlmode { Line 846  sub editxmlmode {
 #    Render the page in whatever target desired.  #    Render the page in whatever target desired.
 #  #
 sub renderpage {  sub renderpage {
     my ($request,$file) = @_;      my ($request,$file,$targets,$return_string) = @_;
   
     my (@targets) = &get_target();      my @targets = @{$targets || [&get_target()]};
     &Apache::lonhomework::showhashsubset(\%env,'form.');      &Apache::lonhomework::showhashsubset(\%env,'form.');
     &Apache::lonxml::debug("Running targets ".join(':',@targets));      &Apache::lonxml::debug("Running targets ".join(':',@targets));
     my $overall_result;      my $overall_result;
Line 741  sub renderpage { Line 861  sub renderpage {
  #    $request->print(" You most likely shouldn't see me.");   #    $request->print(" You most likely shouldn't see me.");
  #}   #}
  #my $t0 = [&gettimeofday()];   #my $t0 = [&gettimeofday()];
    my $output=1;
    if ($target eq 'no_output_web') {
       $target = 'web'; $output=0;
    }
  my $problem=&Apache::lonnet::getfile($file);   my $problem=&Apache::lonnet::getfile($file);
    my $result;
  if ($problem eq -1) {   if ($problem eq -1) {
     &Apache::lonxml::error("<b> ".&mt('Unable to find')." <i>$file</i></b>");      my $filename=(split('/',$file))[-1];
       $result.="<b> ".&mt('Unable to find')." <i>$filename</i></b>";
     $problem='';      $problem='';
  }   }
   
  my %mystyle;   my %mystyle;
  my $result = '';  
  if ($target eq 'analyze') { %Apache::lonhomework::analyze=(); }   if ($target eq 'analyze') { %Apache::lonhomework::analyze=(); }
  if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); }   if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); }
  if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%env,'^form');}   if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%env,'^form');}
   
  &Apache::lonxml::debug("Should be parsing now");   &Apache::lonxml::debug("Should be parsing now");
  $result = &Apache::lonxml::xmlparse($request, $target, $problem,   $result .= &Apache::lonxml::xmlparse($request, $target, $problem,
     &setup_vars($target),%mystyle);       &setup_vars($target),%mystyle);
  undef($Apache::lonhomework::parsing_a_problem);   undef($Apache::lonhomework::parsing_a_problem);
    if (!$output) { $result = ''; }
  #$request->print("Result follows:");   #$request->print("Result follows:");
  if ($target eq 'modified') {   if ($target eq 'modified') {
     &handle_save_or_undo($request,\$problem,\$result);      &handle_save_or_undo($request,\$problem,\$result);
Line 777  sub renderpage { Line 903  sub renderpage {
  #$request->print(":Result ends");   #$request->print(":Result ends");
  #my $td=&tv_interval($t0);   #my $td=&tv_interval($t0);
     }      }
     &Apache::lonxml::add_messages(\$overall_result);      if (!$return_string) {
     $request->print($overall_result);      &Apache::lonxml::add_messages(\$overall_result);
     $request->rflush();      $request->print($overall_result);   
    $request->rflush();   
       } else {
    return $overall_result;
       }
 }  }
   
 # with no arg it returns a HTML <option> list of the template titles  # with no arg it returns a HTML <option> list of the template titles
Line 837  sub newproblem { Line 967  sub newproblem {
     $errormsg='<p><font color="red">'.&mt('You did not select a template.').'</font></p>'."\n";      $errormsg='<p><font color="red">'.&mt('You did not select a template.').'</font></p>'."\n";
  }   }
  my $instructions;   my $instructions;
  my $bodytag=&Apache::loncommon::bodytag(undef,undef,undef,   my $start_page = 
  ($env{'environment.remote'} ne 'off'));      &Apache::loncommon::start_page("Create New $extension");
  if ($templatelist) { $instructions=&mt(", select a template from the pull-down menu below.").'<br />'.&mt("Then");}   if ($templatelist) { $instructions=&mt(", select a template from the pull-down menu below.").'<br />'.&mt("Then");}
  my %lt=&Apache::lonlocal::texthash( 'create' => 'Creating a new',   my %lt=&Apache::lonlocal::texthash( 'create' => 'Creating a new',
   'resource' => 'resource',    'resource' => 'resource',
Line 849  sub newproblem { Line 979  sub newproblem {
   'Create' => 'Create',    'Create' => 'Create',
   'button' => 'button');    'button' => 'button');
  $request->print(<<ENDNEWPROBLEM);   $request->print(<<ENDNEWPROBLEM);
 $bodytag  $start_page
 <h1>$lt{'create'} $extension $lt{'resource'}</h1>  <h1>$lt{'create'} $extension $lt{'resource'}</h1>
 $errormsg  $errormsg
 $lt{'requested'} <tt>$shownurl</tt> $lt{'not exist'}.  $lt{'requested'} <tt>$shownurl</tt> $lt{'not exist'}.
Line 862  ENDNEWPROBLEM Line 992  ENDNEWPROBLEM
     $request->print("<select name=\"template\">$templatelist</select>");      $request->print("<select name=\"template\">$templatelist</select>");
  }   }
  $request->print("<br /><input type=\"submit\" name=\"newfile\" value=\"".&mt('Create')." $extension\" />");   $request->print("<br /><input type=\"submit\" name=\"newfile\" value=\"".&mt('Create')." $extension\" />");
  $request->print("</form></p></body>");   $request->print("</form></p>".&Apache::loncommon::end_page());
     }      }
     return '';      return '';
 }  }
   
 sub view_or_edit_menu {  
     my ($request) = @_;  
     my $url=&HTML::Entities::encode($request->uri,'<>&"');  
     my %lt=&Apache::lonlocal::texthash( 'would' => 'Would you like to',  
       'view' => 'View',  
       'Edit' => 'edit',  
       'or' => 'or',  
       'the problem' => 'the problem');  
     $request->print(<<EDITMENU);  
 <body bgcolor="#FFFFFF">  
 <form action="$url" method="POST">  
 $lt{'would'} <input type="submit" name="problemmode" accesskey="v" value="&lt{'view'}">  
 &lt{'or'} <input type="submit" name="problemmode" accesskey="e" value="&lt{'Edit'}">  
 &lt{'the problem'}.  
 </form>  
 </body>  
 EDITMENU  
 }  
   
 sub handler {  sub handler {
     #my $t0 = [&gettimeofday()];      #my $t0 = [&gettimeofday()];
     my $request=$_[0];      my $request=$_[0];
           $Apache::lonxml::request=$request;
     $Apache::lonxml::debug=$env{'user.debug'};      $Apache::lonxml::debug=$env{'user.debug'};
     $env{'request.uri'}=$request->uri;      $env{'request.uri'}=$request->uri;
     &setuppermissions();      &setuppermissions();
Line 909  sub handler { Line 1020  sub handler {
  if ($Apache::lonhomework::browse ne 'F' &&    if ($Apache::lonhomework::browse ne 'F' && 
     $env{'request.state'} ne "construct") {      $env{'request.state'} ne "construct") {
     #should know where we are, so ask      #should know where we are, so ask
     if ( &Apache::lonnet::mod_perl_version() == 2 ) {  
  &Apache::lonnet::cleanenv();  
     }  
     &Apache::lonnet::logthis(&Apache::lonnet::mod_perl_version());  
     $request->internal_redirect('/adm/ambiguous'); return OK;      $request->internal_redirect('/adm/ambiguous'); return OK;
  }   }
     }      }
     if (&setupheader($request)) { return OK; }      if (&setupheader($request)) { return OK; }
     &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:");      &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:$Apache::lonhomework::modifygrades:$Apache::lonhomework::queuegrade");
     &Apache::lonxml::debug("Problem Mode ".$env{'form.problemmode'});      &Apache::lonxml::debug("Problem Mode ".$env{'form.problemmode'});
     my ($symb) = &Apache::lonxml::whichuser();      my ($symb) = &Apache::lonxml::whichuser();
     &Apache::lonxml::debug('symb is '.$symb);      &Apache::lonxml::debug('symb is '.$symb);
     if ($env{'request.state'} eq "construct" || $symb eq '') {  
  if ($env{'form.resetdata'} eq &mt('Reset Submissions') ||  
     $env{'form.resetdata'} eq &mt('New Problem Variation') ||  
     $env{'form.newrandomization'} eq &mt('New Randomization')) {  
     my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();  
     &Apache::lonnet::tmpreset($symb,'',$domain,$name);  
     &Apache::lonxml::debug("Attempt reset");  
  }  
     }  
     if ($env{'request.state'} eq "construct") {      if ($env{'request.state'} eq "construct") {
  if ( -e $file ) {   if ( -e $file ) {
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
     ['problemmode']);      ['problemmode']);
     if (!(defined $env{'form.problemmode'})) {      if (!(defined $env{'form.problemmode'})) {
  #first visit to problem in construction space   #first visit to problem in construction space
  #&view_or_edit_menu($request);  
  $env{'form.problemmode'}='View';   $env{'form.problemmode'}='View';
  &renderpage($request,$file);   &renderpage($request,$file);
     } elsif ($env{'form.problemmode'} eq &mt('EditXML') ||      } elsif ($env{'form.problemmode'} eq &mt('EditXML') ||
Line 958  sub handler { Line 1055  sub handler {
     }      }
     #my $td=&tv_interval($t0);      #my $td=&tv_interval($t0);
     #&Apache::lonxml::debug("Spent $td seconds processing");      #&Apache::lonxml::debug("Spent $td seconds processing");
     # &Apache::lonhomework::send_footer($request);  
     # always turn off debug messages      # always turn off debug messages
     $Apache::lonxml::debug=0;      $Apache::lonxml::debug=0;
     return OK;      return OK;
Removed from v.1.207  
changed lines
  Added in v.1.252

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>