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

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

version 1.421, 2007/07/06 23:17:28 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 ---------
   
   =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)=@_;
     return '      return '
Line 4362  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";
 }  }
   
   =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 4379  sub getSequenceDropDown { Line 4413  sub getSequenceDropDown {
     return $result;      return $result;
 }  }
   
   
   =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'};
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
Line 4394  sub scantron_filenames { Line 4437  sub scantron_filenames {
     return @possiblenames;      return @possiblenames;
 }  }
   
   =pod 
   
   =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) = @_;
     my $result= '<select name="scantron_selectfile">';      my $result= '<select name="scantron_selectfile">';
Line 4405  sub scantron_uploads { Line 4459  sub scantron_uploads {
     return $result;      return $result;
 }  }
   
   =pod 
   
   =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');
     my $result='<select name="scantron_format">'."\n";      my $result='<select name="scantron_format">'."\n";
Line 4419  sub scantron_scantab { Line 4482  sub scantron_scantab {
     return $result;      return $result;
 }  }
   
   =pod 
   
   =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'};
     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
Line 4433  sub scantron_CODElist { Line 4505  sub scantron_CODElist {
     return $namechoice;      return $namechoice;
 }  }
   
   =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;
 }  }
   
   =pod 
   
   =item scantron_selectphase
   
     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 4457  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:
   
     $result.= <<SCANTRONFORM;      $result.= <<SCANTRONFORM;
     <table width="100%" border="0">      <table width="100%" border="0">
     <tr>      <tr>
Line 4511  SCANTRONFORM Line 4609  SCANTRONFORM
     if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||      if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||
         &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {          &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
   
    # Chunk of form to prompt for a scantron file upload.
   
         $r->print(<<SCANTRONFORM);          $r->print(<<SCANTRONFORM);
     <tr>      <tr>
       <td bgcolor="#777777">        <td bgcolor="#777777">
Line 4556  UPLOAD Line 4656  UPLOAD
     </tr>      </tr>
 SCANTRONFORM  SCANTRONFORM
     }      }
   
       # Chunk of the form that prompts to view a scoring office file,
       # corrected file, skipped records in a file.
   
     $r->print(<<SCANTRONFORM);      $r->print(<<SCANTRONFORM);
     <tr>      <tr>
       <form action='/adm/grades' name='scantron_download'>        <form action='/adm/grades' name='scantron_download'>
