';
+ }
+ return $result;
+}
+
+}
+
+sub showallfoils {
+ if (defined($env{'form.showallfoils'})) {
+ my ($symb)=&Apache::lonnet::whichuser();
+ if (($env{'request.state'} eq 'construct') ||
+ ($env{'user.adv'} && $symb eq '') ||
+ ($Apache::lonhomework::viewgrades) ) {
+ return 1;
+ }
+ }
+ if ($Apache::lonhomework::type eq 'survey') { return 1; }
+ return 0;
+}
+
+=pod
+
+=item &getresponse($offset,$resulttype);
+
+Retreives the current submitted response, helps out in the case of
+scantron mode.
+
+Returns either the exact text of the submission, or a bubbled response
+converted to something usable.
+
+Optional Arguments:
+ $offset - (defaults to 1) if a problem has more than one bubble
+ response, pass in the number of the bubble wanted, (the
+ first bubble associated with a problem has an offset of 1,
+ the second bubble is 2
+
+ $resulttype - undef -> a number between 0 and 25
+ 'A is 1' -> a number between 1 and 26
+ 'letter' -> a letter between 'A' and 'Z'
+ $lines - undef problem only needs a single line of bubbles.
+ nonzero Problem wants the first nonempty response in
+ $lines lines of bubbles.
+ $bubbles_per_line - Must be provided if lines is defined.. number of
+ bubbles on a line.
+
+=cut
+
+sub getresponse {
+ my ($offset,$resulttype, $lines, $bubbles_per_line)=@_;
+ my $formparm='form.HWVAL_'.$Apache::inputtags::response['-1'];
+ my $response;
+ if (!defined($offset)) {
+ $offset=1;
+ } else {
+ $formparm.=":$offset";
+ }
+ if (!defined($lines)) {
+ $lines = 1;
+ }
+ my %let_to_num=('A'=>0,'B'=>1,'C'=>2,'D'=>3,'E'=>4,'F'=>5,'G'=>6,'H'=>7,
+ 'I'=>8,'J'=>9,'K'=>10,'L'=>11,'M'=>12,'N'=>13,'O'=>14,
+ 'P'=>15,'Q'=>16,'R'=>17,'S'=>18,'T'=>19,'U'=>20,'V'=>21,
+ 'W'=>22,'X'=>23,'Y'=>24,'Z'=>25);
+ if ($env{'form.submitted'} eq 'scantron') {
+ my $part = $Apache::inputtags::part;
+ my $id = $Apache::inputtags::response[-1];
+
+ my $line;
+ for ($line = 0; $line < $lines; $line++) {
+ my $theline = $Apache::lonxml::counter+$offset-1+$line;
+ $response = $env{"scantron.$theline.answer"};
+ if ((defined($response)) && ($response ne "") && ($response ne " ")) {
+ last;
+ }
+
+ }
+
+ # save bubbled letter for later
+ $Apache::lonhomework::results{"resource.$part.$id.scantron"}.=
+ $response;
+ if ($resulttype ne 'letter') {
+ if ($resulttype eq 'A is 1') {
+ $response = $let_to_num{$response}+1;
+ } else {
+ $response = $let_to_num{$response};
+ }
+ if ($response ne "") {
+ $response += $line * $bubbles_per_line;
+ }
+ } else {
+ if ($response ne "") {
+ $response = chr(ord($response) + $line * $bubbles_per_line);
+ }
+ }
+
+ } else {
+ $response = $env{$formparm};
+ }
+ #
+ # If we have a nonempty answer, correct the numeric value
+ # of the answer for the line on which it was found.
+ #
+
+ return $response;
+}
+
+=pod
+
+=item &repetition();
+
+Returns the number of lines that are required to encode the weight.
+(Currently expects that there are 10 bubbles per line)
+
+=cut
+
+sub repetition {
+ my $id = $Apache::inputtags::part;
+ my $weight = &Apache::lonnet::EXT("resource.$id.weight");
+ if (!defined($weight) || ($weight eq '')) { $weight=1; }
+ my $repetition = int($weight/10);
+ if ($weight % 10 != 0) { $repetition++; }
+ return $repetition;
+}
+
+=pod
+
+=item &scored_response($part_id,$response_id);
+
+Sets the results hash elements
+
+ resource.$part_id.$response_id.awarded - to the floating point
+ number between 0 and 1 that was awarded on the bubbled input
+
+ resource.$part_id.$response_id.awarddetail - to 'ASSIGNED_SCORE'
+
+Returns
+
+ the number of bubble sheet lines that were used (and likely need to
+ be passed to &Apache::lonxml::increment_counter()
+
+Arguments
+
+ $part_id - id of the part to grade
+ $response_id - id of the response to grade
+
+
+=cut
+
+sub scored_response {
+ my ($part,$id)=@_;
+ my $repetition=&repetition();
+ my $score=0;
+ for (my $i=0;$i<$repetition;$i++) {
+ # A is 1, B is 2, etc. (get response return 0-9 and then we add 1)
+ my $increase=&Apache::response::getresponse($i+1);
+ if ($increase ne '') { $score+=$increase+1; }
+ }
+ my $weight = &Apache::lonnet::EXT("resource.$part.weight");
+ if (!defined($weight) || $weight eq '' || $weight eq 0) { $weight = 1; }
+ my $pcr=$score/$weight;
+ $Apache::lonhomework::results{"resource.$part.$id.awarded"}=$pcr;
+ $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=
+ 'ASSIGNED_SCORE';
+ return $repetition;
+}
+
+sub whichorder {
+ my ($max,$randomize,$showall,$hash)=@_;
+ #&Apache::lonxml::debug("man $max randomize $randomize");
+ if (!defined(@{ $$hash{'names'} })) { return; }
+ my @names = @{ $$hash{'names'} };
+ my @whichopt =();
+ my (%top,@toplist,%bottom,@bottomlist);
+ if (!($showall || ($randomize eq 'no'))) {
+ my $current=0;
+ foreach my $name (@names) {
+ $current++;
+ if ($$hash{"$name.location"} eq 'top') {
+ $top{$name}=$current;
+ } elsif ($$hash{"$name.location"} eq 'bottom') {
+ $bottom{$name}=$current;
+ }
+ }
+ }
+ my $topcount=0;
+ my $bottomcount=0;
+ while (((scalar(@whichopt)+$topcount+$bottomcount) < $max || $showall)
+ && ($#names > -1)) {
+ #&Apache::lonxml::debug("Have $#whichopt max is $max");
+ my $aopt;
+ if ($showall || ($randomize eq 'no')) {
+ $aopt=0;
+ } else {
+ $aopt=int(&Math::Random::random_uniform() * ($#names+1));
+ }
+ #&Apache::lonxml::debug("From $#whichopt $max $#names elms, picking $aopt");
+ $aopt=splice(@names,$aopt,1);
+ #&Apache::lonxml::debug("Picked $aopt");
+ if ($top{$aopt}) {
+ $toplist[$top{$aopt}]=$aopt;
+ $topcount++;
+ } elsif ($bottom{$aopt}) {
+ $bottomlist[$bottom{$aopt}]=$aopt;
+ $bottomcount++;
+ } else {
+ push (@whichopt,$aopt);
+ }
+ }
+ for (my $i=0;$i<=$#toplist;$i++) {
+ if ($toplist[$i]) { unshift(@whichopt,$toplist[$i]) }
+ }
+ for (my $i=0;$i<=$#bottomlist;$i++) {
+ if ($bottomlist[$i]) { push(@whichopt,$bottomlist[$i]) }
+ }
+ return @whichopt;
+}
+
+sub show_answer {
+ my $part = $Apache::inputtags::part;
+ my $award = $Apache::lonhomework::history{"resource.$part.solved"};
+ my $status = $Apache::inputtags::status[-1];
+ return ( ($award =~ /^correct/
+ && &Apache::lonhomework::show_problem_status())
+ || $status eq "SHOW_ANSWER");
+}
+
+sub analyze_store_foilgroup {
+ my ($shown,$attrs)=@_;
+ my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]";
+ foreach my $name (@{ $Apache::response::foilgroup{'names'} }) {
+ if (defined($Apache::lonhomework::analyze{"$part_id.foil.value.$name"})) { next; }
+ push (@{ $Apache::lonhomework::analyze{"$part_id.foils"} },$name);
+ foreach my $attr (@$attrs) {
+ $Apache::lonhomework::analyze{"$part_id.foil.".$attr.".$name"} =
+ $Apache::response::foilgroup{"$name.".$attr};
+ }
+ }
+ push (@{ $Apache::lonhomework::analyze{"$part_id.shown"} }, @{ $shown });
+}
+
+sub check_if_computed {
+ my ($token,$parstack,$safeeval,$name)=@_;
+ my $value = &Apache::lonxml::get_param($name,$parstack,$safeeval);
+ if (ref($token->[2]) eq 'HASH' && $value ne $token->[2]{$name}) {
+ my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]";
+ $Apache::lonhomework::analyze{"$part_id.answercomputed"} = 1;
+ }
+}
+
+sub pick_foil_for_concept {
+ my ($target,$attrs,$hinthash,$parstack,$safeeval)=@_;
+ if (not defined(@{ $Apache::response::conceptgroup{'names'} })) { return; }
+ my @names = @{ $Apache::response::conceptgroup{'names'} };
+ my $pick=int(&Math::Random::random_uniform() * ($#names+1));
+ my $name=$names[$pick];
+ push @{ $Apache::response::foilgroup{'names'} }, $name;
+ foreach my $attr (@$attrs) {
+ $Apache::response::foilgroup{"$name.".$attr} =
+ $Apache::response::conceptgroup{"$name.".$attr};
+ }
+ my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
+ $Apache::response::foilgroup{"$name.concept"} = $concept;
+ &Apache::lonxml::debug("Selecting $name in $concept");
+ my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]";
+ if ($target eq 'analyze') {
+ push (@{ $Apache::lonhomework::analyze{"$part_id.concepts"} },
+ $concept);
+ $Apache::lonhomework::analyze{"$part_id.concept.$concept"}=
+ $Apache::response::conceptgroup{'names'};
+ foreach my $name (@{ $Apache::response::conceptgroup{'names'} }) {
+ push (@{ $Apache::lonhomework::analyze{"$part_id.foils"} },
+ $name);
+ foreach my $attr (@$attrs) {
+ $Apache::lonhomework::analyze{"$part_id.foil.$attr.$name"}=
+ $Apache::response::conceptgroup{"$name.$attr"};
+ }
+ }
+ }
+ push(@{ $hinthash->{"$part_id.concepts"} },$concept);
+ $hinthash->{"$part_id.concept.$concept"}=
+ $Apache::response::conceptgroup{'names'};
+
+}
+#------------------------------------------------------------
+#
+# Get a parameter associated with a problem.
+# Parameters:
+# $id - the id of the paramater, either a part id,
+# or a partid and responspe id joined by _
+# $name - Name of the parameter to fetch
+# $default - Default value for the paramter.
+#
+#
+#
+sub get_response_param {
+ my ($id,$name,$default)=@_;
+ my $parameter;
+ if ($env{'request.state'} eq 'construct' &&
+ defined($Apache::inputtags::params{$name})) {
+ $parameter=$Apache::inputtags::params{$name};
+ } else {
+ $parameter=&Apache::lonnet::EXT("resource.$id.$name");
+ }
+ if (!defined($parameter) || $parameter eq '') {
+ $parameter = $default;
+ }
+ return $parameter;
+}
+
+sub submitted {
+ my ($who)=@_;
+
+ # when scatron grading any submission is a submission
+ if ($env{'form.submitted'} eq 'scantron') { return 1; }
+ # if the caller only cared if this was a scantron submission
+ if ($who eq 'scantron') { return 0; }
+ # if the Submit Answer button for this particular part was pressed
+ my $partid=$Apache::inputtags::part;
+ if ($env{'form.submitted'} eq "part_$partid") {
+ return 1;
+ }
+ if ($env{'form.submitted'} eq "yes"
+ && defined($env{'form.submit_'.$partid})) {
+ return 1;
+ }
+ # Submit All button on a .page was pressed
+ if (defined($env{'form.all_submit'})) { return 1; }
+ # otherwise no submission occured
+ return 0;
+}
+
+sub add_to_gradingqueue {
+ my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
+ if ( $courseid eq ''
+ || $symb eq ''
+ || $env{'request.state'} eq 'construct'
+ || $Apache::lonhomework::type ne 'problem') {
+ return;
+ }
+
+ my %queue_info = ( 'type' => 'problem',
+ 'time' => time);
+
+ if (exists($Apache::lonhomework::history{"resource.0.checkedin.slot"})) {
+ $queue_info{'slot'}=
+ $Apache::lonhomework::history{"resource.0.checkedin.slot"};
+ }
+
+ my $result=&Apache::bridgetask::add_to_queue('gradingqueue',\%queue_info);
+ if ($result ne 'ok') {
+ &Apache::lonxml::error("add_to_queue said $result");
+ }
+}
+
+# basically undef and 0 (both false) mean that they still have work to do
+# and all true values mean that they can't do any more work
+#
+# a return of undef means it is unattempted
+# a return of 0 means it is attmpted and wrong but still has tries
+# a return of 1 means it is marked correct
+# a return of 2 means they have exceed maximum number of tries
+# a return of 3 means it after the answer date
+sub check_status {
+ my ($id)=@_;
+ if (!defined($id)) { $id=$Apache::inputtags::part; }
+ my $curtime=&Apache::lonnet::EXT('system.time');
+ my $opendate=&Apache::lonnet::EXT("resource.$id.opendate");
+ my $duedate=&Apache::lonnet::EXT("resource.$id.duedate");
+ my $answerdate=&Apache::lonnet::EXT("resource.$id.answerdate");
+ if ( $opendate && $curtime > $opendate &&
+ $duedate && $curtime > $duedate &&
+ $answerdate && $curtime > $answerdate) {
+ return 3;
+ }
+ my $status=&Apache::lonnet::EXT("user.resource.resource.$id.solved");
+ if ($status =~ /^correct/) { return 1; }
+ if (!$status) { return undef; }
+ my $maxtries=&Apache::lonnet::EXT("resource.$id.maxtries");
+ if ($maxtries eq '') { $maxtries=2; }
+ my $curtries=&Apache::lonnet::EXT("user.resource.resource.$id.tries");
+ if ($curtries < $maxtries) { return 0; }
+ return 2;
+}
+
+=pod
+
+=item setup_prior_tries_hash($func,$data)
+
+ Foreach each past .submission $func is called with 3 arguments
+ - the mode to set things up for (currently always 'grade')
+ - the stored .submission string
+ - The expansion of $data
+
+ $data is an array ref containing elements that are either
+ - scalars that are other elements of the history hash to pass to $func
+ - ref to data to be passed untouched to $func
+
+=cut
+
+sub setup_prior_tries_hash {
+ my ($func,$data) = @_;
+ my $part = $Apache::inputtags::part;
+ my $id = $Apache::inputtags::response[-1];
+ foreach my $i (1..$Apache::lonhomework::history{'version'}) {
+ my $sub_key = "$i:resource.$part.$id.submission";
+ next if (!exists($Apache::lonhomework::history{$sub_key}));
+ my @other_data;
+ foreach my $datum (@{ $data }) {
+ if (ref($datum)) {
+ push(@other_data,$datum);
+ } else {
+ my $info_key = "$i:resource.$part.$id.$datum";
+ push(@other_data,$Apache::lonhomework::history{$info_key});
+ }
+ }
+
+ my $output =
+ &$func('grade',
+ $Apache::lonhomework::history{$sub_key},
+ \@other_data);
+ if (defined($output)) {
+ $Apache::inputtags::submission_display{$sub_key} = $output;
+ }
+ }
}
1;