Diff for /loncom/homework/lonhomework.pm between versions 1.179 and 1.198

version 1.179, 2004/09/18 17:29:29 version 1.198, 2005/03/16 19:09:43
Line 53  use HTML::Entities(); Line 53  use HTML::Entities();
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Time::HiRes qw( gettimeofday tv_interval );  use Time::HiRes qw( gettimeofday tv_interval );
   use Apache::lonnet();
   
   # FIXME - improve commenting
   
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register_insert();      &Apache::lonxml::register_insert();
 }  }
   
   
   #
   # Decides what targets to render for.
   # Implicit inputs:
   #   Various session environment variables:
   #      request.state -  published  - is a /res/ resource
   #                       uploaded   - is a /uploaded/ resource
   #                       contruct   - is a /priv/ resource
   #      form.grade_target - a form parameter requesting a specific target
 sub get_target {  sub get_target {
       &Apache::lonxml::debug("request.state = $ENV{'request.state'}");
       if( defined($ENV{'form.grade_target'})) {
    &Apache::lonxml::debug("form.grade_target= $ENV{'form.grade_target'}");
       } else {
    &Apache::lonxml::debug("form.grade_target <undefined>");
       }
     if (($ENV{'request.state'} eq "published") ||      if (($ENV{'request.state'} eq "published") ||
  ($ENV{'request.state'} eq "uploaded")) {   ($ENV{'request.state'} eq "uploaded")) {
  if ( defined($ENV{'form.grade_target'}  )    if ( defined($ENV{'form.grade_target'}  ) 
Line 96  sub get_target { Line 115  sub get_target {
  } else {   } else {
     return ('web','answer');      return ('web','answer');
  }   }
     } elsif ( $ENV{'form.problemmode'} eq &mt('Edit') ) {      } elsif ( $ENV{'form.problemmode'} eq &mt('Edit') ||
         $ENV{'form.problemmode'} eq 'Edit') {
  if ( $ENV{'form.submitted'} eq 'edit' ) {   if ( $ENV{'form.submitted'} eq 'edit' ) {
     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');
Line 189  sub check_ip_acc { Line 209  sub check_ip_acc {
     }      }
     return $allowed;      return $allowed;
 }  }
   
   sub check_task_access {
       return &check_access;
   }
 # JB, 9/24/2002: Any changes in this function may require a change  # JB, 9/24/2002: Any changes in this function may require a change
 # in lonnavmaps::resource::getDateStatus.  # in lonnavmaps::resource::getDateStatus.
 sub check_access {  sub check_access {
Line 292  sub check_access { Line 316  sub check_access {
     $status = 'CANNOT_ANSWER';      $status = 'CANNOT_ANSWER';
  }   }
     }      }
     if ($status eq 'CAN_ANSWER') {      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");
  &Apache::lonxml::debug("looking for interval $interval");   &Apache::lonxml::debug("looking for interval $interval");
  if ($interval) {   if ($interval) {
Line 300  sub check_access { Line 324  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=' '.$interval.' seconds';   $datemsg=&seconds_to_human_length($interval);
     } else {      } else {
  my $newdate=localtime($first_access+$interval);   my $newdate=localtime($first_access+$interval);
  if (time > ($first_access+$interval)) {   if (time > ($first_access+$interval)) {
Line 328  sub check_access { Line 352  sub check_access {
     return ($status,$datemsg);      return ($status,$datemsg);
 }  }
   
   sub seconds_to_human_length {
       my ($length)=@_;
   
       my $seconds=$length%60; $length=int($length/60);
       my $minutes=$length%60; $length=int($length/60);
       my $hours=$length%24;   $length=int($length/24);
       my $days=$length;
   
       my $timestr;
       if ($days > 0) { $timestr.=&mt('[quant,_1,day]',$days); }
       if ($hours > 0) { $timestr.=($timestr?", ":"").
     &mt('[quant,_1,hour]',$hours); }
       if ($minutes > 0) { $timestr.=($timestr?", ":"").
       &mt('[quant,_1,minute]',$minutes); }
       if ($seconds > 0) { $timestr.=($timestr?", ":"").
       &mt('[quant,_1,second]',$seconds); }
       return $timestr;
   }
   
 sub showhash {  sub showhash {
     my (%hash) = @_;      my (%hash) = @_;
     &showhashsubset(\%hash,'.');      &showhashsubset(\%hash,'.');
Line 338  sub showarray { Line 381  sub showarray {
     my ($array)=@_;      my ($array)=@_;
     my $string="(";      my $string="(";
     foreach my $elm (@{ $array }) {      foreach my $elm (@{ $array }) {
  if (ref($elm)) {   if (ref($elm) eq 'ARRAY') {
     if ($elm =~ /ARRAY/ ) {      $string.=&showarray($elm);
  $string.=&showarray($elm);   } elsif (ref($elm) eq 'HASH') {
     }      $string.= "HASH --- \n<br />";
       $string.= &showhashsubset($elm,'.');
  } else {   } else {
     $string.="$elm,"      $string.="$elm,"
  }   }
Line 355  sub showhashsubset { Line 399  sub showhashsubset {
     my ($hash,$keyre) = @_;      my ($hash,$keyre) = @_;
     my $resultkey;      my $resultkey;
     foreach $resultkey (sort keys %$hash) {      foreach $resultkey (sort keys %$hash) {
  if ($resultkey =~ /$keyre/) {   if ($resultkey !~ /$keyre/) { next; }
     if (ref($$hash{$resultkey})) {   if (ref($$hash{$resultkey})  eq 'ARRAY' ) {
  if ($$hash{$resultkey} =~ /ARRAY/ ) {      &Apache::lonxml::debug("$resultkey ---- ".
     &Apache::lonxml::debug("$resultkey ---- ".     &showarray($$hash{$resultkey}));
    &showarray($$hash{$resultkey}));   } elsif (ref($$hash{$resultkey}) eq 'HASH' ) {
  } elsif ($$hash{$resultkey} =~ /HASH/ ) {      &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
     &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");      &showhashsubset($$hash{$resultkey},'.');
     &showhashsubset($$hash{$resultkey},'.');   } else {
  } else {      &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
     &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");  
  }  
     } else {  
  &Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");  
     }  
  }   }
     }      }
     &Apache::lonxml::debug("\n<br />restored values^</br>\n");      &Apache::lonxml::debug("\n<br />restored values^</br>\n");
Line 384  sub setuppermissions { Line 423  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;      $Apache::lonhomework::viewgrades = $viewgrades; # File global variable...dirt.
       if ($Apache::lonhomework::browse eq 'F' && 
    $ENV{'form.devalidatecourseresdata'} eq 'on') {
    my (undef,$courseid) = &Apache::lonxml::whichuser();
    &Apache::lonnet::devalidatecourseresdata($ENV{"course.$courseid.num"},
         $ENV{"course.$courseid.domain"});
       }
     return ''      return ''
 }  }
   
 sub setupheader {  sub setupheader {
     my $request=$_[0];      my $request=$_[0];
     if ($ENV{'browser.mathml'}) {      &Apache::loncommon::content_type($request,'text/html');
  &Apache::loncommon::content_type($request,'text/xml');  
     } else {  
  &Apache::loncommon::content_type($request,'text/html');  
     }  
     if (!$Apache::lonxml::debug && ($ENV{'REQUEST_METHOD'} eq 'GET')) {      if (!$Apache::lonxml::debug && ($ENV{'REQUEST_METHOD'} eq 'GET')) {
  &Apache::loncommon::no_cache($request);   &Apache::loncommon::no_cache($request);
     }      }
   #    $request->set_last_modified(&Apache::lonnet::metadata($request->uri,
   #  'lastrevisiondate'));
     $request->send_http_header;      $request->send_http_header;
     return OK if $request->header_only;      return OK if $request->header_only;
     return ''      return ''
Line 449  sub handle_save_or_undo { Line 492  sub handle_save_or_undo {
   
 sub analyze_header {  sub analyze_header {
     my ($request) = @_;      my ($request) = @_;
     my $result.='<html>      my $bodytag='<body bgcolor="#ffffff">';
       if ($ENV{'environment.remote'} eq 'off') {
    $bodytag=&Apache::loncommon::bodytag();
       }
       my $html=&Apache::lonxml::xmlbegin();
       my $result.=$html.'
             <head><title>'.&mt("Analyzing a problem").'</title></head>              <head><title>'.&mt("Analyzing a problem").'</title></head>
             <body bgcolor="#FFFFFF">'.&Apache::lonxml::message_location().'              '.$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 489  sub analyze { Line 537  sub analyze {
     for(my $i=1;$i<$ENV{'form.numtoanalyze'}+1;$i++) {      for(my $i=1;$i<$ENV{'form.numtoanalyze'}+1;$i++) {
  &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; }
  my $subresult=&Apache::lonnet::ssi($request->uri,   my $subresult=&Apache::lonnet::ssi($request->uri,
    ('grade_target' => 'analyze'),     ('grade_target' => 'analyze'),
    ('rndseed' => $i+$rndseed));     ('rndseed' => $i+$rndseed));
Line 514  sub analyze { Line 563  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><td colspan="'.($num_cols+1).'">'.&mt('Part').' '.$part.'</td></tr>');      $request->print('<table><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><td colspan="'.($num_cols).'">'.&mt('Answer').'</td><td>'.&mt('Frequency').'</td></tr>');      $request->print('<tr><th colspan="'.($num_cols).'">'.&mt('Answer').'</th><th>'.&mt('Frequency').'</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 align="right">'.
  join('</td><td align="right">',split("\0",$answer)).   join('</td><td align="right">',split("\0",$answer)).
Line 571  sub editxmlmode { Line 620  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; }
  $result.='<html><body bgcolor="#FFFFFF">'.   my $bodytag='<body bgcolor="#ffffff">';
     &Apache::lonxml::message_location().'   if ($ENV{'environment.remote'} eq 'off') {
       $bodytag=&Apache::loncommon::bodytag();
    }
    my $html=&Apache::lonxml::xmlbegin();
    $result.=$html.$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 594  sub editxmlmode { Line 647  sub editxmlmode {
     return '';      return '';
 }  }
   
   #
   #    Render the page in whatever target desired.
   #
 sub renderpage {  sub renderpage {
     my ($request,$file) = @_;      my ($request,$file) = @_;
   
Line 602  sub renderpage { Line 658  sub renderpage {
     &Apache::lonxml::debug("Running targets ".join(':',@targets));      &Apache::lonxml::debug("Running targets ".join(':',@targets));
     my $overall_result;      my $overall_result;
     foreach my $target (@targets) {      foreach my $target (@targets) {
    # FIXME need to do something intelligent when a problem goes
           # from viewable to not viewable due to map conditions
    #&setuppermissions();
    #if (   $Apache::lonhomework::browse ne '2'
    #    && $Apache::lonhomework::browse ne 'F' ) {
    #    $request->print(" You most likely shouldn't see me.");
    #}
  #my $t0 = [&gettimeofday()];   #my $t0 = [&gettimeofday()];
  my $problem=&Apache::lonnet::getfile($file);   my $problem=&Apache::lonnet::getfile($file);
  if ($problem eq -1) {   if ($problem eq -1) {
Line 699  sub newproblem { Line 762  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,1);   my $bodytag=&Apache::loncommon::bodytag(undef,undef,undef,
    ($ENV{'environment.remote'} ne 'off'));
  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 752  sub handler { Line 816  sub handler {
     my $request=$_[0];      my $request=$_[0];
           
     $Apache::lonxml::debug=$ENV{'user.debug'};      $Apache::lonxml::debug=$ENV{'user.debug'};
     if (&setupheader($request)) { return OK; }  
     $ENV{'request.uri'}=$request->uri;      $ENV{'request.uri'}=$request->uri;
       &setuppermissions();
     #setup permissions  
     $Apache::lonhomework::browse= &Apache::lonnet::allowed('bre',$ENV{'request.filename'});  
     $Apache::lonhomework::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});  
     &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:");  
     # some times multiple problemmodes are submitted, need to select      # some times multiple problemmodes are submitted, need to select
     # the last one      # the last one
     &Apache::lonxml::debug("Problem Mode ".$ENV{'form.problemmode'});      if ( defined($ENV{'form.problemmode'}) && ref($ENV{'form.problemmode'}) ) {
     if ( defined($ENV{'form.problemmode'}) &&  
  ref($ENV{'form.problemmode'}) ) {  
  &Apache::lonxml::debug("Problem Mode ".join(",",@$ENV{'form.problemmode'}));  
  my $mode=$ENV{'form.problemmode'}->[-1];   my $mode=$ENV{'form.problemmode'}->[-1];
  undef $ENV{'form.problemmode'};   undef $ENV{'form.problemmode'};
  $ENV{'form.problemmode'}=$mode;   $ENV{'form.problemmode'}=$mode;
     }      }
     &Apache::lonxml::debug("Problem Mode ".$ENV{'form.problemmode'});  
     my $file=&Apache::lonnet::filelocation("",$request->uri);      my $file=&Apache::lonnet::filelocation("",$request->uri);
   
     #check if we know where we are      #check if we know where we are
Line 781  sub handler { Line 837  sub handler {
     if ( &Apache::lonnet::mod_perl_version() == 2 ) {      if ( &Apache::lonnet::mod_perl_version() == 2 ) {
  &Apache::lonnet::cleanenv();   &Apache::lonnet::cleanenv();
     }      }
     $request->internal_redirect('/adm/ambiguous'); return;      &Apache::lonnet::logthis(&Apache::lonnet::mod_perl_version());
       $request->internal_redirect('/adm/ambiguous'); return OK;
  }   }
     }      }
       if (&setupheader($request)) { return OK; }
       &Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:");
       &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{'request.state'} eq "construct" || $symb eq '') {
Line 805  sub handler { Line 864  sub handler {
  #&view_or_edit_menu($request);   #&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') ||
        $ENV{'form.problemmode'} eq 'EditXML') {
  &editxmlmode($request,$file);   &editxmlmode($request,$file);
     } elsif ($ENV{'form.problemmode'} eq &mt('Calculate answers')) {      } elsif ($ENV{'form.problemmode'} eq &mt('Calculate answers')) {
  &analyze($request,$file);   &analyze($request,$file);

Removed from v.1.179  
changed lines
  Added in v.1.198


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