Diff for /loncom/homework/grades.pm between versions 1.422 and 1.423

version 1.422, 2007/07/19 09:52:59 version 1.423, 2007/07/24 21:21:31
Line 3827  LISTJAVASCRIPT Line 3827  LISTJAVASCRIPT
   
     $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";      $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
     $result.='&nbsp;<b>Problems from:</b> <select name="selectpage">'."\n";      $result.='&nbsp;<b>Problems from:</b> <select name="selectpage">'."\n";
     my ($titles,$symbx) = &getSymbMap($request);      my ($titles,$symbx) = &getSymbMap();
     my ($curpage) =&Apache::lonnet::decode_symb($symb);       my ($curpage) =&Apache::lonnet::decode_symb($symb); 
 #    my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb);   #    my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 
 #    my $type=($curpage =~ /\.(page|sequence)/);  #    my $type=($curpage =~ /\.(page|sequence)/);
Line 3909  LISTJAVASCRIPT Line 3909  LISTJAVASCRIPT
 }  }
   
 sub getSymbMap {  sub getSymbMap {
     my ($request) = @_;  
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
   
     my %symbx = ();      my %symbx = ();
Line 4354  sub updateGradeByPage { Line 4353  sub updateGradeByPage {
 #  #
 #------ start of section for handling grading by page/sequence ---------  #------ start of section for handling grading by page/sequence ---------
   
 # Create the hidden field entries used to hold context/default values.  =pod
   
   =head1 Bubble sheet grading routines
   
     (For this documentation 'scanline' refers to the full line of characters
      from the file that we are parsing 'bubble line' refers to the data
      representing the line of bubbles that are on the physical bubble sheet)
   
   =over 4
   
   =cut
   
   
   =pod 
   
   =item defaultFormData
   
     Returns html hidden inputs used to hold context/default values.
   
    Arguments:
     $symb - $symb of the current resource 
   
   =cut
   
 sub defaultFormData {  sub defaultFormData {
     my ($symb)=@_;      my ($symb)=@_;
Line 4364  sub defaultFormData { Line 4385  sub defaultFormData {
      '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";       '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
 }  }
   
 # Make a drop down of the sequences  =pod 
   
   =item getSequenceDropDown
   
      Return html dropdown of possible sequences to grade
    
    Arguments:
      $symb - $symb of the current resource 
   
   =cut
   
 sub getSequenceDropDown {  sub getSequenceDropDown {
     my ($request,$symb)=@_;      my ($symb)=@_;
     my $result='<select name="selectpage">'."\n";      my $result='<select name="selectpage">'."\n";
     my ($titles,$symbx) = &getSymbMap($request);      my ($titles,$symbx) = &getSymbMap();
     my ($curpage)=&Apache::lonnet::decode_symb($symb);       my ($curpage)=&Apache::lonnet::decode_symb($symb); 
     my $ctr=0;      my $ctr=0;
     foreach (@$titles) {      foreach (@$titles) {
Line 4383  sub getSequenceDropDown { Line 4413  sub getSequenceDropDown {
     return $result;      return $result;
 }  }
   
 # Returns a list of the scantron files that have been uploaded to date.  
   =pod 
   
   =item scantron_filenames
   
      Returns a list of the scantron files in the current course 
   
   =cut
   
 sub scantron_filenames {  sub scantron_filenames {
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
Line 4400  sub scantron_filenames { Line 4437  sub scantron_filenames {
     return @possiblenames;      return @possiblenames;
 }  }
   
 # Returns the html required for a drop-down list of scantron  =pod 
 # files that have been uploaded.  
   =item scantron_uploads
   
      Returns  html drop-down list of scantron files in current course.
   
    Arguments:
      $file2grade - filename to set as selected in the dropdown
   
   =cut
   
 sub scantron_uploads {  sub scantron_uploads {
     my ($file2grade) = @_;      my ($file2grade) = @_;
Line 4414  sub scantron_uploads { Line 4459  sub scantron_uploads {
     return $result;      return $result;
 }  }
   
 # Returns the html for a drop down list of the scantron formats in the  =pod 
 # scantronformat.tab file.  
   =item scantron_scantab
   
     Returns html drop down of the scantron formats in the scantronformat.tab
     file.
   
   =cut
   
 sub scantron_scantab {  sub scantron_scantab {
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');      my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
Line 4431  sub scantron_scantab { Line 4482  sub scantron_scantab {
     return $result;      return $result;
 }  }
   
 #  Returns the html for the options in the  =pod 
 #  saved codes dropdown.  
   =item scantron_CODElist
   
     Returns html drop down of the saved CODE lists from current course,
     generated from earlier printings.
   
   =cut
   
 sub scantron_CODElist {  sub scantron_CODElist {
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
Line 4448  sub scantron_CODElist { Line 4505  sub scantron_CODElist {
     return $namechoice;      return $namechoice;
 }  }
   
 # Returns the HTML for "Each CODE to be used once" radio.  =pod 
   
   =item scantron_CODEunique
   
     Returns the html for "Each CODE to be used once" radio.
   
   =cut
   
 sub scantron_CODEunique {  sub scantron_CODEunique {
     my $result='<span style="white-space: nowrap;">      my $result='<span style="white-space: nowrap;">
                  <label><input type="radio" name="scantron_CODEunique"                   <label><input type="radio" name="scantron_CODEunique"
                         value="yes" checked="checked" /> Yes </label>                          value="yes" checked="checked" />'.&mt('Yes').' </label>
                 </span>                  </span>
                 <span style="white-space: nowrap;">                  <span style="white-space: nowrap;">
                  <label><input type="radio" name="scantron_CODEunique"                   <label><input type="radio" name="scantron_CODEunique"
                         value="no" /> No </label>                          value="no" />'.&mt('No').' </label>
                 </span>';                  </span>';
     return $result;      return $result;
 }  }
 #  
 #    Display the first scantron file selection form.  =pod 
 # Paramters:  
 #    r           - The apache request object  =item scantron_selectphase
 #    file2grade  - The name of the scantron file to be graded(?).  
     Generates the initial screen to start the bubble sheet process.
     Allows for - starting a grading run.
                - downloading exisiting scan data (original, corrected
                                                   or skipped info)
   
                - uploading new scan data
   
    Arguments:
     $r          - The Apache request object
     $file2grade - name of the file that contain the scanned data to score
   
   =cut
   
 sub scantron_selectphase {  sub scantron_selectphase {
     my ($r,$file2grade) = @_;      my ($r,$file2grade) = @_;
     my ($symb)=&get_symb($r);      my ($symb)=&get_symb($r);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $sequence_selector=&getSequenceDropDown($r,$symb);      my $sequence_selector=&getSequenceDropDown($symb);
     my $default_form_data=&defaultFormData($symb);      my $default_form_data=&defaultFormData($symb);
     my $grading_menu_button=&show_grading_menu_form($symb);      my $grading_menu_button=&show_grading_menu_form($symb);
     my $file_selector=&scantron_uploads($file2grade);      my $file_selector=&scantron_uploads($file2grade);
Line 4479  sub scantron_selectphase { Line 4554  sub scantron_selectphase {
     my $CODE_selector=&scantron_CODElist();      my $CODE_selector=&scantron_CODElist();
     my $CODE_unique=&scantron_CODEunique();      my $CODE_unique=&scantron_CODEunique();
     my $result;      my $result;
     #FIXME allow instructor to be able to download the scantron file  
     # and to upload it,  
   
     # Chunk of form to prompt for a file to grade and how:      # Chunk of form to prompt for a file to grade and how:
   
Line 4621  SCANTRONFORM Line 4694  SCANTRONFORM
     return      return
 }  }
   
 # Parse and return the scantron configuration line selected as a  =pod
 # hash of configuration file fields.  
 #  =item get_scantron_config
 # Parameters:  
 #   which - the name of the configuration to parse from the file.     Parse and return the scantron configuration line selected as a
 #           If the named configuration is not in the file, an empty     hash of configuration file fields.
 #           hash is returned.  
    Arguments:
       which - the name of the configuration to parse from the file.
   
   
    Returns:
               If the named configuration is not in the file, an empty
               hash is returned.
       a hash with the fields
         name         - internal name for the this configuration setup
         description  - text to display to operator that describes this config
         CODElocation - if 0 or the string 'none'
                             - no CODE exists for this config
                        if -1 || the string 'letter'
                             - a CODE exists for this config and is
                               a string of letters
                        Unsupported value (but planned for future support)
                             if a positive integer
                                  - The CODE exists as the first n items from
                                    the question section of the form
                             if the string 'number'
                                  - The CODE exists for this config and is
                                    a string of numbers
         CODEstart   - (only matter if a CODE exists) column in the line where
                        the CODE starts
         CODElength  - length of the CODE
         IDstart     - column where the student ID number starts
         IDlength    - length of the student ID info
         Qstart      - column where the information from the bubbled
                       'questions' start
         Qlength     - number of columns comprising a single bubble line from
                       the sheet. (usually either 1 or 10)
         Qon         - either a single charater representing the character used
                       to signal a bubble was chosen in the positional setup, or
                       the string 'letter' if the letter of the chosen bubble is
                       in the final, or 'number' if a number representing the
                       chosen bubble is in the file (1->A 0->J)
         Qoff        - the character used to represent that a buble was left blank
         PaperID     - if the scanning process generates a unique number for each
                       sheet scanned the column that this ID number starts in
         PaperIDlength - number of columns that comprise the unique ID number
                         for the sheet of paper
         FirstName   - column that the firs tname starts in
         FirstNameLength - number of columns that the first name spans
    
         LastName    - column that the last name starts in
         LastNameLength - number of columns that the last name spans
   
   =cut
   
 sub get_scantron_config {  sub get_scantron_config {
     my ($which) = @_;      my ($which) = @_;
Line 4661  sub get_scantron_config { Line 4782  sub get_scantron_config {
     return %config;      return %config;
 }  }
   
 #  creates a hash keyed by student id that conains  =pod 
 #  the corresponding student username:domain.  
 # Parameters:  =item username_to_idmap
 #   reference to the class list hash. This is a hash  
 #   keyed by student name:domain  whose elements are references      creates a hash keyed by student id with values of the corresponding
 #   to arrays containng various chunks of information      student username:domain.
 #   about the student. (See loncoursedata for more info).  
 #    Arguments:
 #   
       $classlist - reference to the class list hash. This is a hash
                    keyed by student name:domain  whose elements are references
                    to arrays containng various chunks of information
                    about the student. (See loncoursedata for more info).
   
     Returns
       %idmap - the constructed hash
   
   =cut
   
 sub username_to_idmap {  sub username_to_idmap {
     my ($classlist)= @_;      my ($classlist)= @_;
     my %idmap;      my %idmap;
Line 4679  sub username_to_idmap { Line 4810  sub username_to_idmap {
     }      }
     return %idmap;      return %idmap;
 }  }
 #  
 # Make a correction in a scantron line?  =pod
 # Parameters:  
 #   scantron_config    - Format of the scantron file  =item scatron_fixup_scanline
 #   scan_data          - Hash of line by line info about the scan(?).  
 #   line               - Scantron line to edit?     Process a requested correction to a scanline.
 #   whichline  
 #   field      Arguments:
 #   args               - Keyword/value hash of additional parameters.      $scantron_config   - hash from &get_scantron_config()
 #      $scan_data         - hash of correction information 
                             (see &scantron_getfile())
       $line              - existing scanline
       $whichline         - line number of the passed in scanline
       $field             - type of change to process 
                            (either 
                             'ID'     -> correct the student ID number
                             'CODE'   -> correct the CODE
                             'answer' -> fixup the submitted answers)
       
      $args               - hash of additional info,
                             - 'ID' 
                                  'newid' -> studentID to use in replacement
                                             of exisiting one
                             - 'CODE' 
                                  'CODE_ignore_dup' - set to true if duplicates
                                                      should be ignored.
                          'CODE' - is new code or 'use_unfound'
                                           if the exisitng unfound code should
                                           be used as is
                             - 'answer'
                                  'response' - new answer or 'none' if blank
                                  'question' - the bubble line to change
   
     Returns:
       $line - the modified scanline
   
     Side effects: 
       $scan_data - may be updated
   
   =cut
   
   
 sub scantron_fixup_scanline {  sub scantron_fixup_scanline {
     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;      my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
     #  
     # ID field, args->{'newid'} is the new value of the ID field.  
     #  
     if ($field eq 'ID') {      if ($field eq 'ID') {
  if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {   if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
     return ($line,1,'New value too large');      return ($line,1,'New value too large');
Line 4709  sub scantron_fixup_scanline { Line 4869  sub scantron_fixup_scanline {
     &scan_data($scan_data,"$whichline.user",      &scan_data($scan_data,"$whichline.user",
        $args->{'username'}.':'.$args->{'domain'});         $args->{'username'}.':'.$args->{'domain'});
  }   }
  # CODE Field,   
  #   args->{CODE_ignore_dup} is true if duplicates should be ignored.  
  #   args->{CODE} is new code or 'use_unfound' if an unfound code should  
  #                be used as is?  
  #  
     } elsif ($field eq 'CODE') {      } elsif ($field eq 'CODE') {
  if ($args->{'CODE_ignore_dup'}) {   if ($args->{'CODE_ignore_dup'}) {
     &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');      &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');
Line 4729  sub scantron_fixup_scanline { Line 4884  sub scantron_fixup_scanline {
     substr($line,$$scantron_config{'CODEstart'}-1,      substr($line,$$scantron_config{'CODEstart'}-1,
    $$scantron_config{'CODElength'})=$args->{'CODE'};     $$scantron_config{'CODElength'})=$args->{'CODE'};
  }   }
  #  
  # Edit the answer field.  
  #     args->{'response'} - new answer or 'none' if blank.  
  #     args->{'question'} - the question (number?)?.  
  #  
     } elsif ($field eq 'answer') {      } elsif ($field eq 'answer') {
  my $length=$scantron_config->{'Qlength'};   my $length=$scantron_config->{'Qlength'};
  my $off=$scantron_config->{'Qoff'};   my $off=$scantron_config->{'Qoff'};
Line 4760  sub scantron_fixup_scanline { Line 4910  sub scantron_fixup_scanline {
     }      }
     return $line;      return $line;
 }  }
 # Edit or look up  an item in the scan_data hash.  
 # Parameters:  =pod
 #   scan_data   - The hash.  
 #   key         - shorthand of the key to edit (actual key is  =item scan_data
 #                 scatronfilename_key.  
 #   data        - New value of the hash entry.      Edit or look up  an item in the scan_data hash.
 #   delete      - If defined, the entry is removed from the table.  
 # Returns:    Arguments:
 #   The new value of the hash table field (undefined if deleted).      $scan_data  - The hash (see scantron_getfile)
 #      $key        - shorthand of the key to edit (actual key is
                     scatronfilename_key).
       $data        - New value of the hash entry.
       $delete      - If true, the entry is removed from the hash.
   
     Returns:
       The new value of the hash table field (undefined if deleted).
   
   =cut
   
   
 sub scan_data {  sub scan_data {
     my ($scan_data,$key,$value,$delete)=@_;      my ($scan_data,$key,$value,$delete)=@_;
     my $filename=$env{'form.scantron_selectfile'};      my $filename=$env{'form.scantron_selectfile'};
Line 4779  sub scan_data { Line 4939  sub scan_data {
     if ($delete) { delete($scan_data->{$filename.'_'.$key}); }      if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
     return $scan_data->{$filename.'_'.$key};      return $scan_data->{$filename.'_'.$key};
 }  }
 #  
 #  Decode a line on the uploaded scantron file:  =pod 
 #  Arguments:  
 #    line             - The text of the  scantron file line to process  =item scantron_parse_scanline
 #    whichline        - Line number(?)  
 #    scantron_config  - Hash describing the format of the scantron lines.    Decodes a scanline from the selected scantron file
 #    scan_data        - Hash being built up of the entire scantron file.  
 #    justHeader       - True if should not process question answers but only   Arguments:
 #                       the stuff to the left of the answers.      line             - The text of the scantron file line to process
 # Returns:      whichline        - Line number
 #   Hash of data from the line?      scantron_config  - Hash describing the format of the scantron lines.
 #      scan_data        - Hash of extra information about the scanline
                          (see scantron_getfile for more information)
       just_header      - True if should not process question answers but only
                          the stuff to the left of the answers.
    Returns:
      Hash containing the result of parsing the scanline
   
      Keys are all proceeded by the string 'scantron.'
   
          CODE    - the CODE in use for this scanline
          useCODE - 1 if the CODE is invalid but it usage has been forced
                    by the operator
          CODE_ignore_dup - 1 if the CODE is a duplicated use when unique
                               CODEs were selected, but the usage has been
                               forced by the operator
          ID  - student ID
          PaperID - if used, the ID number printed on the sheet when the 
                    paper was scanned
          FirstName - first name from the sheet
          LastName  - last name from the sheet
   
        if just_header was not true these key may also exist
   
          missingerror - a list of bubbled line numbers that had a blank bubble
                         that is considered an error (if the operator had already
                         okayed a blank bubble line as really being blank then
                         that bubble line number won't appear here.
          doubleerror  - a list of bubbled line numbers that had more than one
                         bubble filled in and has not been corrected by the
                         operator
          maxquest     - the number of the last bubble line that was parsed
   
          (<number> starts at 1)
          <number>.answer - zero or more letters representing the selected
                            letters from the scanline for the bubble line 
                            <number>.
                            if blank there was either no bubble or there where
                            multiple bubbles, (consult the keys missingerror and
                            doubleerror if this is an error condition)
   
   =cut
   
 sub scantron_parse_scanline {  sub scantron_parse_scanline {
     my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_;      my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;
     my %record;      my %record;
     my $questions=substr($line,$$scantron_config{'Qstart'}-1);  # Answers      my $questions=substr($line,$$scantron_config{'Qstart'}-1);  # Answers
     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff      my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff
Line 4825  sub scantron_parse_scanline { Line 5026  sub scantron_parse_scanline {
     $record{'scantron.LastName'}=      $record{'scantron.LastName'}=
  substr($data,$$scantron_config{'LastName'}-1,   substr($data,$$scantron_config{'LastName'}-1,
        $$scantron_config{'LastNamelength'});         $$scantron_config{'LastNamelength'});
     if ($justHeader) { return \%record; }      if ($just_header) { return \%record; }
   
     my @alphabet=('A'..'Z');      my @alphabet=('A'..'Z');
     my $questnum=0;      my $questnum=0;
Line 4898  sub scantron_parse_scanline { Line 5099  sub scantron_parse_scanline {
     return \%record;      return \%record;
 }  }
   
   =pod
   
   =item scantron_add_delay
   
      Adds an error message that occurred during the grading phase to a
      queue of messages to be shown after grading pass is complete
   
    Arguments:
      $delayqueue  - arrary ref of hash ref of erro messages
      $scanline    - the scanline that caused the error
      $errormesage - the error message
      $errorcode   - a numeric code for the error
   
    Side Effects:
      updates the $dealyqueue to have a new hash ref of the error
   
   =cut
   
 sub scantron_add_delay {  sub scantron_add_delay {
     my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;      my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;
     push(@$delayqueue,      push(@$delayqueue,
Line 4906  sub scantron_add_delay { Line 5125  sub scantron_add_delay {
  );   );
 }  }
   
   =pod
   
   =item scantron_find_student
   
   =cut
   
 sub scantron_find_student {  sub scantron_find_student {
     my ($scantron_record,$scan_data,$idmap,$line)=@_;      my ($scantron_record,$scan_data,$idmap,$line)=@_;
     my $scanID=$$scantron_record{'scantron.ID'};      my $scanID=$$scantron_record{'scantron.ID'};
Line 4920  sub scantron_find_student { Line 5145  sub scantron_find_student {
     return undef;      return undef;
 }  }
   
   =pod
   
   =item scantron_filter
   
   =cut
   
 sub scantron_filter {  sub scantron_filter {
     my ($curres)=@_;      my ($curres)=@_;
   
Line 4936  sub scantron_filter { Line 5167  sub scantron_filter {
     return 0;      return 0;
 }  }
   
   =pod
   
   =item scantron_process_corrections
   
   =cut
   
 sub scantron_process_corrections {  sub scantron_process_corrections {
     my ($r) = @_;      my ($r) = @_;
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
Line 4993  sub scantron_process_corrections { Line 5230  sub scantron_process_corrections {
     }      }
 }  }
   
   =pod
   
   =item reset_skipping_status
   
   =cut
   
 sub reset_skipping_status {  sub reset_skipping_status {
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     &scan_data($scan_data,'remember_skipping',undef,1);      &scan_data($scan_data,'remember_skipping',undef,1);
     &scantron_putfile(undef,$scan_data);      &scantron_putfile(undef,$scan_data);
 }  }
   
   =pod
   
   =item start_skipping
   
   =cut
   
 sub start_skipping {  sub start_skipping {
     my ($scan_data,$i)=@_;      my ($scan_data,$i)=@_;
     my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));      my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
Line 5010  sub start_skipping { Line 5259  sub start_skipping {
     &scan_data($scan_data,'remember_skipping',join(':',%remembered));      &scan_data($scan_data,'remember_skipping',join(':',%remembered));
 }  }
   
   =pod
   
   =item should_be_skipped
   
   =cut
   
 sub should_be_skipped {  sub should_be_skipped {
     my ($scanlines,$scan_data,$i)=@_;      my ($scanlines,$scan_data,$i)=@_;
     if ($env{'form.scantron_options_redo'} !~ /^redo_/) {      if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
Line 5025  sub should_be_skipped { Line 5280  sub should_be_skipped {
     return 1;      return 1;
 }  }
   
   =pod
   
   =item remember_current_skipped
   
   =cut
   
 sub remember_current_skipped {  sub remember_current_skipped {
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my %to_remember;      my %to_remember;
Line 5038  sub remember_current_skipped { Line 5299  sub remember_current_skipped {
     &scantron_putfile(undef,$scan_data);      &scantron_putfile(undef,$scan_data);
 }  }
   
   =pod
   
   =item check_for_error
   
   =cut
   
 sub check_for_error {  sub check_for_error {
     my ($r,$result)=@_;      my ($r,$result)=@_;
     if ($result ne 'ok' && $result ne 'not_found' ) {      if ($result ne 'ok' && $result ne 'not_found' ) {
Line 5045  sub check_for_error { Line 5312  sub check_for_error {
     }      }
 }  }
   
   =pod
   
   =item scantron_warning_screen
   
   =cut
   
 sub scantron_warning_screen {  sub scantron_warning_screen {
     my ($button_text)=@_;      my ($button_text)=@_;
     my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});      my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
Line 5077  $CODElist Line 5350  $CODElist
 STUFF  STUFF
 }  }
   
   =pod
   
   =item scantron_do_warning
   
   =cut
   
 sub scantron_do_warning {  sub scantron_do_warning {
     my ($r)=@_;      my ($r)=@_;
     my ($symb)=&get_symb($r);      my ($symb)=&get_symb($r);
Line 5108  STUFF Line 5387  STUFF
     return '';      return '';
 }  }
   
   =pod
   
   =item scantron_form_start
   
   =cut
   
 sub scantron_form_start {  sub scantron_form_start {
     my ($max_bubble)=@_;      my ($max_bubble)=@_;
     my $result= <<SCANTRONFORM;      my $result= <<SCANTRONFORM;
Line 5125  SCANTRONFORM Line 5410  SCANTRONFORM
     return $result;      return $result;
 }  }
   
   =pod
   
   =item scantron_validate_file
   
   =cut
   
 sub scantron_validate_file {  sub scantron_validate_file {
     my ($r) = @_;      my ($r) = @_;
     my ($symb)=&get_symb($r);      my ($symb)=&get_symb($r);
Line 5208  STUFF Line 5499  STUFF
     return '';      return '';
 }  }
   
   
   =pod
   
   =item scantron_remove_file
   
   =cut
   
 sub scantron_remove_file {  sub scantron_remove_file {
     my ($which)=@_;      my ($which)=@_;
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
Line 5222  sub scantron_remove_file { Line 5520  sub scantron_remove_file {
     return &Apache::lonnet::removeuserfile($cname,$cdom,$file);      return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
 }  }
   
   
   =pod
   
   =item scantron_remove_scan_data
   
   =cut
   
 sub scantron_remove_scan_data {  sub scantron_remove_scan_data {
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
Line 5244  sub scantron_remove_scan_data { Line 5549  sub scantron_remove_scan_data {
     return $result;      return $result;
 }  }
   
   
   =pod
   
   =item scantron_getfile
   
   =cut
   
 sub scantron_getfile {  sub scantron_getfile {
     #FIXME really would prefer a scantron directory      #FIXME really would prefer a scantron directory
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
Line 5276  sub scantron_getfile { Line 5588  sub scantron_getfile {
     return (\%scanlines,\%scan_data);      return (\%scanlines,\%scan_data);
 }  }
   
   =pod
   
   =item lonnet_putfile
   
   =cut
   
 sub lonnet_putfile {  sub lonnet_putfile {
     my ($contents,$filename)=@_;      my ($contents,$filename)=@_;
     my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
Line 5285  sub lonnet_putfile { Line 5603  sub lonnet_putfile {
   
 }  }
   
   =pod
   
   =item scantron_putfile
   
   =cut
   
 sub scantron_putfile {  sub scantron_putfile {
     my ($scanlines,$scan_data) = @_;      my ($scanlines,$scan_data) = @_;
     #FIXME really would prefer a scantron directory      #FIXME really would prefer a scantron directory
Line 5305  sub scantron_putfile { Line 5629  sub scantron_putfile {
     &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);      &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
 }  }
   
   =pod
   
   =item scantron_get_line
   
   =cut
   
 sub scantron_get_line {  sub scantron_get_line {
     my ($scanlines,$scan_data,$i)=@_;      my ($scanlines,$scan_data,$i)=@_;
     if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }      if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }
Line 5313  sub scantron_get_line { Line 5643  sub scantron_get_line {
     return $scanlines->{'orig'}[$i];       return $scanlines->{'orig'}[$i]; 
 }  }
   
   =pod
   
   =item scantron_todo_count
   
   =cut
   
 sub get_todo_count {  sub get_todo_count {
     my ($scanlines,$scan_data)=@_;      my ($scanlines,$scan_data)=@_;
     my $count=0;      my $count=0;
Line 5324  sub get_todo_count { Line 5660  sub get_todo_count {
     return $count;      return $count;
 }  }
   
   =pod
   
   =item scantron_put_line
   
   =cut
   
 sub scantron_put_line {  sub scantron_put_line {
     my ($scanlines,$scan_data,$i,$newline,$skip)=@_;      my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
     if ($skip) {      if ($skip) {
Line 5334  sub scantron_put_line { Line 5676  sub scantron_put_line {
     $scanlines->{'corrected'}[$i]=$newline;      $scanlines->{'corrected'}[$i]=$newline;
 }  }
   
   =pod
   
   =item scantron_clear_skip
   
   =cut
   
 sub scantron_clear_skip {  sub scantron_clear_skip {
     my ($scanlines,$scan_data,$i)=@_;      my ($scanlines,$scan_data,$i)=@_;
     if (exists($scanlines->{'skipped'}[$i])) {      if (exists($scanlines->{'skipped'}[$i])) {
Line 5343  sub scantron_clear_skip { Line 5691  sub scantron_clear_skip {
     return 0;      return 0;
 }  }
   
   =pod
   
   =item scantron_filter_not_exam
   
   =cut
   
 sub scantron_filter_not_exam {  sub scantron_filter_not_exam {
     my ($curres)=@_;      my ($curres)=@_;
           
Line 5359  sub scantron_filter_not_exam { Line 5713  sub scantron_filter_not_exam {
     return 0;      return 0;
 }  }
   
   =pod
   
   =item scantron_validate_sequence
   
   =cut
   
 sub scantron_validate_sequence {  sub scantron_validate_sequence {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
   
Line 5382  sub scantron_validate_sequence { Line 5742  sub scantron_validate_sequence {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
   =pod
   
   =item scantron_validate_ID
   
   =cut
   
 sub scantron_validate_ID {  sub scantron_validate_ID {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
           
Line 5444  sub scantron_validate_ID { Line 5810  sub scantron_validate_ID {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
   =pod
   
   =item scantron_get_correction
   
   =cut
   
 sub scantron_get_correction {  sub scantron_get_correction {
     my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;      my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
   
Line 5567  ENDSCRIPT Line 5939  ENDSCRIPT
     $r->print("\n</li></ul>");      $r->print("\n</li></ul>");
   
 }  }
 #  
 #  Ask the grader to select the actual bubble  =pod
 #    
 # Arguments:  =item scantron_bubble_selector
 #    r           - Apache request.    
 #    scan_config - Hash of the scantron format selected.     Generates the html radiobuttons to correct a single bubble line
 #    quest       - Question being evaluated     possibly showing the exisiting the selected bubbles if known
 #    selected    - array of selected bubbles  
 #    lines       - if present, number of bubble lines in questions.   Arguments:
       $r           - Apache request object
       $scan_config - hash from &get_scantron_config()
       $quest       - number of the bubble line to make a corrector for
       $selected    - array of letters of previously selected bubbles
       $lines       - if present, number of bubble lines to show
   
   =cut
   
 sub scantron_bubble_selector {  sub scantron_bubble_selector {
     my ($r,$scan_config,$quest,@selected, $lines)=@_;      my ($r,$scan_config,$quest,@selected, $lines)=@_;
     my $max=$$scan_config{'Qlength'};      my $max=$$scan_config{'Qlength'};
Line 5637  sub scantron_bubble_selector { Line 6017  sub scantron_bubble_selector {
     $r->print('</table>');      $r->print('</table>');
 }  }
   
   =pod
   
   =item num_matches
   
   =cut
   
 sub num_matches {  sub num_matches {
     my ($orig,$code) = @_;      my ($orig,$code) = @_;
     my @code=split(//,$code);      my @code=split(//,$code);
Line 5648  sub num_matches { Line 6034  sub num_matches {
     return $same;      return $same;
 }  }
   
   =pod
   
   =item scantron_get_closely_matching_CODEs
   
   =cut
   
 sub scantron_get_closely_matching_CODEs {  sub scantron_get_closely_matching_CODEs {
     my ($allcodes,$CODE)=@_;      my ($allcodes,$CODE)=@_;
     my @CODEs;      my @CODEs;
Line 5658  sub scantron_get_closely_matching_CODEs Line 6050  sub scantron_get_closely_matching_CODEs
     return ($#CODEs,$CODEs[-1]);      return ($#CODEs,$CODEs[-1]);
 }  }
   
   =pod
   
   =item get_codes
   
   =cut
   
 sub get_codes {  sub get_codes {
     my ($old_name, $cdom, $cnum) = @_;      my ($old_name, $cdom, $cnum) = @_;
     if (!$old_name) {      if (!$old_name) {
Line 5680  sub get_codes { Line 6078  sub get_codes {
     return %allcodes;      return %allcodes;
 }  }
   
   =pod
   
   =item scantron_validate_CODE
   
   =cut
   
 sub scantron_validate_CODE {  sub scantron_validate_CODE {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
Line 5731  sub scantron_validate_CODE { Line 6135  sub scantron_validate_CODE {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
   =pod
   
   =item scantron_validate_doublebubble
   
   =cut
   
 sub scantron_validate_doublebubble {  sub scantron_validate_doublebubble {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
     #get student info      #get student info
Line 5754  sub scantron_validate_doublebubble { Line 6164  sub scantron_validate_doublebubble {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
   =pod
   
   =item scantron_get_maxbubble
   
   =cut
   
 sub scantron_get_maxbubble {      sub scantron_get_maxbubble {    
     if (defined($env{'form.scantron_maxbubble'}) &&      if (defined($env{'form.scantron_maxbubble'}) &&
  $env{'form.scantron_maxbubble'}) {   $env{'form.scantron_maxbubble'}) {
Line 5780  sub scantron_get_maxbubble { Line 6196  sub scantron_get_maxbubble {
     return $env{'form.scantron_maxbubble'};      return $env{'form.scantron_maxbubble'};
 }  }
   
   =pod
   
   =item scantron_validate_missingbubbles
   
   =cut
   
 sub scantron_validate_missingbubbles {  sub scantron_validate_missingbubbles {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
     #get student info      #get student info
Line 5812  sub scantron_validate_missingbubbles { Line 6234  sub scantron_validate_missingbubbles {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
   =pod
   
   =item scantron_process_students
   
      Routine that does the actual grading of the bubble sheet information.
   
      The parsed scanline hash is added to %env 
   
      Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
      foreach resource , with the form data of
   
    'submitted'     =>'scantron' 
    'grade_target'  =>'grade',
    'grade_username'=> username of student
    'grade_domain'  => domain of student
    'grade_courseid'=> of course
    'grade_symb'    => symb of resource to grade
   
       This triggers a grading pass. The problem grading code takes care
       of converting the bubbled letter information (now in %env) into a
       valid submission.
   
   =cut
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r) = @_;      my ($r) = @_;
     my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});      my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
Line 5916  SCANTRONFORM Line 6362  SCANTRONFORM
     return '';      return '';
 }  }
   
   =pod
   
   =item scantron_upload_scantron_data
   
       Creates the screen for adding a new bubble sheet data file to a course.
   
   =cut
   
 sub scantron_upload_scantron_data {  sub scantron_upload_scantron_data {
     my ($r)=@_;      my ($r)=@_;
     $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));      $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));
Line 5952  UPLOAD Line 6406  UPLOAD
     return '';      return '';
 }  }
   
   =pod
   
   =item scantron_upload_scantron_data_save
   
      Adds a provided bubble information data file to the course if user
      has the correct privileges to do so.  
   
   =cut
   
 sub scantron_upload_scantron_data_save {  sub scantron_upload_scantron_data_save {
     my($r)=@_;      my($r)=@_;
     my ($symb)=&get_symb($r,1);      my ($symb)=&get_symb($r,1);
Line 6007  sub scantron_upload_scantron_data_save { Line 6470  sub scantron_upload_scantron_data_save {
     return '';      return '';
 }  }
   
   =pod
   
   =item valid_file
   
      Vaildates that the requested bubble data file has exists in the course.
   
   =cut
   
 sub valid_file {  sub valid_file {
     my ($requested_file)=@_;      my ($requested_file)=@_;
     foreach my $filename (sort(&scantron_filenames())) {      foreach my $filename (sort(&scantron_filenames())) {
Line 6015  sub valid_file { Line 6486  sub valid_file {
     return 0;      return 0;
 }  }
   
   =pod
   
   =item scantron_download_scantron_data
   
      Shows a list of the three internal files (original, corrected,
      skipped) for a specific bubble sheet data file that exists in the
      course.
   
   =cut
   
 sub scantron_download_scantron_data {  sub scantron_download_scantron_data {
     my ($r)=@_;      my ($r)=@_;
     my $default_form_data=&defaultFormData(&get_symb($r,1));      my $default_form_data=&defaultFormData(&get_symb($r,1));
Line 6051  DOWNLOAD Line 6532  DOWNLOAD
     return '';      return '';
 }  }
   
   =pod
   
   =back
   
   =cut
   
 #-------- end of section for handling grading scantron forms -------  #-------- end of section for handling grading scantron forms -------
 #  #
 #-------------------------------------------------------------------  #-------------------------------------------------------------------

Removed from v.1.422  
changed lines
  Added in v.1.423


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