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/Scoring.pm,v 1.35 2004/06/14 22:18:16 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::Scoring; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::Scoring - Generate scoring data files 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI qw(); 29 use WeBWorK::Utils qw(readFile); 30 use WeBWorK::DB::Utils qw(initializeUserProblem); 31 use WeBWorK::Timing; 32 33 sub initialize { 34 my ($self) = @_; 35 my $r = $self->r; 36 my $urlpath = $r->urlpath; 37 my $ce = $r->ce; 38 my $db = $r->db; 39 my $authz = $r->authz; 40 my $scoringDir = $ce->{courseDirs}->{scoring}; 41 my $courseName = $urlpath->arg("courseID"); 42 my $user = $r->param('user'); 43 44 # Check permission 45 return unless $authz->hasPermissions($user, "access_instructor_tools"); 46 return unless $authz->hasPermissions($user, "score_sets"); 47 48 if (defined $r->param('scoreSelected')) { 49 my @selected = $r->param('selectedSet'); 50 my @totals = (); 51 my $recordSingleSetScores = $r->param('recordSingleSetScores'); 52 53 $self->addmessage(CGI::div({class=>'ResultsWithError'},"You must select one or more sets for scoring")) unless @selected; 54 55 # pre-fetch users 56 $WeBWorK::timer->continue("pre-fetching users") if defined($WeBWorK::timer); 57 my @Users = $db->getUsers($db->listUsers); 58 my %Users; 59 foreach my $User (@Users) { 60 next unless $User; 61 $Users{$User->user_id} = $User; 62 } 63 my @sortedUserIDs = sort { $Users{$a}->student_id cmp $Users{$b}->student_id } 64 keys %Users; 65 my @userInfo = (\%Users, \@sortedUserIDs); 66 $WeBWorK::timer->continue("done pre-fetching users") if defined($WeBWorK::timer); 67 68 my $scoringType = ($recordSingleSetScores) ?'everything':'totals'; 69 my (@everything, @normal,@full,@info,@totalsColumn); 70 @info = $self->scoreSet($selected[0], "info", undef, @userInfo) if defined($selected[0]); 71 @totals = @info; 72 my $showIndex = defined($r->param('includeIndex')) ? defined($r->param('includeIndex')) : 0; 73 74 foreach my $setID (@selected) { 75 next unless defined $setID; 76 if ($scoringType eq 'everything') { 77 @everything = $self->scoreSet($setID, "everything", $showIndex, @userInfo); 78 @normal = $self->everything2normal(@everything); 79 @full = $self->everything2full(@everything); 80 @info = $self->everything2info(@everything); 81 @totalsColumn = $self->everything2totals(@everything); 82 $self->appendColumns(\@totals, \@totalsColumn); 83 $self->writeCSV("$scoringDir/s${setID}scr.csv", @normal); 84 $self->writeCSV("$scoringDir/s${setID}ful.csv", @full); 85 } else { 86 @totalsColumn = $self->scoreSet($setID, "totals", $showIndex, @userInfo); 87 $self->appendColumns(\@totals, \@totalsColumn); 88 } 89 } 90 $self->writeCSV("$scoringDir/${courseName}_totals.csv", @totals); 91 } 92 93 # Obtaining list of sets: 94 #$WeBWorK::timer->continue("Begin listing sets") if defined $WeBWorK::timer; 95 my @setNames = $db->listGlobalSets(); 96 #$WeBWorK::timer->continue("End listing sets") if defined $WeBWorK::timer; 97 my @set_records = (); 98 #$WeBWorK::timer->continue("Begin obtaining sets") if defined $WeBWorK::timer; 99 @set_records = $db->getGlobalSets( @setNames); 100 #$WeBWorK::timer->continue("End obtaining sets: ".@set_records) if defined $WeBWorK::timer; 101 102 103 # store data 104 $self->{ra_sets} = \@setNames; # ra_sets IS NEVER USED AGAIN!!!!! 105 $self->{ra_set_records} = \@set_records; 106 } 107 108 109 sub body { 110 my ($self) = @_; 111 my $r = $self->r; 112 my $urlpath = $r->urlpath; 113 my $ce = $r->ce; 114 my $authz = $r->authz; 115 my $scoringDir = $ce->{courseDirs}->{scoring}; 116 my $courseName = $urlpath->arg("courseID"); 117 my $user = $r->param('user'); 118 119 my $scoringPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); 120 my $scoringURL = $self->systemLink($scoringPage, authen=>0); 121 122 my $scoringDownloadPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ScoringDownload", 123 courseID => $courseName 124 ); 125 126 # Check permissions 127 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 128 unless $authz->hasPermissions($r->param("user"), "access_instructor_tools"); 129 130 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to score sets.") 131 unless $authz->hasPermissions($r->param("user"), "score_sets"); 132 133 print join("", 134 CGI::start_form(-method=>"POST", -action=>$scoringURL),"\n", 135 $self->hidden_authen_fields,"\n", 136 CGI::hidden({-name=>'scoreSelected', -value=>1}), 137 $self->popup_set_form, 138 CGI::br(), 139 CGI::checkbox({ -name=>'includeIndex', 140 -value=>1, 141 -label=>'IncludeIndex', 142 -checked=>1, 143 }, 144 'Include Index' 145 ), 146 CGI::br(), 147 CGI::checkbox({ -name=>'recordSingleSetScores', 148 -value=>1, 149 -label=>'Record Scores for Single Sets', 150 -checked=>0, 151 }, 152 'Record Scores for Single Sets' 153 ), 154 CGI::br(), 155 CGI::input({type=>'submit',value=>'Score selected set(s)...',name=>'score-sets'}), 156 157 ); 158 159 160 if ($authz->hasPermissions($user, "score_sets")) { 161 my @selected = $r->param('selectedSet'); 162 if (@selected) { 163 print CGI::p("All of these files will also be made available for mail merge"); 164 } 165 foreach my $setID (@selected) { 166 167 my @validFiles; 168 foreach my $type ("scr", "ful") { 169 my $filename = "s$setID$type.csv"; 170 my $path = "$scoringDir/$filename"; 171 push @validFiles, $filename if -f $path; 172 } 173 if (@validFiles) { 174 print CGI::h2("$setID"); 175 foreach my $filename (@validFiles) { 176 #print CGI::a({href=>"../scoringDownload/?getFile=${filename}&".$self->url_authen_args}, $filename); 177 print CGI::a({href=>$self->systemLink($scoringDownloadPage, 178 params=>{getFile => $filename } )}, $filename); 179 print CGI::br(); 180 } 181 print CGI::hr(); 182 } 183 } 184 if (-f "$scoringDir/${courseName}_totals.csv") { 185 print CGI::h2("Totals"); 186 #print CGI::a({href=>"../scoringDownload/?getFile=${courseName}_totals.csv&".$self->url_authen_args}, "${courseName}_totals.csv"); 187 print CGI::a({href=>$self->systemLink($scoringDownloadPage, 188 params=>{getFile => "${courseName}_totals.csv" } )}, "${courseName}_totals.csv"); 189 print CGI::hr(); 190 print CGI::pre({style=>'font-size:smaller'},WeBWorK::Utils::readFile("$scoringDir/${courseName}_totals.csv")); 191 } 192 } 193 194 return ""; 195 } 196 197 # If, some day, it becomes possible to assign a different number of problems to each student, this code 198 # will have to be rewritten some. 199 # $format can be any of "normal", "full", "everything", "info", or "totals". An undefined value defaults to "normal" 200 # normal: student info, the status of each problem in the set, and a "totals" column 201 # full: student info, the status of each problem, and the number of correct and incorrect attempts 202 # everything: "full" plus a totals column 203 # info: student info columns only 204 # totals: total column only 205 sub scoreSet { 206 my ($self, $setID, $format, $showIndex, $UsersRef, $sortedUserIDsRef) = @_; 207 my $r = $self->r; 208 my $db = $r->db; 209 my @scoringData; 210 my $scoringItems = { info => 0, 211 successIndex => 0, 212 setTotals => 0, 213 problemScores => 0, 214 problemAttempts => 0, 215 header => 0, 216 }; 217 $format = "normal" unless defined $format; 218 $format = "normal" unless $format eq "full" or $format eq "everything" or $format eq "totals" or $format eq "info"; 219 my $columnsPerProblem = ($format eq "full" or $format eq "everything") ? 3 : 1; 220 221 my $setRecord = $db->getGlobalSet($setID); #checked 222 die "global set $setID not found. " unless $setRecord; 223 #my %users; 224 #my %userStudentID=(); 225 #$WeBWorK::timer->continue("Begin getting users for set $setID") if defined($WeBWorK::timer); 226 #foreach my $userID ($db->listUsers()) { 227 # my $userRecord = $db->getUser($userID); # checked 228 # die "user record for $userID not found" unless $userID; 229 # # FIXME: if two users have the same student ID, the second one will 230 # # clobber the first one. this is bad! 231 # # The key is what we'd like to sort by. 232 # $users{$userRecord->student_id} = $userRecord; 233 # $userStudentID{$userID} = $userRecord->student_id; 234 #} 235 #$WeBWorK::timer->continue("End getting users for set $setID") if defined($WeBWorK::timer); 236 237 my %Users = %$UsersRef; # user objects hashed on user ID 238 my @sortedUserIDs = @$sortedUserIDsRef; # user IDs sorted by student ID 239 240 my @problemIDs = $db->listGlobalProblems($setID); 241 242 # determine what information will be returned 243 if ($format eq 'normal') { 244 $scoringItems = { info => 1, 245 successIndex => $showIndex, 246 setTotals => 1, 247 problemScores => 1, 248 problemAttempts => 0, 249 header => 1, 250 }; 251 } elsif ($format eq 'full') { 252 $scoringItems = { info => 1, 253 successIndex => $showIndex, 254 setTotals => 0, 255 problemScores => 1, 256 problemAttempts => 1, 257 header => 1, 258 }; 259 } elsif ($format eq 'everything') { 260 $scoringItems = { info => 1, 261 successIndex => $showIndex, 262 setTotals => 1, 263 problemScores => 1, 264 problemAttempts => 1, 265 header => 1, 266 }; 267 } elsif ($format eq 'totals') { 268 $scoringItems = { info => 0, 269 successIndex => $showIndex, 270 setTotals => 1, 271 problemScores => 0, 272 problemAttempts => 0, 273 header => 0, 274 }; 275 } elsif ($format eq 'info') { 276 $scoringItems = { info => 0, 277 successIndex => 0, 278 setTotals => 0, 279 problemScores => 0, 280 problemAttempts => 0, 281 header => 1, 282 }; 283 } else { 284 warn "unrecognized format"; 285 } 286 287 # Initialize a two-dimensional array of the proper size 288 for (my $i = 0; $i < @sortedUserIDs + 7; $i++) { # 7 is how many descriptive fields there are in each column 289 push @scoringData, []; 290 } 291 292 my @userInfoColumnHeadings = ("STUDENT ID", "LAST NAME", "FIRST NAME", "SECTION", "RECITATION"); 293 my @userInfoFields = ("student_id", "last_name", "first_name", "section", "recitation"); 294 #my @userKeys = sort keys %users; # list of "student IDs" NOT user IDs 295 296 if ($scoringItems->{header}) { 297 $scoringData[0][0] = "NO OF FIELDS"; 298 $scoringData[1][0] = "SET NAME"; 299 $scoringData[2][0] = "PROB NUMBER"; 300 $scoringData[3][0] = "DUE DATE"; 301 $scoringData[4][0] = "DUE TIME"; 302 $scoringData[5][0] = "PROB VALUE"; 303 304 305 306 # Write identifying information about the users 307 308 for (my $field=0; $field < @userInfoFields; $field++) { 309 if ($field > 0) { 310 for (my $i = 0; $i < 6; $i++) { 311 $scoringData[$i][$field] = ""; 312 } 313 } 314 $scoringData[6][$field] = $userInfoColumnHeadings[$field]; 315 for (my $user = 0; $user < @sortedUserIDs; $user++) { 316 my $fieldName = $userInfoFields[$field]; 317 $scoringData[$user + 7][$field] = $Users{$sortedUserIDs[$user]}->$fieldName; 318 } 319 } 320 } 321 return @scoringData if $format eq "info"; 322 323 # pre-fetch global problems 324 $WeBWorK::timer->continue("pre-fetching global problems for set $setID") if defined($WeBWorK::timer); 325 my %GlobalProblems = map { $_->problem_id => $_ } 326 $db->getAllGlobalProblems($setID); 327 $WeBWorK::timer->continue("done pre-fetching global problems for set $setID") if defined($WeBWorK::timer); 328 329 # pre-fetch user problems 330 $WeBWorK::timer->continue("pre-fetching user problems for set $setID") if defined($WeBWorK::timer); 331 my %UserProblems; # $UserProblems{$userID}{$problemID} 332 foreach my $userID (@sortedUserIDs) { 333 my %CurrUserProblems = map { $_->problem_id => $_ } 334 $db->getAllUserProblems($userID, $setID); 335 $UserProblems{$userID} = \%CurrUserProblems; 336 } 337 $WeBWorK::timer->continue("done pre-fetching user problems for set $setID") if defined($WeBWorK::timer); 338 339 # Write the problem data 340 my $dueDateString = $self->formatDateTime($setRecord->due_date); 341 my ($dueDate, $dueTime) = $dueDateString =~ m/^([^\s]*)\s*([^\s]*)$/; 342 my $valueTotal = 0; 343 my %userStatusTotals = (); 344 my %userSuccessIndex = (); 345 my %numberOfAttempts = (); 346 my $num_of_problems = @problemIDs; 347 for (my $problem = 0; $problem < @problemIDs; $problem++) { 348 349 #my $globalProblem = $db->getGlobalProblem($setID, $problemIDs[$problem]); #checked 350 my $globalProblem = $GlobalProblems{$problemIDs[$problem]}; 351 die "global problem $problemIDs[$problem] not found for set $setID" unless $globalProblem; 352 353 my $column = 5 + $problem * $columnsPerProblem; 354 if ($scoringItems->{header}) { 355 $scoringData[0][$column] = ""; 356 $scoringData[1][$column] = $setRecord->set_id; 357 $scoringData[2][$column] = $globalProblem->problem_id; 358 $scoringData[3][$column] = $dueDate; 359 $scoringData[4][$column] = $dueTime; 360 $scoringData[5][$column] = $globalProblem->value; 361 $scoringData[6][$column] = "STATUS"; 362 if ($scoringItems->{header} and $scoringItems->{problemAttempts}) { # Fill in with blanks, or maybe the problem number 363 for (my $row = 0; $row < 6; $row++) { 364 for (my $col = $column+1; $col <= $column + 2; $col++) { 365 if ($row == 2) { 366 $scoringData[$row][$col] = $globalProblem->problem_id; 367 } else { 368 $scoringData[$row][$col] = ""; 369 } 370 } 371 } 372 $scoringData[6][$column + 1] = "#corr"; 373 $scoringData[6][$column + 2] = "#incorr"; 374 } 375 } 376 $valueTotal += $globalProblem->value; 377 378 #my @userLoginIDs = $db->listUsers(); 379 #$WeBWorK::timer->continue("Begin getting user problems for set $setID, problem $problemIDs[$problem]") if defined($WeBWorK::timer); 380 ##my @userProblems = $db->getMergedProblems( map { [ $_, $setID, $problemIDs[$problem] ] } @userLoginIDs ); 381 #my @userProblems = $db->getUserProblems( map { [ $_, $setID, $problemIDs[$problem] ] } @userLoginIDs ); # checked 382 #my %userProblems; 383 #foreach my $item (@userProblems) { 384 # $userProblems{$item->user_id} = $item if ref $item; 385 #} 386 #$WeBWorK::timer->continue("End getting user problems for set $setID, problem $problemIDs[$problem]") if defined($WeBWorK::timer); 387 388 for (my $user = 0; $user < @sortedUserIDs; $user++) { 389 #my $userProblem = $userProblems{ $users{$userKeys[$user]}->user_id }; 390 #my $userProblem = $UserProblems{$sers{$userKeys[$user]}->user_id}{$problemIDs[$problem]}; 391 my $userProblem = $UserProblems{$sortedUserIDs[$user]}{$problemIDs[$problem]}; 392 unless (defined $userProblem) { # assume an empty problem record if the problem isn't assigned to this user 393 $userProblem = $db->newUserProblem; 394 $userProblem->status(0); 395 $userProblem->value(0); 396 $userProblem->num_correct(0); 397 $userProblem->num_incorrect(0); 398 } 399 $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; 400 #$userStatusTotals{$user} += $userProblem->status * $userProblem->value; 401 $userStatusTotals{$user} += $userProblem->status * $globalProblem->value; 402 if ($scoringItems->{successIndex}) { 403 $numberOfAttempts{$user} = 0 unless defined($numberOfAttempts{$user}); 404 my $num_correct = $userProblem->num_correct; 405 my $num_incorrect = $userProblem->num_incorrect; 406 $num_correct = ( defined($num_correct) and $num_correct) ? $num_correct : 0; 407 $num_incorrect = ( defined($num_incorrect) and $num_incorrect) ? $num_incorrect : 0; 408 $numberOfAttempts{$user} += $num_correct + $num_incorrect; 409 } 410 if ($scoringItems->{problemScores}) { 411 $scoringData[7 + $user][$column] = $userProblem->status; 412 if ($scoringItems->{problemAttempts}) { 413 $scoringData[7 + $user][$column + 1] = $userProblem->num_correct; 414 $scoringData[7 + $user][$column + 2] = $userProblem->num_incorrect; 415 } 416 } 417 } 418 } 419 if ($scoringItems->{successIndex}) { 420 for (my $user = 0; $user < @sortedUserIDs; $user++) { 421 my $avg_num_attempts = ($num_of_problems) ? $numberOfAttempts{$user}/$num_of_problems : 0; 422 $userSuccessIndex{$user} = ($avg_num_attempts) ? ($userStatusTotals{$user}/$valueTotal)**2/$avg_num_attempts : 0; 423 } 424 } 425 # write the status totals 426 if ($scoringItems->{setTotals}) { # Ironic, isn't it? 427 my $totalsColumn = $format eq "totals" ? 0 : 5 + @problemIDs * $columnsPerProblem; 428 $scoringData[0][$totalsColumn] = ""; 429 $scoringData[1][$totalsColumn] = $setRecord->set_id; 430 $scoringData[1][$totalsColumn+1] = $setRecord->set_id if $scoringItems->{successIndex}; 431 $scoringData[2][$totalsColumn] = ""; 432 $scoringData[3][$totalsColumn] = ""; 433 $scoringData[4][$totalsColumn] = ""; 434 $scoringData[5][$totalsColumn] = $valueTotal; 435 $scoringData[6][$totalsColumn] = "total"; 436 $scoringData[6][$totalsColumn+1] = "index" if $scoringItems->{successIndex}; 437 for (my $user = 0; $user < @sortedUserIDs; $user++) { 438 $scoringData[7+$user][$totalsColumn] = sprintf("%4.1f",$userStatusTotals{$user}); 439 $scoringData[7+$user][$totalsColumn+1] = sprintf("%4.1f",$userSuccessIndex{$user}) if $scoringItems->{successIndex}; 440 } 441 } 442 $WeBWorK::timer->continue("End set $setID") if defined($WeBWorK::timer); 443 return @scoringData; 444 } 445 446 # Often it's more efficient to just get everything out of the database 447 # and then pick out what you want later. Hence, these "everything2*" functions 448 sub everything2info { 449 my ($self, @everything) = @_; 450 my @result = (); 451 foreach my $row (@everything) { 452 push @result, [@{$row}[0..4]]; 453 } 454 return @result; 455 } 456 457 sub everything2normal { 458 my ($self, @everything) = @_; 459 my @result = (); 460 foreach my $row (@everything) { 461 my @row = @$row; 462 my @newRow = (); 463 push @newRow, @row[0..4]; 464 for (my $i = 5; $i < @row; $i+=3) { 465 push @newRow, $row[$i]; 466 } 467 #push @newRow, $row[$#row]; 468 push @result, [@newRow]; 469 } 470 return @result; 471 } 472 473 sub everything2full { 474 my ($self, @everything) = @_; 475 my @result = (); 476 foreach my $row (@everything) { 477 push @result, [@{$row}[0..($#{$row}-1)]]; 478 } 479 return @result; 480 } 481 482 sub everything2totals { 483 my ($self, @everything) = @_; 484 my @result = (); 485 foreach my $row (@everything) { 486 push @result, [${$row}[$#{$row}]]; 487 } 488 return @result; 489 } 490 491 sub appendColumns { 492 my ($self, $a1, $a2) = @_; 493 my @a1 = @$a1; 494 my @a2 = @$a2; 495 for (my $i = 0; $i < @a1; $i++) { 496 push @{$a1[$i]}, @{$a2[$i]}; 497 } 498 } 499 500 # Reads a CSV file and returns an array of arrayrefs, each containing a 501 # row of data: 502 # (["c1r1", "c1r2", "c1r3"], ["c2r1", "c2r2", "c2r3"]) 503 sub readCSV { 504 my ($self, $fileName) = @_; 505 my @result = (); 506 my @rows = split m/\n/, readFile($fileName); 507 foreach my $row (@rows) { 508 push @result, [split m/\s*,\s*/, $row]; 509 } 510 return @result; 511 } 512 513 # Write a CSV file from an array in the same format that readCSV produces 514 sub writeCSV { 515 my ($self, $filename, @csv) = @_; 516 517 my @lengths = (); 518 for (my $row = 0; $row < @csv; $row++) { 519 for (my $column = 0; $column < @{$csv[$row]}; $column++) { 520 $lengths[$column] = 0 unless defined $lengths[$column]; 521 $lengths[$column] = length $csv[$row][$column] if defined($csv[$row][$column]) and length $csv[$row][$column] > $lengths[$column]; 522 } 523 } 524 525 open my $fh, ">", $filename or warn "Unable to open $filename for writing"; 526 foreach my $row (@csv) { 527 my @rowPadded = (); 528 foreach (my $column = 0; $column < @$row; $column++) { 529 push @rowPadded, $self->pad($row->[$column], $lengths[$column] + 1); 530 } 531 print $fh join(",", @rowPadded); 532 print $fh "\n"; 533 } 534 close $fh; 535 } 536 537 # As soon as backwards compatability is no longer a concern and we don't expect to have 538 # to use old ww1.x code to read the output anymore, I recommend switching to using 539 # these routines, which are more versatile and compatable with other programs which 540 # deal with CSV files. 541 sub readStandardCSV { 542 my ($self, $fileName) = @_; 543 my @result = (); 544 my @rows = split m/\n/, readFile($fileName); 545 foreach my $row (@rows) { 546 push @result, [$self->splitQuoted($row)]; 547 } 548 return @result; 549 } 550 551 sub writeStandardCSV { 552 my ($self, $filename, @csv) = @_; 553 open my $fh, ">", $filename; 554 foreach my $row (@csv) { 555 print $fh (join ",", map {$self->quote($_)} @$row); 556 print $fh "\n"; 557 } 558 close $fh; 559 } 560 561 ### 562 563 # This particular unquote method unquotes (optionally) quoted strings in the 564 # traditional CSV style (double-quote for literal quote, etc.) 565 sub unquote { 566 my ($self, $string) = @_; 567 if ($string =~ m/^"(.*)"$/) { 568 $string = $1; 569 $string =~ s/""/"/; 570 } 571 return $string; 572 } 573 574 # Should you wish to treat whitespace differently, this routine has been designed 575 # to make it easy to do so. 576 sub splitQuoted { 577 my ($self, $string) = @_; 578 my ($leadingSpace, $preText, $quoted, $postText, $trailingSpace, $result); 579 my @result = (); 580 my $continue = 1; 581 while ($continue) { 582 $string =~ m/\G(\s*)/gc; 583 $leadingSpace = $1; 584 $string =~ m/\G([^",]*)/gc; 585 $preText = $1; 586 if ($string =~ m/\G"((?:[^"]|"")*)"/gc) { 587 $quoted = $1; 588 } 589 $string =~ m/\G([^,]*?)(\s*)(,?)/gc; 590 ($postText, $trailingSpace, $continue) = ($1, $2, $3); 591 592 $preText = "" unless defined $preText; 593 $postText = "" unless defined $postText; 594 $quoted = "" unless defined $quoted; 595 596 if ($quoted and (not $preText and not $postText)) { 597 $quoted =~ s/""/"/; 598 $result = $quoted; 599 } else { 600 $result = "$preText$quoted$postText"; 601 } 602 push @result, $result; 603 } 604 return @result; 605 } 606 607 # This particular quoting method does CSV-style (double a quote to escape it) quoting when necessary. 608 sub quote { 609 my ($self, $string) = @_; 610 if ($string =~ m/[", ]/) { 611 $string =~ s/"/""/; 612 $string = "\"$string\""; 613 } 614 return $string; 615 } 616 617 sub pad { 618 my ($self, $string, $padTo) = @_; 619 $string = '' unless defined $string; 620 my $spaces = $padTo - length $string; 621 return $string . " "x$spaces; 622 } 623 624 sub maxLength { 625 my ($self, $arrayRef) = @_; 626 my $max = 0; 627 foreach my $cell (@$arrayRef) { 628 $max = length $cell unless length $cell < $max; 629 } 630 return $max; 631 } 632 633 sub popup_set_form { 634 my $self = shift; 635 my $r = $self->r; 636 my $db = $r->db; 637 my $ce = $r->ce; 638 my $authz = $r->authz; 639 my $user = $r->param('user'); 640 641 my $root = $ce->{webworkURLs}->{root}; 642 my $courseName = $ce->{courseName}; 643 644 # return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 645 646 # This code will require changing if the permission and user tables ever have different keys. 647 my @setNames = (); 648 my $ra_set_records = $self->{ra_set_records}; 649 my %setLabels = ();# %$hr_classlistLabels; 650 my @set_records = sort {$a->set_id cmp $b->set_id } @{$ra_set_records}; 651 foreach my $sr (@set_records) { 652 $setLabels{$sr->set_id} = $sr->set_id; 653 push(@setNames, $sr->set_id); # reorder sets 654 } 655 return CGI::popup_menu(-name=>'selectedSet', 656 -values=>\@setNames, 657 -labels=>\%setLabels, 658 -size => 10, 659 -multiple => 1, 660 #-default=>$user 661 ), 662 663 664 } 665 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |