';
+ my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
+ keys(%{$record}));
+ foreach my $grade (sort(@grade)) {
+ my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
+ $result.= '
'.&mt("Dimension: [_1], status [_2] ",
+ $dim, $record->{$grade}).
+ '
';
+ }
+ $result.='
';
+ return $result;
+ }
+ } elsif ( $response =~ m/(?:numerical|formula)/) {
+ $answer =
+ &Apache::loncommon::format_previous_attempt_value('submission',
+ $answer);
+ }
+ return $answer;
+}
+
+#-- A couple of common js functions
+sub commonJSfunctions {
+ my $request = shift;
+ $request->print(<
+ function radioSelection(radioButton) {
+ var selection=null;
+ if (radioButton.length > 1) {
+ for (var i=0; i 1) {
+ for (var i=0; i
+COMMONJSFUNCTIONS
+}
+
+#--- Dumps the class list with usernames,list of sections,
+#--- section, ids and fullnames for each user.
+sub getclasslist {
+ my ($getsec,$filterlist,$getgroup) = @_;
+ my @getsec;
+ my @getgroup;
+ my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
+ if (!ref($getsec)) {
+ if ($getsec ne '' && $getsec ne 'all') {
+ @getsec=($getsec);
+ }
+ } else {
+ @getsec=@{$getsec};
+ }
+ if (grep(/^all$/,@getsec)) { undef(@getsec); }
+ if (!ref($getgroup)) {
+ if ($getgroup ne '' && $getgroup ne 'all') {
+ @getgroup=($getgroup);
+ }
+ } else {
+ @getgroup=@{$getgroup};
+ }
+ if (grep(/^all$/,@getgroup)) { undef(@getgroup); }
+
+ my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
+ # Bail out if we were unable to get the classlist
+ return if (! defined($classlist));
+ &Apache::loncoursedata::get_group_memberships($classlist,$keylist);
+ #
+ my %sections;
+ my %fullnames;
+ foreach my $student (keys(%$classlist)) {
+ my $end =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_END()];
+ my $start =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_START()];
+ my $id =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_ID()];
+ my $section =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
+ my $fullname =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()];
+ my $status =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()];
+ my $group =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
+ # filter students according to status selected
+ if ($filterlist && (!($stu_status =~ /Any/))) {
+ if (!($stu_status =~ $status)) {
+ delete($classlist->{$student});
+ next;
+ }
+ }
+ # filter students according to groups selected
+ my @stu_groups = split(/,/,$group);
+ if (@getgroup) {
+ my $exclude = 1;
+ foreach my $grp (@getgroup) {
+ foreach my $stu_group (@stu_groups) {
+ if ($stu_group eq $grp) {
+ $exclude = 0;
+ }
+ }
+ if (($grp eq 'none') && !$group) {
+ $exclude = 0;
+ }
+ }
+ if ($exclude) {
+ delete($classlist->{$student});
+ }
+ }
+ $section = ($section ne '' ? $section : 'none');
+ if (&canview($section)) {
+ if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {
+ $sections{$section}++;
+ if ($classlist->{$student}) {
+ $fullnames{$student}=$fullname;
+ }
+ } else {
+ delete($classlist->{$student});
+ }
+ } else {
+ delete($classlist->{$student});
+ }
+ }
+ my %seen = ();
+ my @sections = sort(keys(%sections));
+ return ($classlist,\@sections,\%fullnames);
+}
+
+sub canmodify {
+ my ($sec)=@_;
+ if ($perm{'mgr'}) {
+ if (!defined($perm{'mgr_section'})) {
+ # can modify whole class
+ return 1;
+ } else {
+ if ($sec eq $perm{'mgr_section'}) {
+ #can modify the requested section
+ return 1;
+ } else {
+ # can't modify the request section
+ return 0;
+ }
+ }
+ }
+ #can't modify
+ return 0;
+}
+
+sub canview {
+ my ($sec)=@_;
+ if ($perm{'vgr'}) {
+ if (!defined($perm{'vgr_section'})) {
+ # can modify whole class
+ return 1;
+ } else {
+ if ($sec eq $perm{'vgr_section'}) {
+ #can modify the requested section
+ return 1;
+ } else {
+ # can't modify the request section
+ return 0;
+ }
+ }
+ }
+ #can't modify
+ return 0;
+}
+
+#--- Retrieve the grade status of a student for all the parts
sub student_gradeStatus {
- my ($url,$udom,$uname,$partlist) = @_;
- my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
- my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
+ my ($symb,$udom,$uname,$partlist) = @_;
+ my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
my %partstatus = ();
foreach (@$partlist) {
- my ($status,$foo)=split(/_/,$record{"resource.$_.solved"},2);
- $status = 'nothing' if ($status eq '');
- $partstatus{$_} = $status;
- $partstatus{"resource.$_.submitted_by"} = $record{"resource.$_.submitted_by"}
- if ($record{"resource.$_.submitted_by"} ne '');
+ my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2);
+ $status = 'nothing' if ($status eq '');
+ $partstatus{$_} = $status;
+ my $subkey = "resource.$_.submitted_by";
+ $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne '');
}
return %partstatus;
}
-sub get_fullname {
- my ($uname,$udom) = @_;
- my %name=&Apache::lonnet::get('environment', ['lastname','generation',
- 'firstname','middlename'],$udom,$uname);
- my $fullname;
- my ($tmp) = keys(%name);
- if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- $fullname=$name{'lastname'}.$name{'generation'};
- if ($fullname =~ /[^\s]+/) { $fullname.=', '; }
- $fullname.=$name{'firstname'}.' '.$name{'middlename'};
- }
- return $fullname;
+# hidden form and javascript that calls the form
+# Use by verifyscript and viewgrades
+# Shows a student's view of problem and submission
+sub jscriptNform {
+ my ($symb) = @_;
+ my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
+ my $jscript=''."\n";
+ $jscript.= ''."\n";
+ return $jscript;
}
-sub response_type {
- my ($url) = shift;
- my $allkeys = &Apache::lonnet::metadata($url,'keys');
-# print "allkeys=>$allkeys ";
- my %seen = ();
- my (@partlist,%handgrade);
- foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
- if (/^\w+response_\d+.*/) {
- my ($responsetype,$part) = split(/_/,$_,2);
- my ($partid,$respid) = split(/_/,$part);
- $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no');
- next if ($seen{$partid} > 0);
- $seen{$partid}++;
- push @partlist,$partid;
+
+
+# Given the score (as a number [0-1] and the weight) what is the final
+# point value? This function will round to the nearest tenth, third,
+# or quarter if one of those is within the tolerance of .00001.
+sub compute_points {
+ my ($score, $weight) = @_;
+
+ my $tolerance = .00001;
+ my $points = $score * $weight;
+
+ # Check for nearness to 1/x.
+ my $check_for_nearness = sub {
+ my ($factor) = @_;
+ my $num = ($points * $factor) + $tolerance;
+ my $floored_num = floor($num);
+ if ($num - $floored_num < 2 * $tolerance * $factor) {
+ return $floored_num / $factor;
+ }
+ return $points;
+ };
+
+ $points = $check_for_nearness->(10);
+ $points = $check_for_nearness->(3);
+ $points = $check_for_nearness->(4);
+
+ return $points;
+}
+
+#------------------ End of general use routines --------------------
+
+#
+# Find most similar essay
+#
+
+sub most_similar {
+ my ($uname,$udom,$uessay,$old_essays)=@_;
+
+# ignore spaces and punctuation
+
+ $uessay=~s/\W+/ /gs;
+
+# ignore empty submissions (occuring when only files are sent)
+
+ unless ($uessay=~/\w+/) { return ''; }
+
+# these will be returned. Do not care if not at least 50 percent similar
+ my $limit=0.6;
+ my $sname='';
+ my $sdom='';
+ my $scrsid='';
+ my $sessay='';
+# go through all essays ...
+ foreach my $tkey (keys(%$old_essays)) {
+ my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
+# ... except the same student
+ next if (($tname eq $uname) && ($tdom eq $udom));
+ my $tessay=$old_essays->{$tkey};
+ $tessay=~s/\W+/ /gs;
+# String similarity gives up if not even limit
+ my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
+# Found one
+ if ($tsimilar>$limit) {
+ $limit=$tsimilar;
+ $sname=$tname;
+ $sdom=$tdom;
+ $scrsid=$tcrsid;
+ $sessay=$old_essays->{$tkey};
}
}
- return \@partlist,\%handgrade;
+ if ($limit>0.6) {
+ return ($sname,$sdom,$scrsid,$sessay,$limit);
+ } else {
+ return ('','','','',0);
+ }
}
+#-------------------------------------------------------------------
+#------------------------------------ Receipt Verification Routines
+#
+#--- Check whether a receipt number is valid.---
+sub verifyreceipt {
+ my $request = shift;
+
+ my $courseid = $env{'request.course.id'};
+ my $receipt = &Apache::lonnet::recprefix($courseid).'-'.
+ $env{'form.receipt'};
+ $receipt =~ s/[^\-\d]//g;
+ my ($symb) = &get_symb($request);
+
+ my $title.='