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