Parent Directory
| 
Revision Log
Preliminary commit of changes to add Gateway module.
This adds to WeBWorK
- the ability to create versioned, timed problem sets ("gateway tests")
for which all problems are displayed on a single page ("versioned"
means that students can get multiple versions of the problem set),
- the ability to create sets that draw problems from groups of
problems, and
- the ability to create sets that require a proctor login to start
and grade.
Sets can be defined as gateway tests or proctored gateway tests from
the ProblemSetDetail page.
Not quite bug-free yet. Known bugs include handling of problem values
on the Student Progress page (I think this may be a problem with
changing from sql database format where all entries were 'text' to
sql_single in ver 2.1, where they are integer), and a division by zero
error on the grades page (which may be the same problem).
Tests with a number of attempts per version greater than one haven't
been carefully tested, nor has scoring of gateway tests.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm,v 1.13 2004/10/20 21:52:06 dpvc Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::Instructor::ShowAnswers; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::ShowAnswers.pm -- display past answers of students 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI; 29 30 sub initialize { 31 my $self = shift; 32 my $r = $self->r; 33 my $urlpath = $r->urlpath; 34 my $db = $r->db; 35 my $ce = $r->ce; 36 my $authz = $r->authz; 37 my $courseName = $urlpath->arg("courseID"); 38 my $user = $r->param('user'); 39 40 unless ($authz->hasPermissions($user, "view_answers")) { 41 $self->{submitError} = "You aren't authorized to view past answers"; 42 return; 43 } 44 } 45 46 47 sub body { 48 my $self = shift; 49 my $r = $self->r; 50 my $urlpath = $r->urlpath; 51 my $db = $r->db; 52 my $ce = $r->ce; 53 my $authz = $r->authz; 54 my $root = $ce->{webworkURLs}->{root}; 55 my $courseName = $urlpath->arg('courseID'); 56 my $setName = $r->param('setID'); # these are passed in the search args in this case 57 my $problemNumber = $r->param('problemID'); 58 my $user = $r->param('user'); 59 my $key = $r->param('key'); 60 my $studentUser = $r->param('studentUser') if ( defined($r->param('studentUser')) ); 61 62 return CGI::em("You are not authorized to access the instructor tools") unless $authz->hasPermissions($user, "access_instructor_tools"); 63 return CGI::em("You are not authorized to view past answers") unless $authz->hasPermissions($user, "view_answers"); 64 65 my $showAnswersPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); 66 my $showAnswersURL = $self->systemLink($showAnswersPage,authen => 0 ); 67 68 ##################################################################### 69 # print form 70 ##################################################################### 71 72 print CGI::p(),CGI::hr(); 73 74 print CGI::start_form("POST", $showAnswersURL,-target=>'information'), 75 $self->hidden_authen_fields; 76 print CGI::submit(-name => 'action', -value=>'Past Answers for')," ", 77 CGI::textfield(-name => 'studentUser', -value => $studentUser, -size =>10 ), 78 " Set: ", 79 CGI::textfield( -name => 'setID', -value => $setName, -size =>10 ), 80 " Problem: ", 81 CGI::textfield(-name => 'problemID', -value => $problemNumber,-size =>10 ), 82 " "; 83 print CGI::end_form(); 84 85 if (defined($setName) and defined($problemNumber) ) { 86 ##################################################################### 87 # print result table of answers 88 ##################################################################### 89 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 90 91 $studentUser = $r->param('studentUser') if ( defined($r->param('studentUser')) ); 92 93 print CGI::h3("Past Answers for $studentUser, set $setName, problem $problemNumber" ); 94 95 $studentUser = "[^|]*" if ($studentUser eq "" or $studentUser eq "*"); 96 $setName = "[^|]*" if ($setName eq "" or $setName eq "*"); 97 $problemNumber = "[^|]*" if ($problemNumber eq "" or $problemNumber eq "*"); 98 99 my $pattern = "^[[^]]*]|$studentUser\\|$setName\\|$problemNumber\\|"; 100 101 if (open(LOG,"$answer_log")) { 102 my $line; 103 $self->{lastdate} = ''; 104 $self->{lasttime} = 0; 105 $self->{lastID} = ''; 106 $self->{lastn} = 0; 107 108 my @lines = grep(/$pattern/,<LOG>); close(LOG); 109 chomp(@lines); 110 foreach $line (@lines) {$line = substr($line,27)}; # remove datestamp 111 112 print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3,align=>"center"}); 113 print "No entries for $studentUser set $setName, problem $problemNumber" unless @lines; 114 foreach $line (sort byData @lines) {$self->tableRow(split("\t",$line,-1))} 115 print CGI::Tr(CGI::td({colspan=>$self->{lastn}},CGI::hr({size=>3}))) if ($self->{lastn}); 116 print CGI::end_table(); 117 } else { 118 print "<B>Can't open the access log $answer_log</B>"; 119 } 120 } 121 122 return ""; 123 } 124 125 sub byData { 126 my ($A,$B) = ($a,$b); 127 $A =~ s/\|[01]*\t([^\t]+)\t.*/|$1/; # remove answers and correct/incorrect status 128 $B =~ s/\|[01]*\t([^\t]+)\t.*/|$1/; 129 return $A cmp $B; 130 } 131 132 sub tableRow { 133 my $self = shift; 134 my ($answer,$score,$studentUser,$set,$prob); 135 my ($ID,$rtime,@answers) = @_; pop(@answers); 136 my $scores = ''; $scores = $1 if ($ID =~ s/\|([01]+)$/|/); 137 my @scores = split(//, $scores); 138 my $date = scalar(localtime($rtime)); $date =~ s/\s+/ /g; 139 my ($day,$month,$mdate,$time,$year) = split(" ",$date); 140 $date = "$mdate $month $year"; 141 my $n = 2*(scalar(@answers)+1); 142 143 if ($self->{lastID} ne $ID) { 144 if ($self->{lastn}) { 145 print CGI::Tr(CGI::td({colspan=>$self->{lastn}},CGI::hr({size=>3}))), 146 CGI::end_table(),CGI::p(); 147 print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3,align=>"center"}); 148 } 149 ($studentUser,$set,$prob) = (split('\|',$ID))[1,2,3]; 150 print CGI::Tr({align=>"center"}, 151 CGI::td({colspan=>$n},CGI::hr({size=>3}), 152 "User: " .CGI::b($studentUser)." ", 153 "Set: " .CGI::b($set)." ", 154 "Problem: ".CGI::b($prob))),"\n"; 155 $self->{lastID} = $ID; 156 $self->{lasttime} = 0; 157 $self->{lastdate} = ""; 158 } 159 160 print CGI::Tr(CGI::td({colspan=>$n},CGI::hr({size=>1}))) 161 if ($rtime - $self->{lasttime} > 30*60); 162 $self->{lasttime} = $rtime; 163 $self->{lastn} = $n; 164 165 if ($self->{lastdate} ne $date) { 166 print CGI::Tr(CGI::td({colspan=>$n},CGI::small(CGI::i($date)))); 167 $self->{lastdate} = $date; 168 } 169 170 ## 171 ## These colors really should use CSS and the template 172 ## 173 my @row = (CGI::td({width=>10}),CGI::td({style=>"color:#808080"},CGI::small($time))); 174 my $td = {nowrap => 1}; 175 foreach $answer (@answers) { 176 $answer =~ s/(^\s+|\s+$)//g; 177 $answer = showHTML($answer); 178 $score = shift(@scores); $td->{style} = $score? "color:#006600": "color:#660000"; 179 delete($td->{style}) unless $answer ne "" && defined($score); 180 $answer = CGI::small(CGI::i("empty")) if ($answer eq ""); 181 push(@row,CGI::td({width=>20}),CGI::td($td,$answer)); 182 } 183 print CGI::Tr(@row); 184 } 185 186 ################################################## 187 # 188 # Make HTML symbols printable 189 # 190 sub showHTML { 191 my $string = shift; 192 return '' unless defined $string; 193 $string =~ s/&/\&/g; 194 $string =~ s/</\</g; 195 $string =~ s/>/\>/g; 196 $string =~ s/\000/,/g; # anyone know why this is here? (I didn't add it -- dpvc) 197 $string; 198 } 199 200 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |