Parent Directory
| 
Revision Log
Cleanup -- moving toward using the Apache:Request object and URLpath. It remains to use URLpath to construct new paths in these files.
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.2 2003/12/09 01:12:31 sh002i 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::ProblemSetList - Entry point for Problem and Set editing 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, "create_and_delete_problem_sets")) { 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 = $urlpath->arg('setID'); 60 my $problemNumber = $urlpath->arg('problemID'); 61 my $user = $r->param('user'); 62 my $key = $r->param('key'); 63 my $studentUser = $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 $studentUser = $r->param('studentUser') if ( defined($r->param('studentUser')) ); 68 my ($safeUser,$safeCourse) = (showHTML($studentUser),showHTML($courseName)); 69 my ($safeSet,$safeProb) = (showHTML($setName),showHTML($problemNumber)); 70 71 72 ##################################################################### 73 # print form 74 ##################################################################### 75 76 print "<p>\n\n<HR>\n"; 77 print '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR><TD>'; 78 print CGI::start_form("POST", $self->{r}->uri,-target=>'information'), 79 CGI::submit(-name => 'action', -value=>'Past Answers for'), "\n", 80 " \n", 81 $self->hidden_authen_fields, 82 qq{<INPUT TYPE="TEXT" NAME="studentUser" VALUE="$safeUser" SIZE="15">}, 83 " \n", 84 qq{Set: <INPUT TYPE="TEXT" NAME="setName" VALUE="$safeSet" SIZE="10">}, 85 " \n", 86 qq{Problem: <INPUT TYPE="TEXT" NAME="problemNumber" VALUE="$safeProb" SIZE="5">}, 87 CGI::end_form(),"\n\n"; 88 print "</TABLE>"; 89 90 if (defined($setName) and defined($problemNumber) ) { 91 ##################################################################### 92 # print result table of answers 93 ##################################################################### 94 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 95 96 $studentUser = $r->param('studentUser') if ( defined($r->param('studentUser')) ); 97 my ($safeUser,$safeCourse) = (showHTML($studentUser),showHTML($courseName)); 98 my ($safeSet,$safeProb) = (showHTML($setName),showHTML($problemNumber)); 99 100 101 print CGI::h3( "Past Answers for $safeUser, set $safeSet, problem$safeProb)" ); 102 103 $studentUser = "[^|]*" if ($studentUser eq "" or $studentUser eq "*"); 104 $setName = "[^|]*" if ($setName eq "" or $setName eq "*"); 105 $problemNumber = "[^|]*" if ($problemNumber eq "" or $problemNumber eq "*"); 106 107 # had to change the pattern a little to match 108 # the initial time stamp: [Fri Feb 28 22:05:11 2003]. 109 my $pattern = "^[[^]]*]|$studentUser\\|$setName\\|$problemNumber\\|"; 110 #my $pattern = "^\\|$studentUser\\|$setName\\|$problemNumber\\|"; 111 112 our ($lastdate,$lasttime,$lastID,$lastn); 113 114 115 if (open(LOG,"$answer_log")) { 116 my $line; 117 local ($lastdate,$lasttime,$lastID,$lastn) = ("",0,"",0); 118 $self->{lastdate} = ''; 119 $self->{lasttime} = ''; 120 $self->{lastID} = ''; 121 $self->{lastn} = ''; 122 123 # get data from file 124 my @lines = grep(/$pattern/,<LOG>); close(LOG); 125 chomp(@lines); 126 127 print "<CENTER>\n"; 128 print '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">',"\n"; 129 print "No entries for $safeUser set $safeSet, problem $safeProb)" unless @lines; # warn if there are no answers 130 foreach $line (sort(@lines)) { 131 print $self->tableRow(split("\t",$line."\tx")); 132 } 133 print qq{<TR><TD COLSPAN="$lastn"><HR SIZE="3"></TD></TR>\n} if ($lastn); 134 print "</TABLE>\n</CENTER>\n\n"; 135 } else { 136 print "<B>Can't open the access log $answer_log</B>"; 137 } 138 } 139 140 141 return ""; 142 } 143 144 sub tableRow { 145 my $self = shift; 146 my $lastID = $self->{lastID}; 147 my $lastn = $self->{lastn}; 148 my $lasttime = $self->{lasttime}; 149 my $lastdate = $self->{lastdate}; 150 my ($out,$answer,$studentUser,$set,$prob) = ""; 151 my ($ID,$rtime,@answers) = @_; pop(@answers); 152 my $date = scalar(localtime($rtime)); $date =~ s/\s+/ /g; 153 my ($day,$month,$mdate,$time,$year) = split(" ",$date); 154 $date = "$mdate $month $year"; 155 my $n = 2*(scalar(@answers)+1); 156 157 if ($lastID ne $ID) { 158 if ($lastn) { 159 print qq{<TR><TD COLSPAN="$lastn"><HR SIZE="3"></TD></TR>\n<P>\n\n}; 160 print '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">',"\n"; 161 } 162 ($studentUser,$set,$prob) = (split('\|',$ID))[1,2,3]; 163 $out .= qq{<TR ALIGN="CENTER"><TD COLSPAN="$n"><HR SIZE="3"> 164 User: <B>$studentUser</B> 165 Set: <B>$set</B> 166 Problem: <B>$prob</B></TD></TR>\n}; 167 $lastID = $ID; $lasttime = 0; $lastdate = ""; 168 } 169 170 $out .= qq{<TR><TD COLSPAN="$n"><HR SIZE="1"></TD></TR>\n} 171 if ($rtime - $lasttime > 30*60); 172 $lasttime = $rtime; $lastn = $n; 173 174 if ($lastdate ne $date) { 175 $out .= qq{<TR><TD COLSPAN="$n"><SMALL><I>$date</I></SMALL></TD></TR>\n}; 176 $lastdate = $date; 177 } 178 179 $out .= '<TR><TD WIDTH="10"></TD>'. 180 '<TD><FONT COLOR="#808080"><SMALL>'.$time.'</SMALL></FONT></TD>'; 181 foreach $answer (@answers) { 182 $answer =~ s/(^\s+|\s+$)//g; 183 $answer = showHTML($answer); 184 $answer = "<SMALL><I>empty</I></SMALL>" if ($answer eq ""); 185 $out .= qq{<TD WIDTH="20"></TD><TD NOWRAP>$answer</TD>}; 186 } 187 $out .= "</TR>\n"; 188 $out; 189 } 190 191 ################################################## 192 # 193 # Make HTML symbols printable 194 # 195 sub showHTML { 196 my $string = shift; 197 return '' unless $string; 198 $string =~ s/&/\&/g; 199 $string =~ s/</\</g; 200 $string =~ s/>/\>/g; 201 $string; 202 } 203 204 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |