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

Diff for /loncom/homework/lonhomework.pm between versions 1.208 and 1.219

version 1.208, 2005/05/10 20:58:38 version 1.219, 2005/11/08 17:53:20
Line 124  sub get_target { Line 124  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 183  sub proctor_checked_in { Line 183  sub proctor_checked_in {
 $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;
Line 242  sub check_task_access { Line 245  sub check_task_access {
  return ($status,$datemsg);   return ($status,$datemsg);
     }      }
     my $version=$Apache::lonhomework::history{'resource.version'};      my $version=$Apache::lonhomework::history{'resource.version'};
     if ($Apache::lonhomework::history{"resource.$version.checkedin"}) {      if ($Apache::lonhomework::history{"resource.$version.checkedin"} &&
  if ($Apache::lonhomework::history{"resource.$version.status"} eq 'pass' ||   $Apache::lonhomework::history{"resource.$version.status"} eq 'pass') {
     $Apache::lonhomework::history{"resource.$version.status"} eq 'fail') {   return ('SHOW_ANSWER');
     return ('SHOW_ANSWER');  
  }  
     }      }
     my ($id)=@_;      my ($id)=@_;
     my @slots=split(':',&Apache::lonnet::EXT("resource.$id.available"));      my @slots=
    (split(':',&Apache::lonnet::EXT("resource.$id.availablestudent")),
    split(':',&Apache::lonnet::EXT("resource.$id.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) {
  &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 274  sub check_task_access { Line 278  sub check_task_access {
  &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') &&       if ( $slotstatus eq 'NOT_IN_A_SLOT' && 
  $Apache::lonhomework::history{"resource.$version.checkedin"}) {   $Apache::lonhomework::history{"resource.$version.checkedin"}) {
  return ('WAITING_FOR_GRADE');   if ($Apache::lonhomework::history{"resource.$version.status"} eq 'fail') {
       return ('SHOW_ANSWER');
    } else {
       return ('WAITING_FOR_GRADE');
    }
     }      }
     return ($slotstatus,$datemsg,$slot_name,$returned_slot);      return ($slotstatus,$datemsg,$slot_name,$returned_slot);
 }  }
Line 315  sub check_access { Line 323  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 367  sub check_access { Line 378  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 603  sub analyze { Line 615  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 615  sub analyze { Line 628  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 629  sub analyze { Line 643  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 640  sub analyze { Line 659  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 border="1"><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>'.
  join('</td><td align="right">',split("\0",$answer)).   join('</td><td>',split("\0",$answer)).
  '</td><td>('.$frequency{$answer}.   '</td><td><a href="'.$request->uri.'?rndseed='.$seedexample{$answer}.'">'.$frequency{$answer}.
  ')</td></tr>');   '</a></td></tr>');
     }      }
     $request->print('</table>');      $request->print('</table>');
  } else {   } else {
Line 659  sub analyze { Line 679  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 702  sub editxmlmode { Line 722  sub editxmlmode {
     $bodytag=&Apache::loncommon::bodytag();      $bodytag=&Apache::loncommon::bodytag();
  }   }
  my $html=&Apache::lonxml::xmlbegin();   my $html=&Apache::lonxml::xmlbegin();
  $result.=$html.$bodytag.&Apache::lonxml::message_location().'   $result.=$html.$bodytag.
       &renderpage($request,$file,['no_output_web'],1).
       &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 728  sub editxmlmode { Line 750  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 743  sub renderpage { Line 765  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);
  if ($problem eq -1) {   if ($problem eq -1) {
     &Apache::lonxml::error("<b> ".&mt('Unable to find')." <i>$file</i></b>");      &Apache::lonxml::error("<b> ".&mt('Unable to find')." <i>$file</i></b>");
Line 750  sub renderpage { Line 776  sub renderpage {
  }   }
   
  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,   my $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 779  sub renderpage { Line 805  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
Removed from v.1.208  
changed lines
  Added in v.1.219

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