Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-0-patches'.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm,v 1.6 2004/06/01 14:50:38 gage 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::howAnswers.pm -- display past answers of students 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI qw(); 29 use WeBWorK::Utils qw(formatDateTime); 30 31 sub initialize { 32 my $self = shift; 33 my $r = $self->r; 34 my $urlpath = $r->urlpath; 35 my $db = $r->db; 36 my $ce = $r->ce; 37 my $authz = $r->authz; 38 my $courseName = $urlpath->arg("courseID"); 39 my $user = $r->param('user'); 40 41 unless ($authz->hasPermissions($user, "access_instructor_tools")) { 42 $self->{submitError} = "You aren't authorized to create or delete problems"; 43 return; 44 } 45 46 47 } 48 49 50 sub body { 51 my $self = shift; 52 my $r = $self->r; 53 my $urlpath = $r->urlpath; 54 my $db = $r->db; 55 my $ce = $r->ce; 56 my $authz = $r->authz; 57 my $root = $ce->{webworkURLs}->{root}; 58 my $courseName = $urlpath->arg('courseID'); 59 my $setName = $r->param('setID'); # these are passed in the search args in this case 60 my $problemNumber = $r->param('problemID'); 61 my $user = $r->param('user'); 62 my $key = $r->param('key'); 63 my $studentUser = $r->param('studentUser') if ( defined($r->param('studentUser')) ); 64 65 return CGI::em("You are not authorized to access the instructor tools") unless $authz->hasPermissions($user, "access_instructor_tools"); 66 67 my $showAnswersPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); 68 my $showAnswersURL = $self->systemLink($showAnswersPage,authen => 0 ); 69 70 my ($safeUser,$safeCourse) = (showHTML($studentUser),showHTML($courseName)); 71 my ($safeSet,$safeProb) = (showHTML($setName),showHTML($problemNumber)); 72 73 ##################################################################### 74 # print form 75 ##################################################################### 76 77 print "<p>\n\n<HR>\n"; 78 print '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR><TD>'; 79 print CGI::start_form("POST", $showAnswersURL,-target=>'information'), 80 CGI::submit(-name => 'action', -value=>'Past Answers for'), "\n", 81 " \n", 82 $self->hidden_authen_fields, 83 # qq{<INPUT TYPE="TEXT" NAME="studentUser" VALUE="$safeUser" SIZE="15">}, 84 # " \n", 85 # qq{Set: <INPUT TYPE="TEXT" NAME="setID" VALUE="$safeSet" SIZE="10">}, 86 # " \n", 87 # qq{Problem: <INPUT TYPE="TEXT" NAME="problemID" VALUE="$safeProb" SIZE="5">}, 88 CGI::textfield(-name => 'studentUser', -value => $safeUser, -size =>10 ), 89 " \n Set: ", 90 CGI::textfield( -name => 'setID', -value => $safeSet, -size =>10 ), 91 " \n Problem: ", 92 CGI::textfield(-name => 'problemID', -value => $safeProb,-size =>10 ), 93 " \n", 94 CGI::end_form(),"\n\n"; 95 print "</TABLE>"; 96 97 if (defined($setName) and defined($problemNumber) ) { 98 ##################################################################### 99 # print result table of answers 100 ##################################################################### 101 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 102 103 $studentUser = $r->param('studentUser') if ( defined($r->param('studentUser')) ); 104 my ($safeUser,$safeCourse) = (showHTML($studentUser),showHTML($courseName)); 105 my ($safeSet,$safeProb) = (showHTML($setName),showHTML($problemNumber)); 106 107 108 print CGI::h3( "Past Answers for $safeUser, set $safeSet, problem$safeProb" ); 109 110 $studentUser = "[^|]*" if ($studentUser eq "" or $studentUser eq "*"); 111 $setName = "[^|]*" if ($setName eq "" or $setName eq "*"); 112 $problemNumber = "[^|]*" if ($problemNumber eq "" or $problemNumber eq "*"); 113 114 # had to change the pattern a little to match 115 # the initial time stamp: [Fri Feb 28 22:05:11 2003]. 116 my $pattern = "^[[^]]*]|$studentUser\\|$setName\\|$problemNumber\\|"; 117 #my $pattern = "^\\|$studentUser\\|$setName\\|$problemNumber\\|"; 118 119 our ($lastdate,$lasttime,$lastID,$lastn); 120 121 122 if (open(LOG,"$answer_log")) { 123 my $line; 124 local ($lastdate,$lasttime,$lastID,$lastn) = ("",0,"",0); 125 $self->{lastdate} = ''; 126 $self->{lasttime} = ''; 127 $self->{lastID} = ''; 128 $self->{lastn} = ''; 129 130 # get data from file 131 my @lines = grep(/$pattern/,<LOG>); close(LOG); 132 chomp(@lines); 133 134 print "<CENTER>\n"; 135 print '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">',"\n"; 136 print "No entries for $safeUser set $safeSet, problem $safeProb" unless @lines; # warn if there are no answers 137 foreach $line (sort(@lines)) { 138 print $self->tableRow(split("\t",substr($line,27),-1)); 139 } 140 print qq{<TR><TD COLSPAN="$self->{lastn}"><HR SIZE="3"></TD></TR>\n</TABLE></TD></TR>\n} 141 if ($self->{lastn}); 142 print "</TABLE>\n</CENTER>\n\n"; 143 } else { 144 print "<B>Can't open the access log $answer_log</B>"; 145 } 146 } 147 148 149 return ""; 150 } 151 152 sub tableRow { 153 my $self = shift; 154 my $lastID = $self->{lastID}; 155 my $lastn = $self->{lastn}; 156 my $lasttime = $self->{lasttime}; 157 my $lastdate = $self->{lastdate}; 158 my ($out,$answer,$studentUser,$set,$prob) = ""; 159 my ($ID,$rtime,@answers) = @_; pop(@answers); 160 my $date = scalar(localtime($rtime)); $date =~ s/\s+/ /g; 161 my ($day,$month,$mdate,$time,$year) = split(" ",$date); 162 $date = "$mdate $month $year"; 163 my $n = 2*(scalar(@answers)+1); 164 165 if ($lastID ne $ID) { 166 if ($lastn) { 167 print qq{<TR><TD COLSPAN="$lastn"><HR SIZE="3"></TD></TR>\n<P>\n\n}; 168 print '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">',"\n"; 169 } 170 ($studentUser,$set,$prob) = (split('\|',$ID))[1,2,3]; 171 $out .= qq{<TR ALIGN="CENTER"><TD COLSPAN="$n"><HR SIZE="3"> 172 User: <B>$studentUser</B> 173 Set: <B>$set</B> 174 Problem: <B>$prob</B></TD></TR>\n}; 175 $self->{lastID} = $lastID = $ID; 176 $self->{lasttime} = $lasttime = 0; 177 $self->{lastdate} = $lastdate = ""; 178 } 179 180 $out .= qq{<TR><TD COLSPAN="$n"><HR SIZE="1"></TD></TR>\n} 181 if ($rtime - $lasttime > 30*60); 182 $self->{lasttime} = $lasttime = $rtime; 183 $self->{lastn} = $lastn = $n; 184 185 if ($lastdate ne $date) { 186 $out .= qq{<TR><TD COLSPAN="$n"><SMALL><I>$date</I></SMALL></TD></TR>\n}; 187 $self->{lastdate} = $lastdate = $date; 188 } 189 190 $out .= '<TR><TD WIDTH="10"></TD>'. 191 '<TD><FONT COLOR="#808080"><SMALL>'.$time.'</SMALL></FONT></TD>'; 192 foreach $answer (@answers) { 193 $answer =~ s/(^\s+|\s+$)//g; 194 $answer = showHTML($answer); 195 $answer = "<SMALL><I>empty</I></SMALL>" if ($answer eq ""); 196 $out .= qq{<TD WIDTH="20"></TD><TD NOWRAP>$answer</TD>}; 197 } 198 $out .= "</TR>\n"; 199 $out; 200 } 201 202 ################################################## 203 # 204 # Make HTML symbols printable 205 # 206 sub showHTML { 207 my $string = shift; 208 return '' unless $string; 209 $string =~ s/&/\&/g; 210 $string =~ s/</\</g; 211 $string =~ s/>/\>/g; 212 $string =~ s/ /,/g; 213 $string; 214 } 215 216 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |