--- loncom/homework/grades.pm 2007/06/15 22:10:15 1.407 +++ loncom/homework/grades.pm 2007/07/19 09:52:59 1.422 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.407 2007/06/15 22:10:15 albertel Exp $ +# $Id: grades.pm,v 1.422 2007/07/19 09:52:59 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -93,6 +93,7 @@ sub get_symb { return (); } } + &Apache::lonenc::check_decrypt(\$symb); return ($symb); } @@ -492,7 +493,7 @@ sub jscriptNform { ' }'."\n". ''."\n"; $jscript.= '
'."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -617,7 +618,7 @@ sub verifyreceipt { if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { $contents.=' '."\n". ''.$$fullname{$_}.' '."\n". + '\');" target="_self">'.$$fullname{$_}.' '."\n". ' '.$uname.' '. ' '.$udom.' '; if ($receiptparts) { @@ -742,7 +743,7 @@ LISTJAVASCRIPT '
'."\n". ''."\n". ''."\n". - ''."\n". + ''."\n". ''."\n"; if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { @@ -1751,7 +1752,7 @@ sub submission { ''."\n". ''."\n". ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -1792,10 +1793,10 @@ sub submission { # $request->print(<Keyword Options:  -List    +List    Paste Selection to List    -Highlight Attribute

+Highlight Attribute

KEYWORDS # # Load the other essays for similarity check @@ -1921,7 +1922,7 @@ KEYWORDS ' Collaborative submission by: '. ''. + '\');" target="_self">'. $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'
'; $request->print($submitby); next; @@ -1999,7 +2000,7 @@ KEYWORDS if ($env{'form.showgrading'} eq '' || (!&canmodify($usec))) { my $toGrade.='  '."\n" if (&canmodify($usec)); + .$counter.'\');" target="_self" />  '."\n" if (&canmodify($usec)); $toGrade.=''."\n"; if (($env{'form.command'} eq 'submission') || ($env{'form.command'} eq 'processGroup' && $counter == $total)) { @@ -2023,7 +2024,7 @@ KEYWORDS $result=''."\n". ''."\n"; $result.=' '. + ',\''.$msgfor.'\');" target="_self">'. &mt('Compose message to student').(scalar(@col_fullnames) >= 1 ? 's' : '').')'. ''."\n"; $endform.='  '."\n"; + $total.','.scalar(@partlist).');" target="_self" />  '."\n"; my $ntstu ='  '; + 'onClick="javascript:checksubmit(this.form,\'Next\');" target="_self" />  '; $endform.='(Next and Previous (student) do not save the scores.)'."\n" ; $endform.=""; @@ -2168,18 +2169,10 @@ sub processHandGrade { } my $includemsg = $env{'form.includemsg'.$ctr}; 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; - } + my $restitle = &Apache::lonnet::gettitle($symb); + my ($feedurl,$showsymb) = + &get_feedurl_and_symb($symb,$uname,$udom); + my $messagetail; if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } @@ -2192,12 +2185,12 @@ sub processHandGrade { if ($env{'form.withgrades'.$ctr}) { $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; $messagetail = " for $env{'form.probTitle'}"; + $feedurl."?symb=$showsymb\">$env{'form.probTitle'}"; } $msgstatus = &Apache::lonmsg::user_normal_msg($uname,$udom,$subject, $message.$messagetail, - undef,$baseurl,undef, + undef,$feedurl,undef, undef,undef,$showsymb, $restitle); $request->print('
'.&mt('Sending message to [_1]:[_2]',$uname,$udom).': '. @@ -2214,26 +2207,16 @@ sub processHandGrade { if ($errorflag eq 'not_allowed') { $request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom").""); next; - } else { - if ($message ne '') { - $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 $env{'form.probTitle'}"; - - } - $msgstatus = - &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); } + $msgstatus = + &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); } } } @@ -2587,28 +2570,31 @@ sub handback_files { $message .= "".&Apache::lonnet::gettitle($symb)."
"; $message .= ' The returned file(s) are named: '. $file_msg; $message .= " and can be found in your portfolio space."; - my $url = (&Apache::lonnet::decode_symb($symb))[2]; - my $feedurl = &Apache::lonnet::clutter($url); - my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', - $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 ($feedurl,$showsymb) = + &get_feedurl_and_symb($symb,$domain,$stuname); 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); + $feedurl,undef,undef,undef,$showsymb,$restitle); } } return; } +sub get_feedurl_and_symb { + my ($symb,$uname,$udom) = @_; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + $url = &Apache::lonnet::clutter($url); + my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$udom,$uname); + if ($encrypturl =~ /^yes$/i) { + &Apache::lonenc::encrypted(\$url,1); + &Apache::lonenc::encrypted(\$symb,1); + } + return ($url,$symb); +} + sub get_submitted_files { my ($udom,$uname,$partid,$respid,$record) = @_; my @files; @@ -2969,7 +2955,7 @@ sub viewgrades { #beginning of class grading form $result.= ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -3036,7 +3022,7 @@ sub viewgrades { $result.=''.''.''."\n". ''; $result.=''; + 'onClick="javascript:resetEntry('.$ctsparts.');" target="_self" />'; #table listing all the students in a section/class #header of table @@ -3087,7 +3073,7 @@ sub viewgrades { $result.=''; $result.=''."\n"; $result.=''."\n"; + 'onClick="javascript:submit();" target="_self" />'."\n"; if (scalar(%$fullname) eq 0) { my $colspan=3+scalar(@parts); $result='There are no students in section "'.$env{'form.section'}. @@ -3107,7 +3093,7 @@ sub viewstudentgrade { ''. "\n".$ctr.'  '. ''.$fullname.' '. + '\');" target="_self">'.$fullname.' '. '('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')'."\n"; $student=~s/:/_/; # colon doen't work in javascript for names foreach my $apart (@$parts) { @@ -3471,6 +3457,7 @@ sub csvuploadmap_header { my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); my $checked=(($env{'form.noFirstLine'})?' checked="checked"':''); my $ignore=&mt('Ignore First Line'); + $symb = &Apache::lonenc::check_encrypt($symb); $request->print(<

Uploading Class Grades

@@ -3565,6 +3552,7 @@ sub upcsvScores_form { my $upload=&mt("Upload Scores"); my $upfile_select=&Apache::loncommon::upfile_select_html(); my $ignore=&mt('Ignore First Line'); + $symb = &Apache::lonenc::check_encrypt($symb); $result.=< @@ -3873,7 +3861,7 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n". ''."\n". - ''."\n". + ''."\n". ''."
\n"; $result.=' '.&mt('Use CODE:').' '. @@ -3997,7 +3985,7 @@ sub displayPage { ''."\n". ''."\n". ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n"; @@ -4366,14 +4354,18 @@ sub updateGradeByPage { # #------ start of section for handling grading by page/sequence --------- +# Create the hidden field entries used to hold context/default values. + sub defaultFormData { my ($symb)=@_; return ' - '."\n". + '."\n". ''."\n". ''."\n"; } +# Make a drop down of the sequences + sub getSequenceDropDown { my ($request,$symb)=@_; my $result=''; @@ -4417,6 +4414,9 @@ sub scantron_uploads { return $result; } +# Returns the html for a drop down list of the scantron formats in the +# scantronformat.tab file. + sub scantron_scantab { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result=''; return $result; } +# +# Display the first scantron file selection form. +# Paramters: +# r - The apache request object +# file2grade - The name of the scantron file to be graded(?). sub scantron_selectphase { my ($r,$file2grade) = @_; @@ -4471,6 +4481,9 @@ sub scantron_selectphase { 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.= < @@ -4523,6 +4536,8 @@ SCANTRONFORM if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { + # Chunk of form to prompt for a scantron file upload. + $r->print(< @@ -4568,6 +4583,10 @@ UPLOAD SCANTRONFORM } + + # Chunk of the form that prompts to view a scoring office file, + # corrected file, skipped records in a file. + $r->print(<
@@ -4602,6 +4621,14 @@ SCANTRONFORM return } +# Parse and return the scantron configuration line selected as a +# hash of configuration file fields. +# +# Parameters: +# which - the name of the configuration to parse from the file. +# If the named configuration is not in the file, an empty +# hash is returned. + sub get_scantron_config { my ($which) = @_; my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); @@ -4634,6 +4661,15 @@ sub get_scantron_config { return %config; } +# creates a hash keyed by student id that conains +# the corresponding student username:domain. +# Parameters: +# 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). +# +# sub username_to_idmap { my ($classlist)= @_; my %idmap; @@ -4643,9 +4679,22 @@ sub username_to_idmap { } return %idmap; } +# +# Make a correction in a scantron line? +# Parameters: +# scantron_config - Format of the scantron file +# scan_data - Hash of line by line info about the scan(?). +# line - Scantron line to edit? +# whichline +# field +# args - Keyword/value hash of additional parameters. +# sub scantron_fixup_scanline { 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 (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { return ($line,1,'New value too large'); @@ -4660,6 +4709,11 @@ sub scantron_fixup_scanline { &scan_data($scan_data,"$whichline.user", $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') { if ($args->{'CODE_ignore_dup'}) { &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); @@ -4675,6 +4729,11 @@ sub scantron_fixup_scanline { substr($line,$$scantron_config{'CODEstart'}-1, $$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') { my $length=$scantron_config->{'Qlength'}; my $off=$scantron_config->{'Qoff'}; @@ -4701,7 +4760,16 @@ sub scantron_fixup_scanline { } return $line; } - +# Edit or look up an item in the scan_data hash. +# Parameters: +# scan_data - The hash. +# key - shorthand of the key to edit (actual key is +# scatronfilename_key. +# data - New value of the hash entry. +# delete - If defined, the entry is removed from the table. +# Returns: +# The new value of the hash table field (undefined if deleted). +# sub scan_data { my ($scan_data,$key,$value,$delete)=@_; my $filename=$env{'form.scantron_selectfile'}; @@ -4711,12 +4779,23 @@ sub scan_data { if ($delete) { delete($scan_data->{$filename.'_'.$key}); } return $scan_data->{$filename.'_'.$key}; } - +# +# Decode a line on the uploaded 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 being built up of the entire scantron file. +# justHeader - True if should not process question answers but only +# the stuff to the left of the answers. +# Returns: +# Hash of data from the line? +# sub scantron_parse_scanline { my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_; my %record; - my $questions=substr($line,$$scantron_config{'Qstart'}-1); - my $data=substr($line,0,$$scantron_config{'Qstart'}-1); + my $questions=substr($line,$$scantron_config{'Qstart'}-1); # Answers + my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff if (!($$scantron_config{'CODElocation'} eq 0 || $$scantron_config{'CODElocation'} eq 'none')) { if ($$scantron_config{'CODElocation'} < 0 || @@ -5468,7 +5547,8 @@ ENDSCRIPT $r->print("

Please indicate which bubble should be used for grading

"); foreach my $question (@{$arg}) { 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') { $r->print("

There have been no bubbles scanned for some question(s)

\n"); @@ -5487,31 +5567,74 @@ ENDSCRIPT $r->print("\n"); } - +# +# Ask the grader to select the actual bubble +# +# Arguments: +# r - Apache request. +# scan_config - Hash of the scantron format selected. +# quest - Question being evaluated +# selected - array of selected bubbles +# lines - if present, number of bubble lines in questions. sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected)=@_; + my ($r,$scan_config,$quest,@selected, $lines)=@_; my $max=$$scan_config{'Qlength'}; my $scmode=$$scan_config{'Qon'}; if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } - my @alphabet=('A'..'Z'); - $r->print(""); - for (my $i=0;$i<$max+1;$i++) { - $r->print("\n".''); - } - $r->print(''); - for (my $i=0;$i<$max;$i++) { - $r->print("\n". - '"); + + if (!defined($lines)) { + $lines = 1; } - $r->print('"); + + for (my $l = 0; $l < $lines; $l++) { + if ($l != 0) { + $r->print(''); + } + + # 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".''); + + } + + if ($l == 0) { + my $lspan = $total_lines * 2; # 2 table rows per bubble line. + + $r->print(''); - $r->print('
$quest'); - if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } - else { $r->print(' '); } - $r->print('
$quest
'); + if ($selected[0] eq $alphabet[$i]) { + $r->print('X'); + shift(@selected) ; + } else { + $r->print(' '); + } + $r->print('
'); + + } + + $r->print(''); + + # 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". + '"); + } + $r->print(''); + + + } + $r->print(''); } sub num_matches { @@ -5938,7 +6061,7 @@ DOWNLOAD sub show_grading_menu_form { my ($symb)=@_; my $result.='
'."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -6013,7 +6136,7 @@ GRADINGMENUJS my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); $result.=''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -6129,7 +6252,7 @@ sub init_perm { } sub gather_clicker_ids { - my %clicker_ids=(); + my %clicker_ids; my $classlist = &Apache::loncoursedata::get_classlist(); @@ -6142,13 +6265,14 @@ sub gather_clicker_ids { my $username = $classlist->{$student}->[$username_idx]; my $domain = $classlist->{$student}->[$domain_idx]; my $clickers = - (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; + (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; foreach my $id (split(/\,/,$clickers)) { - $id=~s/^0+//; + $id=~s/^[\#0]+//; + $id=~s/[\-\:]//g; if (exists($clicker_ids{$id})) { - $clicker_ids{$id}.=','.$username.':'.$domain; + $clicker_ids{$id}.=','.$username.':'.$domain; } else { - $clicker_ids{$id}=$username.':'.$domain; + $clicker_ids{$id}=$username.':'.$domain; } } } @@ -6156,28 +6280,37 @@ sub gather_clicker_ids { } sub gather_adv_clicker_ids { - my %clicker_ids=(); + my %clicker_ids; my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); - foreach my $element (sort keys %coursepersonnel) { + foreach my $element (sort(keys(%coursepersonnel))) { foreach my $person (split(/\,/,$coursepersonnel{$element})) { my ($puname,$pudom)=split(/\:/,$person); my $clickers = - (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; + (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; foreach my $id (split(/\,/,$clickers)) { - $id=~s/^0+//; - if (exists($clicker_ids{$id})) { - $clicker_ids{$id}.=','.$puname.':'.$pudom; - } else { - $clicker_ids{$id}=$puname.':'.$pudom; - } + $id=~s/^[\#0]+//; + $id=~s/[\-\:]//g; + if (exists($clicker_ids{$id})) { + $clicker_ids{$id}.=','.$puname.':'.$pudom; + } else { + $clicker_ids{$id}=$puname.':'.$pudom; + } } } } return %clicker_ids; } +sub clicker_grading_parameters { + return ('gradingmechanism' => 'scalar', + 'upfiletype' => 'scalar', + 'specificid' => 'scalar', + 'pcorrect' => 'scalar', + 'pincorrect' => 'scalar'); +} + sub process_clicker { my ($r)=@_; my ($symb)=&get_symb($r); @@ -6191,16 +6324,33 @@ sub process_clicker { $result.=' '.&mt('Specify a file containing the clicker information for this resource'). '.'."\n"; $result.=''."\n"; +# Attempt to restore parameters from last session, set defaults if not present + my %Saveable_Parameters=&clicker_grading_parameters(); + &Apache::loncommon::restore_course_settings('grades_clicker', + \%Saveable_Parameters); + if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; } + if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; } + if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; } + if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; } + + my %checked; + foreach my $gradingmechanism ('attendance','personnel','specific') { + if ($env{'form.gradingmechanism'} eq $gradingmechanism) { + $checked{$gradingmechanism}="checked='checked'"; + } + } + my $upload=&mt("Upload File"); my $type=&mt("Type"); my $attendance=&mt("Award points just for participation"); my $personnel=&mt("Correctness determined from response by course personnel"); - my $specific=&mt("Correctness determined from response with clicker ID"); + my $specific=&mt("Correctness determined from response with clicker ID(s)"); my $pcorrect=&mt("Percentage points for correct solution"); my $pincorrect=&mt("Percentage points for incorrect solution"); - my $selectform=&Apache::loncommon::select_form('iclicker','upfiletype', - ('iclicker' => 'i>clicker')); - + my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', + ('iclicker' => 'i>clicker', + 'interwrite' => 'interwrite PRS')); + $symb = &Apache::lonenc::check_encrypt($symb); $result.=< function sanitycheck() { @@ -6248,13 +6398,13 @@ function sanitycheck() {
-
-
-
- - -
-
+
+
+
+ + +
+

ENDUPFORM @@ -6268,43 +6418,52 @@ sub process_clicker_file { my ($r)=@_; my ($symb)=&get_symb($r); if (!$symb) {return '';} + + my %Saveable_Parameters=&clicker_grading_parameters(); + &Apache::loncommon::store_course_settings('grades_clicker', + \%Saveable_Parameters); + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { - $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; - return $result.&show_grading_menu_form($symb); + $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; + return $result.&show_grading_menu_form($symb); } my %clicker_ids=&gather_clicker_ids(); - my %correct_ids=(); + my %correct_ids; if ($env{'form.gradingmechanism'} eq 'personnel') { - %correct_ids=&gather_adv_clicker_ids(); + %correct_ids=&gather_adv_clicker_ids(); } if ($env{'form.gradingmechanism'} eq 'specific') { - my $correct_id=$env{'form.specificid'}; - $correct_id=~tr/a-z/A-Z/; - $correct_id=~s/\s//gs; - $correct_id=~s/^0+//; - $correct_ids{$correct_id}='specified'; + foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; + $correct_id=~tr/a-z/A-Z/; + $correct_id=~s/\s//gs; + $correct_id=~s/^[\#0]+//; + $correct_id=~s/[\-\:]//g; + if ($correct_id) { + $correct_ids{$correct_id}='specified'; + } + } } if ($env{'form.gradingmechanism'} eq 'attendance') { - $result.=&mt('Score based on attendance only'); + $result.=&mt('Score based on attendance only'); } else { - my $number=0; - $result.='

'.&mt('Correctness determined by the following IDs').'

'; - foreach my $id (sort(keys(%correct_ids))) { - $result.=''.$id.' - '; - if ($correct_ids{$id} eq 'specified') { - $result.=&mt('specified'); - } else { - my ($uname,$udom)=split(/\:/,$correct_ids{$id}); - $result.=&Apache::loncommon::plainname($uname,$udom); - } - $result.='
'; - $number++; - } - if ($number==0) { - $result.=''.&mt('No IDs found to determine correct answer').''; - return $result.&show_grading_menu_form($symb); - } + my $number=0; + $result.='

'.&mt('Correctness determined by the following IDs').''; + foreach my $id (sort(keys(%correct_ids))) { + $result.='
'.$id.' - '; + if ($correct_ids{$id} eq 'specified') { + $result.=&mt('specified'); + } else { + my ($uname,$udom)=split(/\:/,$correct_ids{$id}); + $result.=&Apache::loncommon::plainname($uname,$udom); + } + $number++; + } + $result.="

\n"; + if ($number==0) { + $result.=''.&mt('No IDs found to determine correct answer').''; + return $result.&show_grading_menu_form($symb); + } } if (length($env{'form.upfile'}) < 2) { $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.', @@ -6313,17 +6472,84 @@ sub process_clicker_file { ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''); return $result.&show_grading_menu_form($symb); } - my %responses=(); - my @questiontitles=(); + +# Were able to get all the info needed, now analyze the file + + $result.=&Apache::loncommon::studentbrowser_javascript(); + $symb = &Apache::lonenc::check_encrypt($symb); + my $heading=&mt('Scanning clicker file'); + $result.=(<
+
+$heading
+
+ + + + + + + +ENDHEADER + my %responses; + my @questiontitles; my $errormsg=''; my $number=0; if ($env{'form.upfiletype'} eq 'iclicker') { - ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); + ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); } - $result.='
'.&mt('Found [_1] questions',$number).'
'; - foreach my $id (keys %responses) { - $result.='
'.$id.' - '.$responses{$id}; + if ($env{'form.upfiletype'} eq 'interwrite') { + ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); + } + $result.='
'.&mt('Found [_1] question(s)',$number).'
'. + ''. + &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', + $env{'form.pcorrect'},$env{'form.pincorrect'}). + '
'; +# Remember Question Titles +# FIXME: Possibly need delimiter other than ":" + for (my $i=0;$i<$number;$i++) { + $result.='').'" />'; + } + my $correct_count=0; + my $student_count=0; + my $unknown_count=0; +# Match answers with usernames +# FIXME: Possibly need delimiter other than ":" + foreach my $id (keys(%responses)) { + if ($correct_ids{$id}) { + $result.="\n".''; + $correct_count++; + } elsif ($clicker_ids{$id}) { + $result.="\n".''; + $student_count++; + } else { + $result.="\n
".&mt('Unregistered Clicker')." ".$id."
"; + $result.="\n".''. + "\n".&mt("Username").":  ". + "\n".&mt("Domain").": ". + &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. + &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id); + $unknown_count++; + } + } + $result.='
'. + &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); + if ($env{'form.gradingmechanism'} ne 'attendance') { + if ($correct_count==0) { + $errormsg.="Found no correct answers answers for grading!"; + } elsif ($correct_count>1) { + $result.='
'.&mt("Found [_1] entries for grading!",$correct_count).''; + } } + if ($errormsg) { + $result.='
'.&mt($errormsg).''; + } else { + $result.='
'; + } + $result.='
'."\n". + '


'."\n"; return $result.&show_grading_menu_form($symb); } @@ -6332,32 +6558,159 @@ sub iclicker_eval { my $number=0; my $errormsg=''; foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { - chomp($line); - foreach my $quoted ($line=~/\,\s*\"([^\"]*)\"\s*\,/g) { - my $replace=$quoted; - $replace=~s/\,//g; - &Apache::lonnet::logthis($quoted.' - '.$replace.'
'); - $line=~s/\,\s*\"\Q$quoted\E\"\s*\,/,$replace,/gs; + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[0] eq 'Question') { + for (my $i=3;$i<$#entries;$i+=6) { + $$questiontitles[$number]=$entries[$i]; + $number++; + } + } + if ($entries[0]=~/^\#/) { + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + for (my $i=0;$i<$number;$i++) { + my $idx=3+$i*6; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + } + return ($errormsg,$number); +} + +sub interwrite_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + my $skipline=1; + my $questionnumber=0; + my %idresponses=(); + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[1] eq 'Time') { $skipline=0; next; } + if ($entries[1] eq 'Response') { $skipline=1; } + next if $skipline; + if ($entries[0]!=$questionnumber) { + $questionnumber=$entries[0]; + $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); + $number++; + } + my $id=$entries[4]; + $id=~s/^[\#0]+//; + $id=~s/^v\d*\://i; + $id=~s/[\-\:]//g; + $idresponses{$id}[$number]=$entries[6]; + } + foreach my $id (keys %idresponses) { + $$responses{$id}=join(',',@{$idresponses{$id}}); + $$responses{$id}=~s/^\s*\,//; + } + return ($errormsg,$number); +} + +sub assign_clicker_grades { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} +# See which part we are saving to + my ($partlist,$handgrade,$responseType) = &response_type($symb); +# FIXME: This should probably look for the first handgradeable part + my $part=$$partlist[0]; +# Start screen output + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + + my $heading=&mt('Assigning grades based on clicker file'); + $result.=(<
+
+$heading
+ENDHEADER +# Get correct result +# FIXME: Possibly need delimiter other than ":" + my @correct=(); + my $gradingmechanism=$env{'form.gradingmechanism'}; + my $number=$env{'form.number'}; + if ($gradingmechanism ne 'attendance') { + foreach my $key (keys(%env)) { + if ($key=~/^form\.correct\:/) { + my @input=split(/\,/,$env{$key}); + for (my $i=0;$i<=$#input;$i++) { + if (($correct[$i]) && ($input[$i]) && + ($correct[$i] ne $input[$i])) { + $result.='
'. + &mt('More than one correct result given for question "[_1]": [_2] versus [_3].', + $env{'form.question:'.$i},$correct[$i],$input[$i]).''; + } elsif ($input[$i]) { + $correct[$i]=$input[$i]; + } + } + } + } + for (my $i=0;$i<$number;$i++) { + if (!$correct[$i]) { + $result.='
'. + &mt('No correct result given for question "[_1]"!', + $env{'form.question:'.$i}).''; + } + } + $result.='
'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct)); + } +# Start grading + my $pcorrect=$env{'form.pcorrect'}; + my $pincorrect=$env{'form.pincorrect'}; + my $storecount=0; + foreach my $key (keys(%env)) { + my $user=''; + if ($key=~/^form\.student\:(.*)$/) { + $user=$1; } - my @entries=split(/\,/,$line); - if ($entries[0] eq 'Question') { - for (my $i=3;$i<$#entries;$i+=6) { - $$questiontitles[$number]=$entries[$i]; - $number++; + if ($key=~/^form\.unknown\:(.*)$/) { + my $id=$1; + if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) { + $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id}; } } - if ($entries[0]=~/^\#/) { - my $id=$entries[0]; - my @idresponses=(); - $id=~s/^[\#0]+//; + if ($user) { + my @answer=split(/\,/,$env{$key}); + my $sum=0; for (my $i=0;$i<$number;$i++) { - my $idx=3+$i*6; - push(@idresponses,$entries[$idx]); + if ($answer[$i]) { + if ($gradingmechanism eq 'attendance') { + $sum+=$pcorrect; + } else { + if ($answer[$i] eq $correct[$i]) { + $sum+=$pcorrect; + } else { + $sum+=$pincorrect; + } + } + } + } + my $ave=$sum/(100*$number); +# Store + my ($username,$domain)=split(/\:/,$user); + my %grades=(); + $grades{"resource.$part.solved"}='correct_by_override'; + $grades{"resource.$part.awarded"}=$ave; + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $returncode=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($returncode ne 'ok') { + $result.="
Failed to save student $username:$domain. Message when trying to save was ($returncode)"; + } else { + $storecount++; } - $$responses{$id}=join(',',@idresponses); } } - return ($errormsg,$number); +# We are done + $result.='
'.&mt('Successfully stored grades for [_1] student(s).',$storecount). + '
'."\n". + '


'."\n"; + return $result.&show_grading_menu_form($symb); } sub handler { @@ -6431,6 +6784,8 @@ sub handler { $request->print(&process_clicker($request)); } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { $request->print(&process_clicker_file($request)); + } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { + $request->print(&assign_clicker_grades($request)); } elsif ($command eq 'csvform' && $perm{'mgr'}) { $request->print(&upcsvScores_form($request)); } elsif ($command eq 'csvupload' && $perm{'mgr'}) {