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

Diff for /loncom/homework/grades.pm between versions 1.385 and 1.397

version 1.385, 2006/12/13 18:43:30 version 1.397, 2007/04/26 22:29:50
Line 39  use Apache::loncoursedata; Line 39  use Apache::loncoursedata;
 use Apache::lonmsg();  use Apache::lonmsg();
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::lonenc;
 use String::Similarity;  use String::Similarity;
 use lib '/home/httpd/lib/perl';  use lib '/home/httpd/lib/perl';
 use LONCAPA;  use LONCAPA;
Line 116  sub response_type { Line 117  sub response_type {
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
     my $res = $navmap->getBySymb($symb);      my $res = $navmap->getBySymb($symb);
     my $partlist = $res->parts();      my $partlist = $res->parts();
       my %vPart = 
    map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart'));
     my (%response_types,%handgrade);      my (%response_types,%handgrade);
     foreach my $part (@{ $partlist }) {      foreach my $part (@{ $partlist }) {
    next if (%vPart && !exists($vPart{$part}));
   
  my @types = $res->responseType($part);   my @types = $res->responseType($part);
  my @ids = $res->responseIds($part);   my @ids = $res->responseIds($part);
  for (my $i=0; $i < scalar(@ids); $i++) {   for (my $i=0; $i < scalar(@ids); $i++) {
Line 598  sub verifyreceipt { Line 603  sub verifyreceipt {
     my (undef,undef,$fullname) = &getclasslist('all','0');      my (undef,undef,$fullname) = &getclasslist('all','0');
           
     my $receiptparts=0;      my $receiptparts=0;
     if ($env{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; }      if ($env{"course.$courseid.receiptalg"} eq 'receipt2' ||
    $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; }
     my $parts=['0'];      my $parts=['0'];
     if ($receiptparts) { ($parts)=&response_type($symb); }      if ($receiptparts) { ($parts)=&response_type($symb); }
     foreach (sort       foreach (sort 
Line 947  sub processGroup { Line 953  sub processGroup {
     my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo');      my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo');
     my $total      = scalar(@stuchecked)-1;      my $total      = scalar(@stuchecked)-1;
   
     foreach (@stuchecked) {      foreach my $student (@stuchecked) {
  my ($uname,$udom,$fullname) = split(/:/);   my ($uname,$udom,$fullname) = split(/:/,$student);
  $env{'form.student'}        = $uname;   $env{'form.student'}        = $uname;
  $env{'form.userdom'}        = $udom;   $env{'form.userdom'}        = $udom;
  $env{'form.fullname'}       = $fullname;   $env{'form.fullname'}       = $fullname;
Line 1621  sub show_problem { Line 1627  sub show_problem {
     return $result;      return $result;
 }  }
   
   sub files_exist {
       my ($r, $symb) = @_;
       my @students = &Apache::loncommon::get_env_multiple('form.stuinfo');
   
       foreach my $student (@students) {
           my ($uname,$udom,$fullname) = split(/:/,$student);
           my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
         $udom,$uname);
           my ($string,$timestamp)= &get_last_submission(\%record);
           foreach my $submission (@$string) {
               my ($partid,$respid) =
    ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
               my $files=&get_submitted_files($udom,$uname,$partid,$respid,
      \%record);
               return 1 if (@$files);
           }
       }
       return 0;
   }
   
   sub download_all_link {
       my ($r,$symb) = @_;
       my $all_students = 
    join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo'));
   
       my $parts =
    join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));
   
       my $identifier = &Apache::loncommon::get_cgi_id();
       &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students,
                               'cgi.'.$identifier.'.symb' => $symb,
                               'cgi.'.$identifier.'.parts' => $parts,);
       $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'.
         &mt('Download All Submitted Documents').'</a>');
       return
   }
   
 # --------------------------- show submissions of a student, option to grade   # --------------------------- show submissions of a student, option to grade 
 sub submission {  sub submission {
     my ($request,$counter,$total) = @_;      my ($request,$counter,$total) = @_;
Line 1655  sub submission { Line 1698  sub submission {
  &sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes');   &sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes');
  $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ?    $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
     &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};      &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
    if ($env{'form.handgrade'} eq 'yes' && &files_exist($request, $symb)) {
       &download_all_link($request, $symb);
    }
  $request->print('<h3>&nbsp;<font color="#339933">Submission Record</font></h3>'."\n".   $request->print('<h3>&nbsp;<font color="#339933">Submission Record</font></h3>'."\n".
  '<font size=+1>&nbsp;<b>Resource: </b>'.$env{'form.probTitle'}.'</font>'."\n");   '<font size=+1>&nbsp;<b>Resource: </b>'.$env{'form.probTitle'}.'</font>'."\n");
   
Line 1866  KEYWORDS Line 1911  KEYWORDS
     my %seenparts;      my %seenparts;
     my @part_response_id = &flatten_responseType($responseType);      my @part_response_id = &flatten_responseType($responseType);
     foreach my $part (@part_response_id) {      foreach my $part (@part_response_id) {
    next if ($env{'form.lastSub'} eq 'hdgrade' 
    && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes');
   
  my ($partid,$respid) = @{ $part };   my ($partid,$respid) = @{ $part };
  my $display_part=&get_display_part($partid,$symb);   my $display_part=&get_display_part($partid,$symb);
  if ($env{"form.$uname:$udom:$partid:submitted_by"}) {   if ($env{"form.$uname:$udom:$partid:submitted_by"}) {
Line 1912  KEYWORDS Line 1960  KEYWORDS
  ($env{'form.lastSub'} eq 'hdgrade' &&    ($env{'form.lastSub'} eq 'hdgrade' && 
  $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) {   $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) {
  my $display_part=&get_display_part($partid,$symb);   my $display_part=&get_display_part($partid,$symb);
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '.   $lastsubonly.='<tr><td bgcolor="#ffffe6">Debug -'.'<b>Part:</b> '.
     $display_part.' <font color="#999999">( ID '.$respid.      $display_part.' <font color="#999999">( hhhh ID '.$respid.
     ' )</font>&nbsp; &nbsp;';      ' )</font>&nbsp; &nbsp;';
  my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);   my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);
  if (@$files) {   if (@$files) {
Line 2006  KEYWORDS Line 2054  KEYWORDS
  my $part_resp = join('_',@{ $part_response_id });   my $part_resp = join('_',@{ $part_response_id });
  next if ($seen{$partid} > 0);   next if ($seen{$partid} > 0);
  $seen{$partid}++;   $seen{$partid}++;
  next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/);   next if ($$handgrade{$part_resp} ne 'yes' 
    && $env{'form.lastSub'} eq 'hdgrade');
  push @partlist,$partid;   push @partlist,$partid;
  push @gradePartRespid,$partid.'.'.$respid;   push @gradePartRespid,$partid.'.'.$respid;
  $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));   $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
Line 2058  sub get_last_submission { Line 2107  sub get_last_submission {
  my %lasthash=();   my %lasthash=();
  my ($version);   my ($version);
  for ($version=1;$version<=$$returnhash{'version'};$version++) {   for ($version=1;$version<=$$returnhash{'version'};$version++) {
     foreach (sort(split(/\:/,$$returnhash{$version.':keys'}))) {      foreach my $key (sort(split(/\:/,
  $lasthash{$_}=$$returnhash{$version.':'.$_};   $$returnhash{$version.':keys'}))) {
    $timestamp = scalar(localtime($$returnhash{$version.':timestamp'}));   $lasthash{$key}=$$returnhash{$version.':'.$key};
    $timestamp = 
       scalar(localtime($$returnhash{$version.':timestamp'}));
     }      }
  }   }
  foreach ((keys %lasthash)) {   foreach my $key (keys(%lasthash)) {
     if ($_ =~ /\.submission$/) {      next if ($key !~ /\.submission$/);
  my ($partid,$foo) = split(/submission$/,$_);  
  my $draft  = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?      my ($partid,$foo) = split(/submission$/,$key);
     '<font color="red">Draft Copy</font> ' : '';      my $draft  = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
  push @string, (join(':',$_,$draft.$lasthash{$_}));   '<font color="red">Draft Copy</font> ' : '';
     }      push(@string, join(':', $key, $draft.$lasthash{$key}));
  }   }
     }      }
     @string = $string[0] eq '' ? '<font color="red">Nothing submitted - no attempts.</font>' : @string;      if (!@string) {
     return \@string,\$timestamp;   $string[0] =
       '<font color="red">Nothing submitted - no attempts.</font>';
       }
       return (\@string,\$timestamp);
 }  }
   
 #--- High light keywords, with style choosen by user.  #--- High light keywords, with style choosen by user.
Line 2116  sub processHandGrade { Line 2170  sub processHandGrade {
     }      }
     my $includemsg = $env{'form.includemsg'.$ctr};      my $includemsg = $env{'form.includemsg'.$ctr};
     my ($subject,$message,$msgstatus) = ('','','');      my ($subject,$message,$msgstatus) = ('','','');
               my $restitle = &Apache::lonnet::gettitle($symb);
               my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
                                                   $symb,$udom,$uname);
               my ($feedurl,$baseurl,$showsymb,$messagetail);
               $feedurl = &Apache::lonnet::clutter($url);
               if ($encrypturl =~ /^yes$/i) {
                   $baseurl = &Apache::lonenc::encrypted($feedurl,1);
                   $showsymb = &Apache::lonenc::encrypted($symb,1);
               } else {
                   $baseurl = $feedurl;
                   $showsymb = $symb;
               }
     if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {      if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
  $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);   $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);
  unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }   unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }
  $subject.=' ['.&Apache::lonnet::declutter($url).']';   $subject.=' ['.$restitle.']';
  my (@msgnum) = split(/,/,$includemsg);   my (@msgnum) = split(/,/,$includemsg);
  foreach (@msgnum) {   foreach (@msgnum) {
     $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');      $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');
Line 2127  sub processHandGrade { Line 2193  sub processHandGrade {
  $message =&Apache::lonfeedback::clear_out_html($message);   $message =&Apache::lonfeedback::clear_out_html($message);
  if ($env{'form.withgrades'.$ctr}) {   if ($env{'form.withgrades'.$ctr}) {
     $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;      $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;
     $message.=" for <a href=\"".      $messagetail = " for <a href=\"".
     &Apache::lonnet::clutter($url).                     $baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
     "?symb=$symb\">$env{'form.probTitle'}</a>";   }
  }   $msgstatus = 
  $msgstatus = &Apache::lonmsg::user_normal_msg($uname,$udom,                      &Apache::lonmsg::user_normal_msg($uname,$udom,$subject,
       $subject,       $message.$messagetail,
       $message);                                                       undef,$baseurl,undef,
  $request->print('<br />'.&mt('Sending message to [_1]@[_2]',$uname,$udom).': '.                                                       undef,undef,$showsymb,
                                                        $restitle);
    $request->print('<br />'.&mt('Sending message to [_1]:[_2]',$uname,$udom).': '.
  $msgstatus);   $msgstatus);
     }      }
     if ($env{'form.collaborator'.$ctr}) {      if ($env{'form.collaborator'.$ctr}) {
Line 2150  sub processHandGrade { Line 2218  sub processHandGrade {
     next;      next;
  } else {   } else {
     if ($message ne '') {      if ($message ne '') {
  $msgstatus = &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message);                                  $encrypturl=
                                     &Apache::lonnet::EXT('resource.0.encrypturl',
                                                          $symb,$udom,$collaborator);
                                   if ($encrypturl =~ /^yes$/i) {
                                       $baseurl = &Apache::lonenc::encrypted($feedurl,1);
                                       $showsymb = &Apache::lonenc::encrypted($symb,1);
                                   } else {
                                       $baseurl = $feedurl;
                                       $showsymb = $symb;
                                   }
                                   if ($env{'form.withgrades'.$ctr}) {
                                       $messagetail = " for <a href=\"".
                                       $baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
   
                                   }
    $msgstatus = 
                                       &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);
     }      }
  }   }
     }      }
Line 2506  sub handback_files { Line 2590  sub handback_files {
  $message .= ' The returned file(s) are named: '. $file_msg;   $message .= ' The returned file(s) are named: '. $file_msg;
  $message .= " and can be found in your portfolio space.";   $message .= " and can be found in your portfolio space.";
  my $url = (&Apache::lonnet::decode_symb($symb))[2];   my $url = (&Apache::lonnet::decode_symb($symb))[2];
  $url = &Apache::lonnet::declutter($url);   my $feedurl = &Apache::lonnet::clutter($url);
  my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain,                  my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
  $subject.' (File Returned) ['.$url.']',$message);                                                                          $symb,$domain,$stuname);
                   my ($baseurl,$showsymb);
                   if ($encrypturl =~ /^yes$/i) {
                       $baseurl = &Apache::lonenc::encrypted($feedurl,1);
                       $showsymb = &Apache::lonenc::encrypted($symb,1);
                   } else {
                       $baseurl = $feedurl;
                       $showsymb = $symb;
                   }
                   my $restitle = &Apache::lonnet::gettitle($symb);
    my $msgstatus = 
                      &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject.
    ' (File Returned) ['.$restitle.']',$message,undef,
                            $baseurl,undef,undef,undef,$showsymb,$restitle);
             }              }
         }          }
     return;      return;
Line 2941  sub viewgrades { Line 3037  sub viewgrades {
     }      }
     $result.='</table>'.'</td></tr></table>'.'</td></tr></table>'."\n".      $result.='</table>'.'</td></tr></table>'.'</td></tr></table>'."\n".
  '<input type="hidden" name="totalparts" value="'.$ctsparts.'" />';   '<input type="hidden" name="totalparts" value="'.$ctsparts.'" />';
     $result.='<input type="button" value="Reset" '.      $result.='<input type="button" value="Revert to Default" '.
  'onClick="javascript:resetEntry('.$ctsparts.');" TARGET=_self>';   'onClick="javascript:resetEntry('.$ctsparts.');" TARGET=_self>';
   
     #table listing all the students in a section/class      #table listing all the students in a section/class
Line 4595  sub scantron_fixup_scanline { Line 4691  sub scantron_fixup_scanline {
  $answer=$alphabet[$args->{'response'}];   $answer=$alphabet[$args->{'response'}];
     } elsif ($on eq 'number') {      } elsif ($on eq 'number') {
  $answer=$args->{'response'}+1;   $answer=$args->{'response'}+1;
    if ($answer == 10) { $answer = '0'; }
     } else {      } else {
  substr($answer,$args->{'response'},1)=$on;   substr($answer,$args->{'response'},1)=$on;
     }      }
Line 4665  sub scantron_parse_scanline { Line 4762  sub scantron_parse_scanline {
  || $currentquest eq '*') {   || $currentquest eq '*') {
  push(@{$record{'scantron.doubleerror'}},$questnum);   push(@{$record{'scantron.doubleerror'}},$questnum);
  $record{"scantron.$questnum.answer"}='';   $record{"scantron.$questnum.answer"}='';
     } elsif (!$currentquest       } elsif (!defined($currentquest)
      || $currentquest eq $$scantron_config{'Qoff'}       || $currentquest eq $$scantron_config{'Qoff'}
      || $currentquest !~ /^[A-Z]$/) {       || $currentquest !~ /^[A-Z]$/) {
  $record{"scantron.$questnum.answer"}='';   $record{"scantron.$questnum.answer"}='';
Line 4680  sub scantron_parse_scanline { Line 4777  sub scantron_parse_scanline {
  || $currentquest eq '*') {   || $currentquest eq '*') {
  push(@{$record{'scantron.doubleerror'}},$questnum);   push(@{$record{'scantron.doubleerror'}},$questnum);
  $record{"scantron.$questnum.answer"}='';   $record{"scantron.$questnum.answer"}='';
  } elsif (!$currentquest       } elsif (!defined($currentquest)
  || $currentquest eq $$scantron_config{'Qoff'}        || $currentquest eq $$scantron_config{'Qoff'} 
  || $currentquest !~ /^\d$/) {       || $currentquest !~ /^\d$/) {
  $record{"scantron.$questnum.answer"}='';   $record{"scantron.$questnum.answer"}='';
  if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {   if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
     push(@{$record{"scantron.missingerror"}},$questnum);      push(@{$record{"scantron.missingerror"}},$questnum);
Removed from v.1.385  
changed lines
  Added in v.1.397

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