Line 4590  SCANTRONFORM Line 4694  SCANTRONFORM
     return      return
 }  }
   
   =pod
   
   =item get_scantron_config
   
      Parse and return the scantron configuration line selected as a
      hash of configuration file fields.
   
    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) = @_;
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');      my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
Line 4622  sub get_scantron_config { Line 4782  sub get_scantron_config {
     return %config;      return %config;
 }  }
   
   =pod 
   
   =item username_to_idmap
   
       creates a hash keyed by student id with values of the corresponding
       student username:domain.
   
     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 4632  sub username_to_idmap { Line 4811  sub username_to_idmap {
     return %idmap;      return %idmap;
 }  }
   
   =pod
   
   =item scatron_fixup_scanline
   
      Process a requested correction to a scanline.
   
     Arguments:
       $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)=@_;
   
     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 4690  sub scantron_fixup_scanline { Line 4911  sub scantron_fixup_scanline {
     return $line;      return $line;
 }  }
   
   =pod
   
   =item scan_data
   
       Edit or look up  an item in the scan_data hash.
   
     Arguments:
       $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 4700  sub scan_data { Line 4940  sub scan_data {
     return $scan_data->{$filename.'_'.$key};      return $scan_data->{$filename.'_'.$key};
 }  }
   
   =pod 
   
   =item scantron_parse_scanline
   
     Decodes a scanline from the selected scantron file
   
    Arguments:
       line             - The text of the scantron file line to process
       whichline        - Line number
       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);      my $questions=substr($line,$$scantron_config{'Qstart'}-1);  # Answers
     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);      my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff
     if (!($$scantron_config{'CODElocation'} eq 0 ||      if (!($$scantron_config{'CODElocation'} eq 0 ||
   $$scantron_config{'CODElocation'} eq 'none')) {    $$scantron_config{'CODElocation'} eq 'none')) {
  if ($$scantron_config{'CODElocation'} < 0 ||   if ($$scantron_config{'CODElocation'} < 0 ||
Line 4734  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 4807  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 4815  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 4829  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 4845  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 4902  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 4919  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 4934  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 4947  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 4954  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 4986  $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 5017  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 5034  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 5117  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 5131  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 5153  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 5185  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 5194  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 5214  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 5222  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 5233  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 5243  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 5252  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 5268  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 5291  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 5353  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 5456  ENDSCRIPT Line 5919  ENDSCRIPT
  $r->print("<p>Please indicate which bubble should be used for grading</p>");   $r->print("<p>Please indicate which bubble should be used for grading</p>");
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     my $selected=$$scan_record{"scantron.$question.answer"};      my $selected=$$scan_record{"scantron.$question.answer"};
     &scantron_bubble_selector($r,$scan_config,$question,split('',$selected));      &scantron_bubble_selector($r,$scan_config,$question,
         split('',$selected));
  }   }
     } elsif ($error eq 'missingbubble') {      } elsif ($error eq 'missingbubble') {
  $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");   $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");
Line 5476  ENDSCRIPT Line 5940  ENDSCRIPT
   
 }  }
   
   =pod
   
   =item scantron_bubble_selector
     
      Generates the html radiobuttons to correct a single bubble line
      possibly showing the exisiting the selected bubbles if known
   
    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)=@_;      my ($r,$scan_config,$quest,@selected, $lines)=@_;
     my $max=$$scan_config{'Qlength'};      my $max=$$scan_config{'Qlength'};
   
     my $scmode=$$scan_config{'Qon'};      my $scmode=$$scan_config{'Qon'};
     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }           if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }     
   
     my @alphabet=('A'..'Z');  
     $r->print("<table border='1'><tr><td rowspan='2'>$quest</td>");      if (!defined($lines)) {
     for (my $i=0;$i<$max+1;$i++) {   $lines = 1;
  $r->print("\n".'<td align="center">');  
  if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }  
  else { $r->print('&nbsp;'); }  
  $r->print('</td>');  
     }  
     $r->print('</tr><tr>');  
     for (my $i=0;$i<$max;$i++) {  
  $r->print("\n".  
   '<td><label><input type="radio" name="scantron_correct_Q_'.  
   $quest.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");  
     }      }
     $r->print('<td><label><input type="radio" name="scantron_correct_Q_'.      my $total_lines = $lines*2;
       my @alphabet=('A'..'Z');
       $r->print("<table border='1'><tr><td rowspan='".$total_lines."'>$quest</td>");
   
       for (my $l = 0; $l < $lines; $l++) {
    if ($l != 0) {
       $r->print('<tr>');
    }
   
    # FIXME:  This loop probably has to be considerably more clever for
    #  multiline bubbles: User can multibubble by having bubbles in
    #  several lines.  User can skip lines legitimately etc. etc.
   
    for (my $i=0;$i<$max;$i++) {
       $r->print("\n".'<td align="center">');
       if ($selected[0] eq $alphabet[$i]) { 
    $r->print('X'); 
    shift(@selected) ;
       } else { 
    $r->print('&nbsp;'); 
       }
       $r->print('</td>');
       
    }
   
    if ($l == 0) {
       my $lspan = $total_lines * 2;   #  2 table rows per bubble line.
   
       $r->print('<td rowspan='.$lspan.'><label><input type="radio" name="scantron_correct_Q_'.
       $quest.'" value="none" /> No bubble </label></td>');        $quest.'" value="none" /> No bubble </label></td>');
     $r->print('</tr></table>');  
    }
   
    $r->print('</tr><tr>');
   
    # FIXME: This may have to be a bit more clever for
    #        multiline questions (different values e.g..).
   
    for (my $i=0;$i<$max;$i++) {
       $r->print("\n".
         '<td><label><input type="radio" name="scantron_correct_Q_'.
         $quest.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
    }
    $r->print('</tr>');
   
       
       }
       $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 5513  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 5523  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 5545  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 5596  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 5619  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 5645  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 5677  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 5781  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 5817  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 5872  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 5880  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 5916  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.421  
changed lines
  Added in v.1.423

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