Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-1-patches'.
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/Preflight.pm,v 1.3 2004/06/14 20:58:17 toenail 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::Preflight; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::Preflight.pm -- display past answers of many students 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI qw(); 29 use WeBWorK::HTML::OptionList qw/optionList/; 30 use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; 31 32 sub initialize { 33 my $self = shift; 34 my $r = $self->r; 35 my $urlpath = $r->urlpath; 36 my $db = $r->db; 37 my $ce = $r->ce; 38 my $authz = $r->authz; 39 my $courseName = $urlpath->arg("courseID"); 40 my $user = $r->param('user'); 41 42 # Check permissions 43 return unless ($authz->hasPermissions($user, "access_instructor_tools")); 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 if ($problemNumber =~ /\!(\d+)/) { $problemNumber = $1 }; 59 my $user = $r->param('user'); 60 my $key = $r->param('key'); 61 my $studentUser = $r->param('studentUser') || ""; 62 63 # Check permissions 64 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 65 unless $authz->hasPermissions($r->param("user"), "access_instructor_tools"); 66 67 68 my $showAnswersPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); 69 my $showAnswersURL = $self->systemLink($showAnswersPage,authen => 0 ); 70 71 my ($safeUser, $safeCourse) = (showHTML($studentUser), showHTML($courseName)); 72 my ($safeSet, $safeProb) = (showHTML($setName), showHTML($problemNumber)); 73 74 my @defaultOrder = qw(user_id set_id problem_id date answers); 75 76 my %prettyFieldNames; 77 78 @prettyFieldNames{qw( 79 user_id 80 set_id 81 problem_id 82 date 83 answers 84 )} = ( 85 "User ID", 86 "Set Name", 87 "Problem Number", 88 "Date", 89 "Answers", 90 ); 91 $prettyFieldNames{nofield} = ""; 92 93 ##################################################################### 94 # print form 95 ##################################################################### 96 97 my @userIDs = grep /\w/, sort $db->listUsers(); 98 my @Users = $db->getUsers(@userIDs); 99 my %users = map { $_ => $db->getUser($_)->first_name } @userIDs; 100 my @setIDs = sort $db->listGlobalSets(); 101 my @GlobalSets = $db->getGlobalSets(@setIDs); 102 my @GlobalProblems = $db->getAllGlobalProblems($setName); 103 104 my $scrolling_user_list = scrollingRecordList({ 105 name => "studentUser", 106 request => $r, 107 default_sort => "lnfn", 108 default_format => "lnfn_uid", 109 default_filters => ["all"], 110 default => "Select one or more users: ", 111 # hide_sort => 1, 112 # hide_format => 1, 113 # hide_filter => 1, 114 size => 10, 115 # multiple => 0, 116 }, @Users); 117 118 my $scrolling_set_list = scrollingRecordList({ 119 name => "setID", 120 request => $r, 121 default_sort => "set_id", 122 default_format => "set_id", 123 default_filters => ["all"], 124 default => "Select one or more sets: ", 125 # hide_sort => 1, 126 # hide_format => 1, 127 # hide_filter => 1, 128 size => 10, 129 # multiple => 0, 130 }, @GlobalSets); 131 132 my $scrolling_problem_list = scrollingRecordList({ 133 name => "problemID", 134 request => $r, 135 default => "Select one or more problems: ", 136 default_filters => ["all"], 137 # hide_sort => 1, 138 # hide_format => 1, 139 # hide_filter => 1, 140 size => 10, 141 # multiple => 0, 142 }, @GlobalProblems); 143 144 my @selected_fields = $r->param("selected_fields"); 145 my @selected_answers = $r->param("selected_answers"); 146 147 print join ("", 148 CGI::br(), 149 "\n\n", 150 CGI::hr(), 151 CGI::start_form( 152 -method => "post", 153 -action => $showAnswersURL, 154 -target => 'information', 155 ), 156 CGI::start_table( 157 -border => "0", 158 -cellpadding => "0", 159 -cellspacing => "0", 160 ), 161 CGI::Tr( 162 CGI::td({style=>"width:33%"}, $scrolling_user_list), 163 CGI::td({style=>"width:33%"}, $scrolling_set_list), 164 CGI::td({style=>"width:33%"}, $scrolling_problem_list), 165 ), 166 CGI::Tr({}, 167 CGI::submit( 168 -name => 'action', 169 -value => 'Past Answers for', 170 ), "\n", 171 # $self->hidden_authen_fields, 172 # " \n User: ", 173 # CGI::textfield( 174 # -name => 'studentUser1', 175 # -value => $safeUser, 176 # -size => 10, 177 # ), 178 # " \n Set: ", 179 # CGI::textfield( 180 # -name => 'setID1', 181 # -value => $safeSet, 182 # -size => 10, 183 # ), 184 # " \n Problem: ", 185 # CGI::textfield( 186 # -name => 'problemID', 187 # -value => $safeProb, 188 # -size => 10, 189 # ), 190 # " \n", 191 # CGI::br(),CGI::br(), 192 ), 193 # CGI::Tr({}, 194 # CGI::popup_menu( 195 # -name => 'studentUser', 196 # -size => 10, 197 # -values => \@userIDs, 198 # -multiple => 1, 199 # ), 200 # CGI::popup_menu( 201 # -name => 'setID', 202 # -values => \@setIDs, 203 # -size => 10, 204 # -multiple => 1, 205 # ), 206 # ), 207 CGI::Tr({}, 208 CGI::td({}, 209 "Select which fields to show: " . CGI::br(), 210 CGI::scrolling_list( 211 -name => "selected_fields", 212 -values => \@defaultOrder, 213 -labels => \%prettyFieldNames, 214 -default => \@selected_fields, 215 -size => 5, 216 -multiple => 1, 217 ), 218 ), 219 CGI::td({}, 220 "and which answers to show: " . CGI::br(), 221 CGI::scrolling_list( 222 -name => "selected_answers", 223 -values => [1..100], 224 -default => \@selected_answers, 225 -size => 5, 226 -multiple => 1, 227 ) 228 ), 229 ), 230 CGI::end_table({}), 231 CGI::end_form({}), 232 ); 233 234 ##################################################################### 235 # create ordering system 236 ##################################################################### 237 238 # FIXME: We need a way to choose the order as well as the fields! 239 my (@fieldOrder) = @selected_fields ? @selected_fields : @defaultOrder; 240 241 if (defined($setName) and defined($problemNumber) ) { 242 ##################################################################### 243 # print result table of answers 244 ##################################################################### 245 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 246 247 $studentUser = $r->param('studentUser') if ( defined($r->param('studentUser')) ); 248 my ($safeUser, $safeCourse) = (showHTML($studentUser), showHTML($courseName)); 249 my ($safeSet, $safeProb) = (showHTML($setName), showHTML($problemNumber)); 250 251 252 print CGI::h3( "Past Answers for " . ($safeUser ? "user $safeUser " : '' ) . ($safeSet ? "set $safeSet " : '' ) . ($safeSet and $safeProb ? ', ' : '') . ($safeProb ? "problem $safeProb" : '')); 253 254 $studentUser = "[^|]*" if (not defined $studentUser or $studentUser eq "" or $studentUser eq "*"); 255 $setName = "[^|]*" if ($setName eq "" or $setName eq "*"); 256 $problemNumber = "[^|]*" if ($problemNumber eq "" or $problemNumber eq "*"); 257 258 #my $pattern = "^[[^]]*]|[^|]*\\|$setName\\|$problemNumber\\|"; 259 my $pattern = "\\|$studentUser\\|$setName\\|$problemNumber\\|"; 260 261 our ($lastdate, $lasttime, $lastID, $lastn); 262 263 264 if (open(LOG,"$answer_log")) { 265 my $line; 266 local ($lastdate, $lasttime, $lastID, $lastn) = ("",0,"",0); 267 $self->{lastdate} = ''; 268 $self->{lasttime} = ''; 269 $self->{lastID} = ''; 270 $self->{lastn} = ''; 271 272 # get data from file 273 274 my @lines = grep(/$pattern/,<LOG>); close(LOG); 275 chomp(@lines); 276 277 my $maxcount = 0; 278 foreach my $newline (@lines) { 279 my @words = split /\t/, $newline; 280 my $count = @words; 281 $maxcount = $count if $count > $maxcount; 282 } 283 @selected_answers = (1..$maxcount) unless @selected_answers; 284 285 # print "<CENTER>\n"; 286 print CGI::start_table({ 287 -border => "1", 288 # -cellpadding => '3', 289 # -cellspacing => '0', 290 -onload => "", 291 }) . "\n"; 292 293 my @tableHeaders; 294 foreach (@fieldOrder) { 295 push @tableHeaders, $prettyFieldNames{$_} unless $_ eq "answers"; 296 } 297 print CGI::Tr({}, CGI::th({}, \@tableHeaders) , CGI::th({-colspan => 200}, $prettyFieldNames{answers})); 298 299 my @Records; 300 ##################################################################### 301 # create array of records 302 ##################################################################### 303 foreach $line ( @lines ) { 304 my %fakeRecord = (); 305 #print CGI::br() . $line; 306 next if not $line =~ /\|(\w+)\|([\w\d_-]+)\|(\d+)\|\s*(\d+)(.*?)\t?$/; 307 $fakeRecord{user_id} = "$1"; 308 $fakeRecord{set_id} = "$2"; 309 $fakeRecord{problem_id} = "$3"; 310 $fakeRecord{date} = $4; #$self->formatDateTime($4); 311 $fakeRecord{answers} = [ split "\t", "$5", -1 ] if $5; # the -1 stops split from dropping any trailing null fields 312 my @answers = map { $_ ? showHTML($_) : CGI::small(CGI::i("empty")) } @{ $fakeRecord{answers} }; 313 shift @answers; # first field is always empty 314 $fakeRecord{answers} = \@answers; 315 316 317 my @tableCells; 318 foreach (@fieldOrder) { 319 320 #push @tableCells, showHTML($fakeRecord{$_}); 321 } 322 323 push @Records, \%fakeRecord; 324 325 #print join " ", map { "$_ = $fakeRecord{$_}" } keys %fakeRecord; 326 #print CGI::br(); 327 # print CGI::Tr({}, CGI::td({}, \@tableCells)); 328 329 #print $self->tableRow(split("\t",$line."\tx")); 330 } 331 332 ##################################################################### 333 # sort array of records 334 ##################################################################### 335 336 @Records = sort byUSPD @Records; 337 338 ##################################################################### 339 # print array of records 340 ##################################################################### 341 342 foreach my $record (@Records) { 343 my @tableCells; 344 foreach (@fieldOrder) { 345 if ($_ eq "answers") { 346 my $i = 0; 347 my %answers = map { ++$i => $_ } @{ $record->{$_} }; 348 push @tableCells, @answers{@selected_answers}; 349 } elsif ($_ eq "date") { 350 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime $record->{$_}; 351 $wday = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")[$wday]; 352 $mon = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[$mon]; 353 $year += 1900; 354 my $ampm = ("am", "pm")[$hour > 12]; 355 $hour = $hour % 12; 356 push @tableCells, showHTML("$wday $mday $mon $year $hour:$min $ampm"); 357 } else { 358 push @tableCells, $record->{$_}; 359 } 360 } 361 362 print CGI::Tr({}, CGI::td({}, \@tableCells)); 363 } 364 365 # print a horizontal line 366 #print CGI::Tr({}, CGI::td({colspan => $lastn}, CGI::hr({size => 3}))); 367 print CGI::end_table({}); 368 # print "\n</CENTER>\n\n"; 369 print CGI::p( 370 CGI::i("No entries for " . ($safeUser ? "user $safeUser " : '' ) . ($safeSet ? "set $safeSet " : '' ) . ($safeSet and $safeProb ? ', ' : '') . ($safeProb ? "problem $safeProb" : '')) 371 ) unless @lines; 372 373 } else { 374 print CGI::em("Can't open the access log $answer_log"); 375 } 376 } 377 378 379 return ""; 380 } 381 382 sub tableRow { 383 my $self = shift; 384 my $lastID = $self->{lastID}; 385 my $lastn = $self->{lastn}; 386 my $lasttime = $self->{lasttime}; 387 my $lastdate = $self->{lastdate}; 388 my ($out,$answer,$studentUser,$set,$prob) = ""; 389 my ($ID,$rtime,@answers) = @_; pop(@answers); 390 my $date = scalar(localtime($rtime)); $date =~ s/\s+/ /g; 391 my ($day,$month,$mdate,$time,$year) = split(" ",$date); 392 $date = "$mdate $month $year"; 393 my $n = 2*(scalar(@answers)+1); 394 395 if ($lastID ne $ID) { 396 if ($lastn) { 397 print qq{<TR><TD COLSPAN="$lastn"><HR SIZE="3"></TD></TR>\n<P>\n\n}; 398 print '<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">',"\n"; 399 } 400 ($studentUser,$set,$prob) = (split('\|',$ID))[1,2,3]; 401 $out .= qq{<TR ALIGN="CENTER"><TD COLSPAN="$n"><HR SIZE="3"> 402 User: <B>$studentUser</B> 403 Set: <B>$set</B> 404 Problem: <B>$prob</B></TD></TR>\n}; 405 $lastID = $ID; $lasttime = 0; $lastdate = ""; 406 } 407 408 $out .= qq{<TR><TD COLSPAN="$n"><HR SIZE="1"></TD></TR>\n} 409 if ($rtime - $lasttime > 30*60); 410 $lasttime = $rtime; $lastn = $n; 411 412 if ($lastdate ne $date) { 413 $out .= qq{<TR><TD COLSPAN="$n"><SMALL><I>$date</I></SMALL></TD></TR>\n}; 414 $lastdate = $date; 415 } 416 417 $out .= '<TR><TD WIDTH="10"></TD>'. 418 '<TD><FONT COLOR="#808080"><SMALL>'.$time.'</SMALL></FONT></TD>'; 419 foreach $answer (@answers) { 420 $answer =~ s/(^\s+|\s+$)//g; 421 $answer = showHTML($answer); 422 $answer = "<SMALL><I>empty</I></SMALL>" if ($answer eq ""); 423 $out .= qq{<TD WIDTH="20"></TD><TD NOWRAP>$answer</TD>}; 424 } 425 $out .= "</TR>\n"; 426 $out; 427 } 428 429 ################################################################################ 430 # sorts 431 ################################################################################ 432 433 sub byUserID { $a->{user_id} cmp $b->{user_id} } 434 sub bySetID { lc($a->{set_id}) cmp lc($b->{set_id}) } 435 sub byProblemID { $a->{problem_id} <=> $b->{problem_id} } 436 sub byDate { $a->{date} cmp $b->{date} } 437 438 sub byUSPD { &byUserID || &bySetID || &byProblemID || &byDate } 439 440 ################################################## 441 # 442 # Make HTML symbols printable 443 # 444 sub showHTML { 445 my $string = shift; 446 return '' unless defined $string; 447 $string =~ s/&/\&/g; 448 $string =~ s/</\</g; 449 $string =~ s/>/\>/g; 450 $string =~ s/ /,/g; 451 $string =~ s/ / /g; 452 return $string; 453 } 454 455 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |