Parent Directory
| 
Revision Log
timezone support
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.11 2004/09/05 14:47:24 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 111 print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3,align=>"center"}); 112 print "No entries for $studentUser set $setName, problem $problemNumber" unless @lines; 113 foreach $line (sort(@lines)) {$self->tableRow(split("\t",substr($line,27),-1))} 114 print CGI::Tr(CGI::td({colspan=>$self->{lastn}},CGI::hr({size=>3}))) if ($self->{lastn}); 115 print CGI::end_table(); 116 } else { 117 print "<B>Can't open the access log $answer_log</B>"; 118 } 119 } 120 121 return ""; 122 } 123 124 sub tableRow { 125 my $self = shift; 126 my ($answer,$score,$studentUser,$set,$prob); 127 my ($ID,$rtime,@answers) = @_; pop(@answers); 128 my $scores = ''; $scores = $1 if ($ID =~ s/\|([01]+)$/|/); 129 my @scores = split(//, $scores); 130 my $date = scalar(localtime($rtime)); $date =~ s/\s+/ /g; 131 my ($day,$month,$mdate,$time,$year) = split(" ",$date); 132 $date = "$mdate $month $year"; 133 my $n = 2*(scalar(@answers)+1); 134 135 if ($self->{lastID} ne $ID) { 136 if ($self->{lastn}) { 137 print CGI::Tr(CGI::td({colspan=>$self->{lastn}},CGI::hr({size=>3}))), 138 CGI::end_table(),CGI::p(); 139 print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3,align=>"center"}); 140 } 141 ($studentUser,$set,$prob) = (split('\|',$ID))[1,2,3]; 142 print CGI::Tr({align=>"center"}, 143 CGI::td({colspan=>$n},CGI::hr({size=>3}), 144 "User: " .CGI::b($studentUser)." ", 145 "Set: " .CGI::b($set)." ", 146 "Problem: ".CGI::b($prob))),"\n"; 147 $self->{lastID} = $ID; 148 $self->{lasttime} = 0; 149 $self->{lastdate} = ""; 150 } 151 152 print CGI::Tr(CGI::td({colspan=>$n},CGI::hr({size=>1}))) 153 if ($rtime - $self->{lasttime} > 30*60); 154 $self->{lasttime} = $rtime; 155 $self->{lastn} = $n; 156 157 if ($self->{lastdate} ne $date) { 158 print CGI::Tr(CGI::td({colspan=>$n},CGI::small(CGI::i($date)))); 159 $self->{lastdate} = $date; 160 } 161 162 ## 163 ## These colors really should use CSS and the template 164 ## 165 my @row = (CGI::td({width=>10}),CGI::td({style=>"color:#808080"},CGI::small($time))); 166 my $td = {nowrap => 1}; 167 foreach $answer (@answers) { 168 $answer =~ s/(^\s+|\s+$)//g; 169 $answer = showHTML($answer); 170 $score = shift(@scores); $td->{style} = $score? "color:#006600": "color:#660000"; 171 delete($td->{style}) unless $answer ne "" && defined($score); 172 $answer = CGI::small(CGI::i("empty")) if ($answer eq ""); 173 push(@row,CGI::td({width=>20}),CGI::td($td,$answer)); 174 } 175 print CGI::Tr(@row); 176 } 177 178 ################################################## 179 # 180 # Make HTML symbols printable 181 # 182 sub showHTML { 183 my $string = shift; 184 return '' unless defined $string; 185 $string =~ s/&/\&/g; 186 $string =~ s/</\</g; 187 $string =~ s/>/\>/g; 188 $string =~ s/\000/,/g; # anyone know why this is here? (I didn't add it -- dpvc) 189 $string; 190 } 191 192 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |