Parent Directory
| 
Revision Log
Revision 3275 - (view) (download) (as text)
| 1 : | sh002i | 1663 | ################################################################################ |
| 2 : | # WeBWorK Online Homework Delivery System | ||
| 3 : | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ | ||
| 4 : | toenail | 2246 | # $CVSHeader: |
| 5 : | sh002i | 1663 | # |
| 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 : | malsyned | 832 | package WeBWorK::ContentGenerator::Instructor::ProblemSetList; |
| 18 : | use base qw(WeBWorK::ContentGenerator::Instructor); | ||
| 19 : | |||
| 20 : | =head1 NAME | ||
| 21 : | |||
| 22 : | toenail | 2246 | WeBWorK::ContentGenerator::Instructor::ProblemSetList - Entry point for Set-specific |
| 23 : | data editing/viewing | ||
| 24 : | malsyned | 832 | |
| 25 : | =cut | ||
| 26 : | |||
| 27 : | toenail | 2246 | =for comment |
| 28 : | |||
| 29 : | What do we want to be able to do here? | ||
| 30 : | |||
| 31 : | filter sort edit publish import create delete | ||
| 32 : | |||
| 33 : | Filter what sets are shown: | ||
| 34 : | - none, all, selected | ||
| 35 : | toenail | 2278 | - matching set_id, visible to students, hidden from students |
| 36 : | toenail | 2246 | |
| 37 : | Sort sets by: | ||
| 38 : | - set name | ||
| 39 : | - open date | ||
| 40 : | - due date | ||
| 41 : | - answer date | ||
| 42 : | - header files | ||
| 43 : | - visibility to students | ||
| 44 : | |||
| 45 : | Switch from view mode to edit mode: | ||
| 46 : | - showing visible sets | ||
| 47 : | - showing selected sets | ||
| 48 : | Switch from edit mode to view and save changes | ||
| 49 : | Switch from edit mode to view and abandon changes | ||
| 50 : | |||
| 51 : | Make sets visible to or hidden from students: | ||
| 52 : | - all, selected | ||
| 53 : | |||
| 54 : | Import sets: | ||
| 55 : | - replace: | ||
| 56 : | - any users | ||
| 57 : | - visible users | ||
| 58 : | - selected users | ||
| 59 : | - no users | ||
| 60 : | - add: | ||
| 61 : | - any users | ||
| 62 : | - no users | ||
| 63 : | |||
| 64 : | toenail | 2272 | Score sets: |
| 65 : | - all | ||
| 66 : | - visible | ||
| 67 : | - selected | ||
| 68 : | |||
| 69 : | toenail | 2246 | Create a set with a given name |
| 70 : | |||
| 71 : | Delete sets: | ||
| 72 : | - visible | ||
| 73 : | - selected | ||
| 74 : | |||
| 75 : | =cut | ||
| 76 : | |||
| 77 : | gage | 2536 | # FIXME: rather than having two types of boolean modes $editMode and $exportMode |
| 78 : | # make one $mode variable that contains a string like "edit", "view", or "export" | ||
| 79 : | |||
| 80 : | malsyned | 832 | use strict; |
| 81 : | use warnings; | ||
| 82 : | use CGI qw(); | ||
| 83 : | glarose | 2343 | use WeBWorK::Utils qw(formatDateTime parseDateTime timeToSec readFile readDirectory cryptPassword); |
| 84 : | malsyned | 832 | |
| 85 : | toenail | 2280 | use constant HIDE_SETS_THRESHOLD => 50; |
| 86 : | use constant DEFAULT_PUBLISHED_STATE => 1; | ||
| 87 : | gage | 1428 | |
| 88 : | toenail | 2246 | use constant EDIT_FORMS => [qw(cancelEdit saveEdit)]; |
| 89 : | gage | 2536 | use constant VIEW_FORMS => [qw(filter sort edit publish import export score create delete)]; |
| 90 : | use constant EXPORT_FORMS => [qw(cancelExport saveExport)]; | ||
| 91 : | toenail | 2246 | |
| 92 : | gage | 2536 | use constant VIEW_FIELD_ORDER => [ qw( select set_id problems users published open_date due_date answer_date set_header hardcopy_header) ]; |
| 93 : | use constant EDIT_FIELD_ORDER => [ qw( set_id published open_date due_date answer_date set_header hardcopy_header) ]; | ||
| 94 : | use constant EXPORT_FIELD_ORDER => [ qw( select set_id filename) ]; | ||
| 95 : | toenail | 2246 | |
| 96 : | gage | 2536 | # permissions needed to perform a given action |
| 97 : | use constant FORM_PERMS => { | ||
| 98 : | saveEdit => "modify_problem_sets", | ||
| 99 : | edit => "modify_problem_sets", | ||
| 100 : | publish => "modify_problem_sets", | ||
| 101 : | import => "create_and_delete_problem_sets", | ||
| 102 : | export => "modify_set_def_files", | ||
| 103 : | saveExport => "modify_set_def_files", | ||
| 104 : | score => "score_sets", | ||
| 105 : | create => "create_and_delete_problem_sets", | ||
| 106 : | delete => "create_and_delete_problem_sets", | ||
| 107 : | }; | ||
| 108 : | toenail | 2246 | |
| 109 : | gage | 2536 | # permissions needed to view a given field |
| 110 : | use constant FIELD_PERMS => { | ||
| 111 : | problems => "modify_problem_sets", | ||
| 112 : | users => "assign_problem_sets", | ||
| 113 : | }; | ||
| 114 : | |||
| 115 : | use constant STATE_PARAMS => [qw(user effectiveUser key visible_sets no_visible_sets prev_visible_sets no_prev_visible_set editMode exportMode primarySortField secondarySortField)]; | ||
| 116 : | |||
| 117 : | toenail | 2246 | use constant SORT_SUBS => { |
| 118 : | set_id => \&bySetID, | ||
| 119 : | set_header => \&bySetHeader, | ||
| 120 : | gage | 2536 | hardcopy_header => \&byHardcopyHeader, |
| 121 : | toenail | 2246 | open_date => \&byOpenDate, |
| 122 : | due_date => \&byDueDate, | ||
| 123 : | answer_date => \&byAnswerDate, | ||
| 124 : | published => \&byPublished, | ||
| 125 : | |||
| 126 : | }; | ||
| 127 : | |||
| 128 : | use constant FIELD_PROPERTIES => { | ||
| 129 : | set_id => { | ||
| 130 : | type => "text", | ||
| 131 : | size => 8, | ||
| 132 : | access => "readonly", | ||
| 133 : | }, | ||
| 134 : | set_header => { | ||
| 135 : | type => "filelist", | ||
| 136 : | size => 10, | ||
| 137 : | access => "readwrite", | ||
| 138 : | }, | ||
| 139 : | gage | 2536 | hardcopy_header => { |
| 140 : | toenail | 2246 | type => "filelist", |
| 141 : | size => 10, | ||
| 142 : | access => "readwrite", | ||
| 143 : | }, | ||
| 144 : | open_date => { | ||
| 145 : | type => "text", | ||
| 146 : | size => 20, | ||
| 147 : | access => "readwrite", | ||
| 148 : | }, | ||
| 149 : | due_date => { | ||
| 150 : | type => "text", | ||
| 151 : | size => 20, | ||
| 152 : | access => "readwrite", | ||
| 153 : | }, | ||
| 154 : | answer_date => { | ||
| 155 : | type => "text", | ||
| 156 : | size => 20, | ||
| 157 : | access => "readwrite", | ||
| 158 : | }, | ||
| 159 : | published => { | ||
| 160 : | type => "checked", | ||
| 161 : | size => 4, | ||
| 162 : | access => "readwrite", | ||
| 163 : | glarose | 2343 | }, |
| 164 : | glarose | 2337 | assignment_type => { |
| 165 : | glarose | 2343 | type => "text", |
| 166 : | size => 20, | ||
| 167 : | access => "readwrite", | ||
| 168 : | }, | ||
| 169 : | glarose | 2337 | attempts_per_version => { |
| 170 : | glarose | 2343 | type => "text", |
| 171 : | size => 4, | ||
| 172 : | access => "readwrite", | ||
| 173 : | }, | ||
| 174 : | glarose | 2337 | time_interval => { |
| 175 : | glarose | 2343 | type => "text", |
| 176 : | size => 10, | ||
| 177 : | access => "readwrite", | ||
| 178 : | }, | ||
| 179 : | glarose | 2337 | versions_per_interval => { |
| 180 : | glarose | 2343 | type => "text", |
| 181 : | size => 4, | ||
| 182 : | access => "readwrite", | ||
| 183 : | }, | ||
| 184 : | glarose | 2337 | version_time_limit => { |
| 185 : | glarose | 2343 | type => "text", |
| 186 : | size => 10, | ||
| 187 : | access => "readwrite", | ||
| 188 : | }, | ||
| 189 : | problem_randorder => { | ||
| 190 : | type => "text", | ||
| 191 : | size => 4, | ||
| 192 : | access => "readwrite", | ||
| 193 : | }, | ||
| 194 : | glarose | 2337 | version_creation_time => { |
| 195 : | glarose | 2343 | type => "text", |
| 196 : | size => 10, | ||
| 197 : | access => "readonly", | ||
| 198 : | }, | ||
| 199 : | glarose | 3186 | version_last_attempt_time => { |
| 200 : | type => "text", | ||
| 201 : | size => 10, | ||
| 202 : | access => "readonly", | ||
| 203 : | }, | ||
| 204 : | toenail | 2246 | }; |
| 205 : | |||
| 206 : | toenail | 2272 | sub pre_header_initialize { |
| 207 : | toenail | 2246 | my ($self) = @_; |
| 208 : | my $r = $self->r; | ||
| 209 : | my $db = $r->db; | ||
| 210 : | my $ce = $r->ce; | ||
| 211 : | my $authz = $r->authz; | ||
| 212 : | toenail | 2272 | my $urlpath = $r->urlpath; |
| 213 : | toenail | 2246 | my $user = $r->param('user'); |
| 214 : | toenail | 2272 | my $courseName = $urlpath->arg("courseID"); |
| 215 : | toenail | 2246 | |
| 216 : | toenail | 2272 | |
| 217 : | gage | 2536 | # Check permissions |
| 218 : | return unless $authz->hasPermissions($user, "access_instructor_tools"); | ||
| 219 : | |||
| 220 : | if (defined $r->param("action") and $r->param("action") eq "score" and $authz->hasPermissions($user, "score_sets")) { | ||
| 221 : | toenail | 2272 | my $scope = $r->param("action.score.scope"); |
| 222 : | my @setsToScore = (); | ||
| 223 : | |||
| 224 : | if ($scope eq "none") { | ||
| 225 : | return "No sets selected for scoring."; | ||
| 226 : | } elsif ($scope eq "all") { | ||
| 227 : | @setsToScore = @{ $r->param("allSetIDs") }; | ||
| 228 : | } elsif ($scope eq "visible") { | ||
| 229 : | @setsToScore = @{ $r->param("visibleSetIDs") }; | ||
| 230 : | } elsif ($scope eq "selected") { | ||
| 231 : | @setsToScore = $r->param("selected_sets"); | ||
| 232 : | } | ||
| 233 : | |||
| 234 : | my $uri = $self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', courseID=>$courseName), | ||
| 235 : | params=>{ | ||
| 236 : | scoreSelected=>"ScoreSelected", | ||
| 237 : | selectedSet=>\@setsToScore, | ||
| 238 : | # recordSingleSetScores=>'' | ||
| 239 : | } | ||
| 240 : | ); | ||
| 241 : | |||
| 242 : | $self->reply_with_redirect($uri); | ||
| 243 : | malsyned | 1410 | } |
| 244 : | toenail | 2272 | |
| 245 : | } | ||
| 246 : | |||
| 247 : | toenail | 2246 | sub body { |
| 248 : | my ($self) = @_; | ||
| 249 : | my $r = $self->r; | ||
| 250 : | my $urlpath = $r->urlpath; | ||
| 251 : | my $db = $r->db; | ||
| 252 : | my $ce = $r->ce; | ||
| 253 : | my $authz = $r->authz; | ||
| 254 : | my $courseName = $urlpath->arg("courseID"); | ||
| 255 : | my $setID = $urlpath->arg("setID"); | ||
| 256 : | my $user = $r->param('user'); | ||
| 257 : | malsyned | 963 | |
| 258 : | toenail | 2246 | my $root = $ce->{webworkURLs}->{root}; |
| 259 : | |||
| 260 : | # templates for getting field names | ||
| 261 : | my $setTemplate = $self->{setTemplate} = $db->newGlobalSet; | ||
| 262 : | |||
| 263 : | gage | 2536 | return CGI::div({class => "ResultsWithError"}, "You are not authorized to access the Instructor tools.") |
| 264 : | toenail | 2246 | unless $authz->hasPermissions($user, "access_instructor_tools"); |
| 265 : | |||
| 266 : | # This table can be consulted when display-ready forms of field names are needed. | ||
| 267 : | my %prettyFieldNames = map { $_ => $_ } | ||
| 268 : | $setTemplate->FIELDS(); | ||
| 269 : | |||
| 270 : | @prettyFieldNames{qw( | ||
| 271 : | select | ||
| 272 : | problems | ||
| 273 : | users | ||
| 274 : | gage | 2536 | filename |
| 275 : | toenail | 2246 | set_id |
| 276 : | set_header | ||
| 277 : | gage | 2536 | hardcopy_header |
| 278 : | toenail | 2246 | open_date |
| 279 : | due_date | ||
| 280 : | answer_date | ||
| 281 : | published | ||
| 282 : | )} = ( | ||
| 283 : | "Select", | ||
| 284 : | "Problems", | ||
| 285 : | "Assigned Users", | ||
| 286 : | gage | 2536 | "Set Definition Filename", |
| 287 : | toenail | 2246 | "Set Name", |
| 288 : | "Set Header", | ||
| 289 : | gage | 2536 | "Hardcopy Header", |
| 290 : | toenail | 2246 | "Open Date", |
| 291 : | "Due Date", | ||
| 292 : | "Answer Date", | ||
| 293 : | "Visible", | ||
| 294 : | ); | ||
| 295 : | |||
| 296 : | ########## set initial values for state fields | ||
| 297 : | |||
| 298 : | my @allSetIDs = $db->listGlobalSets; | ||
| 299 : | my @users = $db->listUsers; | ||
| 300 : | $self->{allSetIDs} = \@allSetIDs; | ||
| 301 : | $self->{totalUsers} = scalar @users; | ||
| 302 : | |||
| 303 : | if (defined $r->param("visible_sets")) { | ||
| 304 : | $self->{visibleSetIDs} = [ $r->param("visible_sets") ]; | ||
| 305 : | } elsif (defined $r->param("no_visible_sets")) { | ||
| 306 : | $self->{visibleSetIDs} = []; | ||
| 307 : | } else { | ||
| 308 : | if (@allSetIDs > HIDE_SETS_THRESHOLD) { | ||
| 309 : | $self->{visibleSetIDs} = []; | ||
| 310 : | } else { | ||
| 311 : | $self->{visibleSetIDs} = [ @allSetIDs ]; | ||
| 312 : | } | ||
| 313 : | malsyned | 1017 | } |
| 314 : | toenail | 2246 | |
| 315 : | $self->{prevVisibleSetIDs} = $self->{visibleSetIDs}; | ||
| 316 : | |||
| 317 : | if (defined $r->param("selected_sets")) { | ||
| 318 : | $self->{selectedSetIDs} = [ $r->param("selected_sets") ]; | ||
| 319 : | } else { | ||
| 320 : | $self->{selectedSetIDs} = []; | ||
| 321 : | gage | 1843 | } |
| 322 : | toenail | 2246 | |
| 323 : | $self->{editMode} = $r->param("editMode") || 0; | ||
| 324 : | |||
| 325 : | gage | 2536 | return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify problem sets.")) |
| 326 : | if $self->{editMode} and not $authz->hasPermissions($user, "modify_problem_sets"); | ||
| 327 : | |||
| 328 : | $self->{exportMode} = $r->param("exportMode") || 0; | ||
| 329 : | |||
| 330 : | return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify set definition files.")) | ||
| 331 : | if $self->{exportMode} and not $authz->hasPermissions($user, "modify_set_def_files"); | ||
| 332 : | |||
| 333 : | toenail | 2246 | $self->{primarySortField} = $r->param("primarySortField") || "due_date"; |
| 334 : | $self->{secondarySortField} = $r->param("secondarySortField") || "open_date"; | ||
| 335 : | |||
| 336 : | my @allSets = $db->getGlobalSets(@allSetIDs); | ||
| 337 : | |||
| 338 : | my (%open_dates, %due_dates, %answer_dates); | ||
| 339 : | foreach my $Set (@allSets) { | ||
| 340 : | push @{$open_dates{defined $Set->open_date ? $Set->open_date : ""}}, $Set->set_id; | ||
| 341 : | push @{$due_dates{defined $Set->due_date ? $Set->due_date : ""}}, $Set->set_id; | ||
| 342 : | push @{$answer_dates{defined $Set->answer_date ? $Set->answer_date : ""}}, $Set->set_id; | ||
| 343 : | } | ||
| 344 : | $self->{open_dates} = \%open_dates; | ||
| 345 : | $self->{due_dates} = \%due_dates; | ||
| 346 : | $self->{answer_dates} = \%answer_dates; | ||
| 347 : | |||
| 348 : | ########## call action handler | ||
| 349 : | |||
| 350 : | my $actionID = $r->param("action"); | ||
| 351 : | if ($actionID) { | ||
| 352 : | gage | 2536 | unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ EXPORT_FORMS() }) { |
| 353 : | toenail | 2246 | die "Action $actionID not found"; |
| 354 : | malsyned | 963 | } |
| 355 : | gage | 2536 | # Check permissions |
| 356 : | if (not FORM_PERMS()->{$actionID} or $authz->hasPermissions($user, FORM_PERMS()->{$actionID})) { | ||
| 357 : | my $actionHandler = "${actionID}_handler"; | ||
| 358 : | my %genericParams; | ||
| 359 : | foreach my $param (qw(selected_sets)) { | ||
| 360 : | $genericParams{$param} = [ $r->param($param) ]; | ||
| 361 : | } | ||
| 362 : | my %actionParams = $self->getActionParams($actionID); | ||
| 363 : | my %tableParams = $self->getTableParams(); | ||
| 364 : | print CGI::div({class=>"Message"}, CGI::p("Results of last action performed: ", $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams))), CGI::hr(); | ||
| 365 : | } else { | ||
| 366 : | return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to perform this action.")); | ||
| 367 : | toenail | 2210 | } |
| 368 : | gage | 2536 | |
| 369 : | toenail | 2246 | } |
| 370 : | gage | 1428 | |
| 371 : | toenail | 2246 | ########## retrieve possibly changed values for member fields |
| 372 : | |||
| 373 : | @allSetIDs = @{ $self->{allSetIDs} }; # do we need this one? YES, deleting or importing a set will change this. | ||
| 374 : | my @visibleSetIDs = @{ $self->{visibleSetIDs} }; | ||
| 375 : | my @prevVisibleSetIDs = @{ $self->{prevVisibleSetIDs} }; | ||
| 376 : | my @selectedSetIDs = @{ $self->{selectedSetIDs} }; | ||
| 377 : | my $editMode = $self->{editMode}; | ||
| 378 : | gage | 2536 | my $exportMode = $self->{exportMode}; |
| 379 : | toenail | 2246 | my $primarySortField = $self->{primarySortField}; |
| 380 : | my $secondarySortField = $self->{secondarySortField}; | ||
| 381 : | |||
| 382 : | #warn "visibleSetIDs=@visibleSetIDs\n"; | ||
| 383 : | #warn "prevVisibleSetIDs=@prevVisibleSetIDs\n"; | ||
| 384 : | #warn "selectedSetIDs=@selectedSetIDs\n"; | ||
| 385 : | #warn "editMode=$editMode\n"; | ||
| 386 : | |||
| 387 : | ########## get required users | ||
| 388 : | |||
| 389 : | my @Sets = grep { defined $_ } @visibleSetIDs ? $db->getGlobalSets(@visibleSetIDs) : (); | ||
| 390 : | |||
| 391 : | # presort users | ||
| 392 : | my %sortSubs = %{ SORT_SUBS() }; | ||
| 393 : | my $primarySortSub = $sortSubs{$primarySortField}; | ||
| 394 : | my $secondarySortSub = $sortSubs{$secondarySortField}; | ||
| 395 : | |||
| 396 : | # don't forget to sort in opposite order of importance | ||
| 397 : | @Sets = sort $secondarySortSub @Sets; | ||
| 398 : | @Sets = sort $primarySortSub @Sets; | ||
| 399 : | sh002i | 1660 | |
| 400 : | toenail | 2246 | ########## print beginning of form |
| 401 : | |||
| 402 : | print CGI::start_form({method=>"post", action=>$self->systemLink($urlpath,authen=>0), name=>"problemsetlist"}); | ||
| 403 : | print $self->hidden_authen_fields(); | ||
| 404 : | |||
| 405 : | ########## print state data | ||
| 406 : | |||
| 407 : | print "\n<!-- state data here -->\n"; | ||
| 408 : | |||
| 409 : | if (@visibleSetIDs) { | ||
| 410 : | print CGI::hidden(-name=>"visible_sets", -value=>\@visibleSetIDs); | ||
| 411 : | } else { | ||
| 412 : | print CGI::hidden(-name=>"no_visible_sets", -value=>"1"); | ||
| 413 : | } | ||
| 414 : | |||
| 415 : | if (@prevVisibleSetIDs) { | ||
| 416 : | print CGI::hidden(-name=>"prev_visible_sets", -value=>\@prevVisibleSetIDs); | ||
| 417 : | } else { | ||
| 418 : | print CGI::hidden(-name=>"no_prev_visible_sets", -value=>"1"); | ||
| 419 : | } | ||
| 420 : | |||
| 421 : | print CGI::hidden(-name=>"editMode", -value=>$editMode); | ||
| 422 : | gage | 2536 | print CGI::hidden(-name=>"exportMode", -value=>$exportMode); |
| 423 : | toenail | 2246 | |
| 424 : | print CGI::hidden(-name=>"primarySortField", -value=>$primarySortField); | ||
| 425 : | print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField); | ||
| 426 : | |||
| 427 : | print "\n<!-- state data here -->\n"; | ||
| 428 : | |||
| 429 : | ########## print action forms | ||
| 430 : | |||
| 431 : | print CGI::start_table({}); | ||
| 432 : | print CGI::Tr({}, CGI::td({-colspan=>2}, "Select an action to perform:")); | ||
| 433 : | |||
| 434 : | my @formsToShow; | ||
| 435 : | if ($editMode) { | ||
| 436 : | @formsToShow = @{ EDIT_FORMS() }; | ||
| 437 : | } else { | ||
| 438 : | @formsToShow = @{ VIEW_FORMS() }; | ||
| 439 : | } | ||
| 440 : | |||
| 441 : | gage | 2536 | if ($exportMode) { |
| 442 : | @formsToShow = @{ EXPORT_FORMS() }; | ||
| 443 : | } | ||
| 444 : | |||
| 445 : | toenail | 2246 | my $i = 0; |
| 446 : | foreach my $actionID (@formsToShow) { | ||
| 447 : | gage | 2536 | # Check permissions |
| 448 : | next if FORM_PERMS()->{$actionID} and not $authz->hasPermissions($user, FORM_PERMS()->{$actionID}); | ||
| 449 : | toenail | 2246 | my $actionForm = "${actionID}_form"; |
| 450 : | my $onChange = "document.problemsetlist.action[$i].checked=true"; | ||
| 451 : | my %actionParams = $self->getActionParams($actionID); | ||
| 452 : | |||
| 453 : | print CGI::Tr({-valign=>"top"}, | ||
| 454 : | CGI::td({}, CGI::input({-type=>"radio", -name=>"action", -value=>$actionID})), | ||
| 455 : | CGI::td({}, $self->$actionForm($onChange, %actionParams)) | ||
| 456 : | ); | ||
| 457 : | |||
| 458 : | $i++; | ||
| 459 : | } | ||
| 460 : | |||
| 461 : | print CGI::Tr({}, CGI::td({-colspan=>2, -align=>"center"}, | ||
| 462 : | CGI::submit(-value=>"Take Action!")) | ||
| 463 : | ); | ||
| 464 : | print CGI::end_table(); | ||
| 465 : | |||
| 466 : | ########## print table | ||
| 467 : | |||
| 468 : | print CGI::p("Showing ", scalar @visibleSetIDs, " out of ", scalar @allSetIDs, " sets."); | ||
| 469 : | |||
| 470 : | $self->printTableHTML(\@Sets, \%prettyFieldNames, | ||
| 471 : | editMode => $editMode, | ||
| 472 : | gage | 2536 | exportMode => $exportMode, |
| 473 : | toenail | 2246 | selectedSetIDs => \@selectedSetIDs, |
| 474 : | ); | ||
| 475 : | |||
| 476 : | |||
| 477 : | ########## print end of form | ||
| 478 : | |||
| 479 : | print CGI::end_form(); | ||
| 480 : | sh002i | 1660 | |
| 481 : | toenail | 2246 | return ""; |
| 482 : | } | ||
| 483 : | sh002i | 1660 | |
| 484 : | toenail | 2246 | ################################################################################ |
| 485 : | # extract particular params and put them in a hash (values are ARRAYREFs!) | ||
| 486 : | ################################################################################ | ||
| 487 : | |||
| 488 : | sub getActionParams { | ||
| 489 : | my ($self, $actionID) = @_; | ||
| 490 : | my $r = $self->{r}; | ||
| 491 : | |||
| 492 : | my %actionParams; | ||
| 493 : | foreach my $param ($r->param) { | ||
| 494 : | next unless $param =~ m/^action\.$actionID\./; | ||
| 495 : | $actionParams{$param} = [ $r->param($param) ]; | ||
| 496 : | } | ||
| 497 : | return %actionParams; | ||
| 498 : | } | ||
| 499 : | |||
| 500 : | sub getTableParams { | ||
| 501 : | my ($self) = @_; | ||
| 502 : | my $r = $self->{r}; | ||
| 503 : | |||
| 504 : | my %tableParams; | ||
| 505 : | foreach my $param ($r->param) { | ||
| 506 : | next unless $param =~ m/^(?:set)\./; | ||
| 507 : | $tableParams{$param} = [ $r->param($param) ]; | ||
| 508 : | } | ||
| 509 : | return %tableParams; | ||
| 510 : | } | ||
| 511 : | |||
| 512 : | ################################################################################ | ||
| 513 : | # actions and action triggers | ||
| 514 : | ################################################################################ | ||
| 515 : | |||
| 516 : | # filter, edit, cancelEdit, and saveEdit should stay with the display module and | ||
| 517 : | # not be real "actions". that way, all actions are shown in view mode and no | ||
| 518 : | # actions are shown in edit mode. | ||
| 519 : | |||
| 520 : | sub filter_form { | ||
| 521 : | my ($self, $onChange, %actionParams) = @_; | ||
| 522 : | #return CGI::table({}, CGI::Tr({-valign=>"top"}, | ||
| 523 : | # CGI::td({}, | ||
| 524 : | return join("", | ||
| 525 : | "Show ", | ||
| 526 : | CGI::popup_menu( | ||
| 527 : | -name => "action.filter.scope", | ||
| 528 : | -values => [qw(all none selected match_ids published unpublished)], | ||
| 529 : | -default => $actionParams{"action.filter.scope"}->[0] || "match_ids", | ||
| 530 : | -labels => { | ||
| 531 : | all => "all sets", | ||
| 532 : | none => "no sets", | ||
| 533 : | selected => "sets checked below", | ||
| 534 : | published => "sets visible to students", | ||
| 535 : | unpublished => "sets hidden from students", | ||
| 536 : | match_ids => "sets with matching set IDs:", | ||
| 537 : | }, | ||
| 538 : | -onchange => $onChange, | ||
| 539 : | ), | ||
| 540 : | " ", | ||
| 541 : | CGI::textfield( | ||
| 542 : | -name => "action.filter.set_ids", | ||
| 543 : | -value => $actionParams{"action.filter.set_ids"}->[0] || "",, | ||
| 544 : | -width => "50", | ||
| 545 : | -onchange => $onChange, | ||
| 546 : | ), | ||
| 547 : | " (separate multiple IDs with commas)", | ||
| 548 : | CGI::br(), | ||
| 549 : | # "Open dates: ", | ||
| 550 : | # CGI::popup_menu( | ||
| 551 : | # -name => "action.filter.open_date", | ||
| 552 : | # -values => [ keys %{ $self->{open_dates} } ], | ||
| 553 : | # -default => $actionParams{"action.filter.open_date"}->[0] || "", | ||
| 554 : | # -labels => { $self->menuLabels($self->{open_dates}) }, | ||
| 555 : | # -onchange => $onChange, | ||
| 556 : | # ), | ||
| 557 : | # " Due dates: ", | ||
| 558 : | # CGI::popup_menu( | ||
| 559 : | # -name => "action.filter.due_date", | ||
| 560 : | # -values => [ keys %{ $self->{due_dates} } ], | ||
| 561 : | # -default => $actionParams{"action.filter.due_date"}->[0] || "", | ||
| 562 : | # -labels => { $self->menuLabels($self->{due_dates}) }, | ||
| 563 : | # -onchange => $onChange, | ||
| 564 : | # ), | ||
| 565 : | # " Answer dates: ", | ||
| 566 : | # CGI::popup_menu( | ||
| 567 : | # -name => "action.filter.answer_date", | ||
| 568 : | # -values => [ keys %{ $self->{answer_dates} } ], | ||
| 569 : | # -default => $actionParams{"action.filter.answer_date"}->[0] || "", | ||
| 570 : | # -labels => { $self->menuLabels($self->{answer_dates}) }, | ||
| 571 : | # -onchange => $onChange, | ||
| 572 : | # ), | ||
| 573 : | sh002i | 1660 | |
| 574 : | toenail | 2246 | ); |
| 575 : | malsyned | 963 | } |
| 576 : | |||
| 577 : | toenail | 2246 | # this action handler modifies the "visibleUserIDs" field based on the contents |
| 578 : | # of the "action.filter.scope" parameter and the "selected_users" | ||
| 579 : | sub filter_handler { | ||
| 580 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 581 : | |||
| 582 : | my $r = $self->r ; | ||
| 583 : | my $db = $r->db; | ||
| 584 : | |||
| 585 : | my $result; | ||
| 586 : | |||
| 587 : | my $scope = $actionParams->{"action.filter.scope"}->[0]; | ||
| 588 : | if ($scope eq "all") { | ||
| 589 : | $result = "showing all sets"; | ||
| 590 : | $self->{visibleSetIDs} = $self->{allSetIDs}; | ||
| 591 : | } elsif ($scope eq "none") { | ||
| 592 : | $result = "showing no sets"; | ||
| 593 : | $self->{visibleSetIDs} = []; | ||
| 594 : | } elsif ($scope eq "selected") { | ||
| 595 : | $result = "showing selected sets"; | ||
| 596 : | $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref | ||
| 597 : | } elsif ($scope eq "match_ids") { | ||
| 598 : | my @setIDs = split /\s*,\s*/, $actionParams->{"action.filter.set_ids"}->[0]; | ||
| 599 : | $self->{visibleSetIDs} = \@setIDs; | ||
| 600 : | } elsif ($scope eq "match_open_date") { | ||
| 601 : | my $open_date = $actionParams->{"action.filter.open_date"}->[0]; | ||
| 602 : | $self->{visibleSetIDs} = $self->{open_dates}->{$open_date}; # an arrayref | ||
| 603 : | } elsif ($scope eq "match_due_date") { | ||
| 604 : | my $due_date = $actionParams->{"action.filter.due_date"}->[0]; | ||
| 605 : | $self->{visibleSetIDs} = $self->{due_date}->{$due_date}; # an arrayref | ||
| 606 : | } elsif ($scope eq "match_answer_date") { | ||
| 607 : | my $answer_date = $actionParams->{"action.filter.answer_date"}->[0]; | ||
| 608 : | $self->{visibleSetIDs} = $self->{answer_dates}->{$answer_date}; # an arrayref | ||
| 609 : | } elsif ($scope eq "published") { | ||
| 610 : | my @setRecords = $db->getGlobalSets(@{$self->{allSetIDs}}); | ||
| 611 : | my @publishedSetIDs = map { $_->published ? $_->set_id : ""} @setRecords; | ||
| 612 : | $self->{visibleSetIDs} = \@publishedSetIDs; | ||
| 613 : | } elsif ($scope eq "unpublished") { | ||
| 614 : | my @setRecords = $db->getGlobalSets(@{$self->{allSetIDs}}); | ||
| 615 : | my @unpublishedSetIDs = map { (not $_->published) ? $_->set_id : ""} @setRecords; | ||
| 616 : | $self->{visibleSetIDs} = \@unpublishedSetIDs; | ||
| 617 : | } | ||
| 618 : | |||
| 619 : | return $result; | ||
| 620 : | } | ||
| 621 : | gage | 1295 | |
| 622 : | toenail | 2246 | sub sort_form { |
| 623 : | my ($self, $onChange, %actionParams) = @_; | ||
| 624 : | return join ("", | ||
| 625 : | "Primary sort: ", | ||
| 626 : | CGI::popup_menu( | ||
| 627 : | -name => "action.sort.primary", | ||
| 628 : | gage | 2536 | -values => [qw(set_id set_header hardcopy_header open_date due_date answer_date published)], |
| 629 : | toenail | 2246 | -default => $actionParams{"action.sort.primary"}->[0] || "due_date", |
| 630 : | -labels => { | ||
| 631 : | toenail | 2290 | set_id => "Set Name", |
| 632 : | set_header => "Set Header", | ||
| 633 : | gage | 2536 | hardcopy_header => "Hardcopy Header", |
| 634 : | toenail | 2290 | open_date => "Open Date", |
| 635 : | due_date => "Due Date", | ||
| 636 : | answer_date => "Answer Date", | ||
| 637 : | published => "Visibility", | ||
| 638 : | toenail | 2246 | }, |
| 639 : | -onchange => $onChange, | ||
| 640 : | ), | ||
| 641 : | " Secondary sort: ", | ||
| 642 : | CGI::popup_menu( | ||
| 643 : | -name => "action.sort.secondary", | ||
| 644 : | gage | 2536 | -values => [qw(set_id set_header hardcopy_header open_date due_date answer_date published)], |
| 645 : | toenail | 2246 | -default => $actionParams{"action.sort.secondary"}->[0] || "open_date", |
| 646 : | -labels => { | ||
| 647 : | toenail | 2290 | set_id => "Set Name", |
| 648 : | set_header => "Set Header", | ||
| 649 : | gage | 2536 | hardcopy_header => "Hardcopy Header", |
| 650 : | toenail | 2290 | open_date => "Open Date", |
| 651 : | due_date => "Due Date", | ||
| 652 : | answer_date => "Answer Date", | ||
| 653 : | published => "Visibility", | ||
| 654 : | toenail | 2246 | }, |
| 655 : | -onchange => $onChange, | ||
| 656 : | ), | ||
| 657 : | ".", | ||
| 658 : | ); | ||
| 659 : | } | ||
| 660 : | malsyned | 836 | |
| 661 : | toenail | 2246 | sub sort_handler { |
| 662 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 663 : | |||
| 664 : | my $primary = $actionParams->{"action.sort.primary"}->[0]; | ||
| 665 : | my $secondary = $actionParams->{"action.sort.secondary"}->[0]; | ||
| 666 : | |||
| 667 : | $self->{primarySortField} = $primary; | ||
| 668 : | $self->{secondarySortField} = $secondary; | ||
| 669 : | gage | 1928 | |
| 670 : | toenail | 2246 | my %names = ( |
| 671 : | toenail | 2290 | set_id => "Set Name", |
| 672 : | set_header => "Set Header", | ||
| 673 : | gage | 2536 | hardcopy_header => "Hardcopy Header", |
| 674 : | toenail | 2290 | open_date => "Open Date", |
| 675 : | due_date => "Due Date", | ||
| 676 : | answer_date => "Answer Date", | ||
| 677 : | published => "Visibility", | ||
| 678 : | toenail | 2246 | ); |
| 679 : | gage | 1934 | |
| 680 : | toenail | 2246 | return "sort by $names{$primary} and then by $names{$secondary}."; |
| 681 : | } | ||
| 682 : | |||
| 683 : | |||
| 684 : | sub edit_form { | ||
| 685 : | my ($self, $onChange, %actionParams) = @_; | ||
| 686 : | gage | 2536 | |
| 687 : | toenail | 2246 | return join("", |
| 688 : | "Edit ", | ||
| 689 : | CGI::popup_menu( | ||
| 690 : | -name => "action.edit.scope", | ||
| 691 : | -values => [qw(all visible selected)], | ||
| 692 : | -default => $actionParams{"action.edit.scope"}->[0] || "selected", | ||
| 693 : | -labels => { | ||
| 694 : | all => "all sets", | ||
| 695 : | visible => "visible sets", | ||
| 696 : | selected => "selected sets", | ||
| 697 : | }, | ||
| 698 : | -onchange => $onChange, | ||
| 699 : | ), | ||
| 700 : | ); | ||
| 701 : | } | ||
| 702 : | |||
| 703 : | sub edit_handler { | ||
| 704 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 705 : | toenail | 2272 | |
| 706 : | toenail | 2246 | my $result; |
| 707 : | |||
| 708 : | my $scope = $actionParams->{"action.edit.scope"}->[0]; | ||
| 709 : | if ($scope eq "all") { | ||
| 710 : | $result = "editing all sets"; | ||
| 711 : | $self->{visibleSetIDs} = $self->{allSetIDs}; | ||
| 712 : | } elsif ($scope eq "visible") { | ||
| 713 : | $result = "editing visible sets"; | ||
| 714 : | # leave visibleUserIDs alone | ||
| 715 : | } elsif ($scope eq "selected") { | ||
| 716 : | $result = "editing selected sets"; | ||
| 717 : | $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref | ||
| 718 : | } | ||
| 719 : | $self->{editMode} = 1; | ||
| 720 : | |||
| 721 : | return $result; | ||
| 722 : | } | ||
| 723 : | |||
| 724 : | sub publish_form { | ||
| 725 : | my ($self, $onChange, %actionParams) = @_; | ||
| 726 : | |||
| 727 : | return join ("", | ||
| 728 : | "Make ", | ||
| 729 : | CGI::popup_menu( | ||
| 730 : | -name => "action.publish.scope", | ||
| 731 : | -values => [ qw(none all selected) ], | ||
| 732 : | toenail | 2249 | -default => $actionParams{"action.publish.scope"}->[0] || "selected", |
| 733 : | toenail | 2246 | -labels => { |
| 734 : | none => "", | ||
| 735 : | all => "all sets", | ||
| 736 : | # visible => "visible sets", | ||
| 737 : | selected => "selected sets", | ||
| 738 : | }, | ||
| 739 : | -onchange => $onChange, | ||
| 740 : | ), | ||
| 741 : | CGI::popup_menu( | ||
| 742 : | -name => "action.publish.value", | ||
| 743 : | -values => [ 0, 1 ], | ||
| 744 : | -default => $actionParams{"action.publish.value"}->[0] || "1", | ||
| 745 : | -labels => { | ||
| 746 : | 0 => "hidden", | ||
| 747 : | 1 => "visible", | ||
| 748 : | }, | ||
| 749 : | -onchange => $onChange, | ||
| 750 : | ), | ||
| 751 : | " for students.", | ||
| 752 : | gage | 1934 | ); |
| 753 : | toenail | 2246 | } |
| 754 : | |||
| 755 : | sub publish_handler { | ||
| 756 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 757 : | toenail | 2272 | |
| 758 : | gage | 2536 | my $r = $self->r; |
| 759 : | my $db = $r->db; | ||
| 760 : | toenail | 2272 | |
| 761 : | toenail | 2246 | my $result = ""; |
| 762 : | gage | 1606 | |
| 763 : | toenail | 2246 | my $scope = $actionParams->{"action.publish.scope"}->[0]; |
| 764 : | my $value = $actionParams->{"action.publish.value"}->[0]; | ||
| 765 : | |||
| 766 : | my $verb = $value ? "made visible for" : "hidden from"; | ||
| 767 : | gage | 1843 | |
| 768 : | toenail | 2246 | my @setIDs; |
| 769 : | |||
| 770 : | if ($scope eq "none") { # FIXME: double negative "Make no sets hidden" might make professor expect all sets to be made visible. | ||
| 771 : | @setIDs = (); | ||
| 772 : | $result = "No change made to any set."; | ||
| 773 : | } elsif ($scope eq "all") { | ||
| 774 : | @setIDs = @{ $self->{allSetIDs} }; | ||
| 775 : | $result = "All sets $verb all students."; | ||
| 776 : | } elsif ($scope eq "visible") { | ||
| 777 : | @setIDs = @{ $self->{visibleSetIDs} }; | ||
| 778 : | $result = "All visible sets $verb all students."; | ||
| 779 : | } elsif ($scope eq "selected") { | ||
| 780 : | @setIDs = @{ $genericParams->{selected_sets} }; | ||
| 781 : | $result = "All selected sets $verb all students."; | ||
| 782 : | malsyned | 883 | } |
| 783 : | |||
| 784 : | toenail | 2246 | my @sets = $db->getGlobalSets(@setIDs); |
| 785 : | |||
| 786 : | map { $_->published("$value") if $_; $db->putGlobalSet($_); } @sets; | ||
| 787 : | |||
| 788 : | return $result | ||
| 789 : | |||
| 790 : | } | ||
| 791 : | gage | 1606 | |
| 792 : | toenail | 2272 | sub score_form { |
| 793 : | my ($self, $onChange, %actionParams) = @_; | ||
| 794 : | toenail | 2246 | |
| 795 : | toenail | 2272 | return join ("", |
| 796 : | "Score ", | ||
| 797 : | toenail | 2246 | CGI::popup_menu( |
| 798 : | toenail | 2272 | -name => "action.score.scope", |
| 799 : | -values => [qw(none all selected)], | ||
| 800 : | -default => $actionParams{"action.score.scope"}->[0] || "none", | ||
| 801 : | toenail | 2246 | -labels => { |
| 802 : | none => "no sets.", | ||
| 803 : | toenail | 2272 | all => "all sets.", |
| 804 : | toenail | 2246 | selected => "selected sets.", |
| 805 : | }, | ||
| 806 : | -onchange => $onChange, | ||
| 807 : | ), | ||
| 808 : | gage | 1934 | ); |
| 809 : | toenail | 2272 | |
| 810 : | |||
| 811 : | |||
| 812 : | toenail | 2246 | } |
| 813 : | gage | 1934 | |
| 814 : | toenail | 2272 | sub score_handler { |
| 815 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 816 : | |||
| 817 : | my $r = $self->r; | ||
| 818 : | my $urlpath = $r->urlpath; | ||
| 819 : | my $courseName = $urlpath->arg("courseID"); | ||
| 820 : | |||
| 821 : | my $scope = $actionParams->{"action.score.scope"}->[0]; | ||
| 822 : | my @setsToScore; | ||
| 823 : | |||
| 824 : | if ($scope eq "none") { | ||
| 825 : | @setsToScore = (); | ||
| 826 : | return "No sets selected for scoring."; | ||
| 827 : | } elsif ($scope eq "all") { | ||
| 828 : | @setsToScore = @{ $self->{allSetIDs} }; | ||
| 829 : | } elsif ($scope eq "visible") { | ||
| 830 : | @setsToScore = @{ $self->{visibleSetIDs} }; | ||
| 831 : | } elsif ($scope eq "selected") { | ||
| 832 : | @setsToScore = @{ $genericParams->{selected_sets} }; | ||
| 833 : | } | ||
| 834 : | |||
| 835 : | my $uri = $self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', courseID=>$courseName), | ||
| 836 : | params=>{ | ||
| 837 : | scoreSelected=>"Score Selected", | ||
| 838 : | selectedSet=>\@setsToScore, | ||
| 839 : | # recordSingleSetScores=>'' | ||
| 840 : | } | ||
| 841 : | ); | ||
| 842 : | |||
| 843 : | |||
| 844 : | return $uri; | ||
| 845 : | } | ||
| 846 : | |||
| 847 : | |||
| 848 : | sub delete_form { | ||
| 849 : | my ($self, $onChange, %actionParams) = @_; | ||
| 850 : | |||
| 851 : | return join("", | ||
| 852 : | CGI::div({class=>"ResultsWithError"}, | ||
| 853 : | "Delete ", | ||
| 854 : | CGI::popup_menu( | ||
| 855 : | -name => "action.delete.scope", | ||
| 856 : | -values => [qw(none selected)], | ||
| 857 : | -default => $actionParams{"action.delete.scope"}->[0] || "none", | ||
| 858 : | -labels => { | ||
| 859 : | none => "no sets.", | ||
| 860 : | #visble => "visible sets.", | ||
| 861 : | selected => "selected sets.", | ||
| 862 : | }, | ||
| 863 : | -onchange => $onChange, | ||
| 864 : | ), | ||
| 865 : | CGI::em(" Deletion destroys all set-related data and is not undoable!"), | ||
| 866 : | ) | ||
| 867 : | ); | ||
| 868 : | } | ||
| 869 : | |||
| 870 : | toenail | 2246 | sub delete_handler { |
| 871 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 872 : | toenail | 2272 | |
| 873 : | my $r = $self->r; | ||
| 874 : | my $db = $r->db; | ||
| 875 : | |||
| 876 : | toenail | 2246 | my $scope = $actionParams->{"action.delete.scope"}->[0]; |
| 877 : | toenail | 2272 | |
| 878 : | toenail | 2097 | |
| 879 : | toenail | 2246 | my @setIDsToDelete = (); |
| 880 : | |||
| 881 : | if ($scope eq "selected") { | ||
| 882 : | @setIDsToDelete = @{ $self->{selectedSetIDs} }; | ||
| 883 : | malsyned | 877 | } |
| 884 : | sh002i | 1804 | |
| 885 : | toenail | 2246 | my %allSetIDs = map { $_ => 1 } @{ $self->{allSetIDs} }; |
| 886 : | my %visibleSetIDs = map { $_ => 1 } @{ $self->{visibleSetIDs} }; | ||
| 887 : | my %selectedSetIDs = map { $_ => 1 } @{ $self->{selectedSetIDs} }; | ||
| 888 : | |||
| 889 : | foreach my $setID (@setIDsToDelete) { | ||
| 890 : | delete $allSetIDs{$setID}; | ||
| 891 : | delete $visibleSetIDs{$setID}; | ||
| 892 : | delete $selectedSetIDs{$setID}; | ||
| 893 : | $db->deleteGlobalSet($setID); | ||
| 894 : | sh002i | 1804 | } |
| 895 : | toenail | 2246 | |
| 896 : | $self->{allSetIDs} = [ keys %allSetIDs ]; | ||
| 897 : | $self->{visibleSetIDs} = [ keys %visibleSetIDs ]; | ||
| 898 : | $self->{selectedSetIDs} = [ keys %selectedSetIDs ]; | ||
| 899 : | |||
| 900 : | my $num = @setIDsToDelete; | ||
| 901 : | return "deleted $num set" . ($num == 1 ? "" : "s"); | ||
| 902 : | } | ||
| 903 : | malsyned | 883 | |
| 904 : | toenail | 2246 | sub create_form { |
| 905 : | my ($self, $onChange, %actionParams) = @_; | ||
| 906 : | toenail | 2272 | |
| 907 : | my $r = $self->r; | ||
| 908 : | toenail | 2246 | |
| 909 : | return "Create a new set named: ", | ||
| 910 : | CGI::textfield( | ||
| 911 : | -name => "action.create.name", | ||
| 912 : | -value => $actionParams{"action.create.name"}->[0] || "", | ||
| 913 : | -width => "50", | ||
| 914 : | -onchange => $onChange, | ||
| 915 : | ); | ||
| 916 : | } | ||
| 917 : | gage | 1843 | |
| 918 : | toenail | 2246 | sub create_handler { |
| 919 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 920 : | toenail | 2272 | |
| 921 : | my $r = $self->r; | ||
| 922 : | my $db = $r->db; | ||
| 923 : | toenail | 2246 | |
| 924 : | my $newSetRecord = $db->newGlobalSet; | ||
| 925 : | my $newSetName = $actionParams->{"action.create.name"}->[0]; | ||
| 926 : | return CGI::div({class => "ResultsWithError"}, "Failed to create new set: no set name specified!") unless $newSetName =~ /\S/; | ||
| 927 : | $newSetRecord->set_id($newSetName); | ||
| 928 : | $newSetRecord->set_header(""); | ||
| 929 : | gage | 2536 | $newSetRecord->hardcopy_header(""); |
| 930 : | toenail | 2246 | $newSetRecord->open_date("0"); |
| 931 : | $newSetRecord->due_date("0"); | ||
| 932 : | $newSetRecord->answer_date("0"); | ||
| 933 : | toenail | 2280 | $newSetRecord->published(DEFAULT_PUBLISHED_STATE); # don't want students to see an empty set |
| 934 : | toenail | 2246 | eval {$db->addGlobalSet($newSetRecord)}; |
| 935 : | |||
| 936 : | return CGI::div({class => "ResultsWithError"}, "Failed to create new set: $@") if $@; | ||
| 937 : | |||
| 938 : | return "Successfully created new set $newSetName"; | ||
| 939 : | |||
| 940 : | } | ||
| 941 : | |||
| 942 : | sub import_form { | ||
| 943 : | my ($self, $onChange, %actionParams) = @_; | ||
| 944 : | gage | 2536 | |
| 945 : | my $r = $self->r; | ||
| 946 : | my $authz = $r->authz; | ||
| 947 : | my $user = $r->param('user'); | ||
| 948 : | toenail | 2272 | |
| 949 : | toenail | 2246 | # this will make the popup menu alternate between a single selection and a multiple selection menu |
| 950 : | # Note: search by name is required since document.problemsetlist.action.import.number is not seen as | ||
| 951 : | # a valid reference to the object named 'action.import.number' | ||
| 952 : | my $importScript = join (" ", | ||
| 953 : | "var number = document.getElementsByName('action.import.number')[0].value;", | ||
| 954 : | "document.getElementsByName('action.import.source')[0].size = number;", | ||
| 955 : | "document.getElementsByName('action.import.source')[0].multiple = (number > 1 ? true : false);", | ||
| 956 : | "document.getElementsByName('action.import.name')[0].value = (number > 1 ? '(taken from filenames)' : '');", | ||
| 957 : | ); | ||
| 958 : | |||
| 959 : | return join(" ", | ||
| 960 : | "Import ", | ||
| 961 : | CGI::popup_menu( | ||
| 962 : | -name => "action.import.number", | ||
| 963 : | -values => [ 1, 8 ], | ||
| 964 : | -default => $actionParams{"action.import.number"}->[0] || "1", | ||
| 965 : | -labels => { | ||
| 966 : | 1 => "a single set", | ||
| 967 : | 8 => "multiple sets", | ||
| 968 : | }, | ||
| 969 : | -onchange => "$onChange;$importScript", | ||
| 970 : | gage | 1723 | ), |
| 971 : | toenail | 2249 | " from ", # set definition file(s) ", |
| 972 : | toenail | 2246 | CGI::popup_menu( |
| 973 : | -name => "action.import.source", | ||
| 974 : | -values => [ "", $self->getDefList() ], | ||
| 975 : | toenail | 2249 | -labels => { "" => "the following file(s)" }, |
| 976 : | toenail | 2246 | -default => $actionParams{"action.import.source"}->[0] || "", |
| 977 : | -size => $actionParams{"action.import.number"}->[0] || "1", | ||
| 978 : | -onchange => $onChange, | ||
| 979 : | ), | ||
| 980 : | toenail | 2249 | " with set name(s): ", |
| 981 : | toenail | 2246 | CGI::textfield( |
| 982 : | -name => "action.import.name", | ||
| 983 : | -value => $actionParams{"action.import.name"}->[0] || "", | ||
| 984 : | -width => "50", | ||
| 985 : | -onchange => $onChange, | ||
| 986 : | ), | ||
| 987 : | toenail | 2272 | ($authz->hasPermissions($user, "assign_problem_sets")) |
| 988 : | ? | ||
| 989 : | "assigning this set to " . | ||
| 990 : | CGI::popup_menu( | ||
| 991 : | -name => "action.import.assign", | ||
| 992 : | -value => [qw(all none)], | ||
| 993 : | -default => $actionParams{"action.import.assign"}->[0] || "none", | ||
| 994 : | -labels => { | ||
| 995 : | all => "all current users.", | ||
| 996 : | none => "no users.", | ||
| 997 : | }, | ||
| 998 : | -onchange => $onChange, | ||
| 999 : | ) | ||
| 1000 : | : | ||
| 1001 : | "" #user does not have permissions to assign problem sets | ||
| 1002 : | gage | 1400 | ); |
| 1003 : | toenail | 2246 | } |
| 1004 : | |||
| 1005 : | sub import_handler { | ||
| 1006 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 1007 : | toenail | 2272 | |
| 1008 : | toenail | 2246 | my @fileNames = @{ $actionParams->{"action.import.source"} }; |
| 1009 : | my $newSetName = $actionParams->{"action.import.name"}->[0]; | ||
| 1010 : | toenail | 2290 | $newSetName = "" if @fileNames > 1; # cannot assign set names to multiple imports |
| 1011 : | toenail | 2246 | my $assign = $actionParams->{"action.import.assign"}->[0]; |
| 1012 : | |||
| 1013 : | my ($added, $skipped) = $self->importSetsFromDef($newSetName, $assign, @fileNames); | ||
| 1014 : | |||
| 1015 : | # make new sets visible... do we really want to do this? probably. | ||
| 1016 : | push @{ $self->{visibleSetIDs} }, @$added; | ||
| 1017 : | push @{ $self->{allSetIDs} }, @$added; | ||
| 1018 : | |||
| 1019 : | my $numAdded = @$added; | ||
| 1020 : | my $numSkipped = @$skipped; | ||
| 1021 : | |||
| 1022 : | return $numAdded . " set" . ($numAdded == 1 ? "" : "s") . " added, " | ||
| 1023 : | . $numSkipped . " set" . ($numSkipped == 1 ? "" : "s") . " skipped."; | ||
| 1024 : | malsyned | 836 | } |
| 1025 : | malsyned | 924 | |
| 1026 : | toenail | 2246 | sub export_form { |
| 1027 : | my ($self, $onChange, %actionParams) = @_; | ||
| 1028 : | gage | 2536 | |
| 1029 : | toenail | 2246 | return join("", |
| 1030 : | "Export ", | ||
| 1031 : | CGI::popup_menu( | ||
| 1032 : | -name => "action.export.scope", | ||
| 1033 : | -values => [qw(all visible selected)], | ||
| 1034 : | -default => $actionParams{"action.export.scope"}->[0] || "visible", | ||
| 1035 : | -labels => { | ||
| 1036 : | all => "all sets", | ||
| 1037 : | visible => "visible sets", | ||
| 1038 : | selected => "selected sets", | ||
| 1039 : | }, | ||
| 1040 : | -onchange => $onChange, | ||
| 1041 : | ), | ||
| 1042 : | ); | ||
| 1043 : | } | ||
| 1044 : | gage | 1428 | |
| 1045 : | gage | 2536 | # this does not actually export any files, rather it sends us to a new page in order to export the files |
| 1046 : | toenail | 2246 | sub export_handler { |
| 1047 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 1048 : | gage | 2536 | |
| 1049 : | my $result; | ||
| 1050 : | toenail | 2246 | |
| 1051 : | my $scope = $actionParams->{"action.export.scope"}->[0]; | ||
| 1052 : | gage | 2536 | if ($scope eq "all") { |
| 1053 : | $result = "exporting all sets"; | ||
| 1054 : | $self->{selectedSetIDs} = $self->{visibleSetIDs} = $self->{allSetIDs}; | ||
| 1055 : | |||
| 1056 : | } elsif ($scope eq "visible") { | ||
| 1057 : | $result = "exporting visible sets"; | ||
| 1058 : | $self->{selectedSetIDs} = $self->{visibleSetIDs}; | ||
| 1059 : | } elsif ($scope eq "selected") { | ||
| 1060 : | $result = "exporting selected sets"; | ||
| 1061 : | $self->{selectedSetIDs} = $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref | ||
| 1062 : | } | ||
| 1063 : | $self->{exportMode} = 1; | ||
| 1064 : | toenail | 2246 | |
| 1065 : | gage | 2536 | return $result; |
| 1066 : | } | ||
| 1067 : | |||
| 1068 : | sub cancelExport_form { | ||
| 1069 : | my ($self, $onChange, %actionParams) = @_; | ||
| 1070 : | return "Abandon export"; | ||
| 1071 : | } | ||
| 1072 : | |||
| 1073 : | sub cancelExport_handler { | ||
| 1074 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 1075 : | my $r = $self->r; | ||
| 1076 : | |||
| 1077 : | #$self->{selectedSetIDs) = $self->{visibleSetIDs}; | ||
| 1078 : | # only do the above if we arrived here via "edit selected users" | ||
| 1079 : | if (defined $r->param("prev_visible_sets")) { | ||
| 1080 : | $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; | ||
| 1081 : | } elsif (defined $r->param("no_prev_visible_sets")) { | ||
| 1082 : | $self->{visibleSetIDs} = []; | ||
| 1083 : | toenail | 2246 | } else { |
| 1084 : | gage | 2536 | # leave it alone |
| 1085 : | toenail | 2246 | } |
| 1086 : | gage | 2536 | $self->{exportMode} = 0; |
| 1087 : | toenail | 2246 | |
| 1088 : | gage | 2536 | return "export abandoned"; |
| 1089 : | } | ||
| 1090 : | |||
| 1091 : | sub saveExport_form { | ||
| 1092 : | my ($self, $onChange, %actionParams) = @_; | ||
| 1093 : | return "Export selected sets (This may take a long time. Even if your browser times out, all the files will be exported)."; | ||
| 1094 : | } | ||
| 1095 : | |||
| 1096 : | sub saveExport_handler { | ||
| 1097 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 1098 : | my $r = $self->r; | ||
| 1099 : | my $db = $r->db; | ||
| 1100 : | toenail | 2246 | |
| 1101 : | gage | 2536 | my @setIDsToExport = @{ $self->{selectedSetIDs} }; |
| 1102 : | gage | 1428 | |
| 1103 : | gage | 2536 | my %filenames = map { $_ => (@{ $tableParams->{"set.$_"} }[0] || $_) } @setIDsToExport; |
| 1104 : | |||
| 1105 : | my ($exported, $skipped, $reason) = $self->exportSetsToDef(%filenames); | ||
| 1106 : | |||
| 1107 : | if (defined $r->param("prev_visible_sets")) { | ||
| 1108 : | $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; | ||
| 1109 : | } elsif (defined $r->param("no_prev_visble_sets")) { | ||
| 1110 : | $self->{visibleSetIDs} = []; | ||
| 1111 : | } else { | ||
| 1112 : | # leave it alone | ||
| 1113 : | toenail | 2246 | } |
| 1114 : | |||
| 1115 : | gage | 2536 | $self->{exportMode} = 0; |
| 1116 : | |||
| 1117 : | my $numExported = @$exported; | ||
| 1118 : | my $numSkipped = @$skipped; | ||
| 1119 : | |||
| 1120 : | my @reasons = map { "set $_ - " . $reason->{$_} } keys %$reason; | ||
| 1121 : | |||
| 1122 : | return $numExported . " set" . ($numExported == 1 ? "" : "s") . " exported, " | ||
| 1123 : | . $numSkipped . " set" . ($numSkipped == 1 ? "" : "s") . " skipped." | ||
| 1124 : | . (($numSkipped) ? CGI::ul(CGI::li(\@reasons)) : ""); | ||
| 1125 : | |||
| 1126 : | toenail | 2246 | } |
| 1127 : | |||
| 1128 : | sub cancelEdit_form { | ||
| 1129 : | my ($self, $onChange, %actionParams) = @_; | ||
| 1130 : | return "Abandon changes"; | ||
| 1131 : | } | ||
| 1132 : | |||
| 1133 : | sub cancelEdit_handler { | ||
| 1134 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 1135 : | my $r = $self->r; | ||
| 1136 : | |||
| 1137 : | #$self->{selectedSetIDs) = $self->{visibleSetIDs}; | ||
| 1138 : | # only do the above if we arrived here via "edit selected users" | ||
| 1139 : | if (defined $r->param("prev_visible_sets")) { | ||
| 1140 : | $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; | ||
| 1141 : | } elsif (defined $r->param("no_prev_visible_sets")) { | ||
| 1142 : | $self->{visibleSetIDs} = []; | ||
| 1143 : | } else { | ||
| 1144 : | # leave it alone | ||
| 1145 : | } | ||
| 1146 : | $self->{editMode} = 0; | ||
| 1147 : | |||
| 1148 : | return "changes abandoned"; | ||
| 1149 : | } | ||
| 1150 : | |||
| 1151 : | sub saveEdit_form { | ||
| 1152 : | my ($self, $onChange, %actionParams) = @_; | ||
| 1153 : | return "Save changes"; | ||
| 1154 : | } | ||
| 1155 : | |||
| 1156 : | sub saveEdit_handler { | ||
| 1157 : | my ($self, $genericParams, $actionParams, $tableParams) = @_; | ||
| 1158 : | my $r = $self->r; | ||
| 1159 : | my $db = $r->db; | ||
| 1160 : | |||
| 1161 : | my @visibleSetIDs = @{ $self->{visibleSetIDs} }; | ||
| 1162 : | foreach my $setID (@visibleSetIDs) { | ||
| 1163 : | my $Set = $db->getGlobalSet($setID); # checked | ||
| 1164 : | # FIXME: we may not want to die on bad sets, they're not as bad as bad users | ||
| 1165 : | die "record for visible set $setID not found" unless $Set; | ||
| 1166 : | |||
| 1167 : | foreach my $field ($Set->NONKEYFIELDS()) { | ||
| 1168 : | my $param = "set.${setID}.${field}"; | ||
| 1169 : | if (defined $tableParams->{$param}->[0]) { | ||
| 1170 : | if ($field =~ /_date/) { | ||
| 1171 : | $Set->$field(parseDateTime($tableParams->{$param}->[0])); | ||
| 1172 : | } else { | ||
| 1173 : | $Set->$field($tableParams->{$param}->[0]); | ||
| 1174 : | } | ||
| 1175 : | } | ||
| 1176 : | } | ||
| 1177 : | |||
| 1178 : | ################################################### | ||
| 1179 : | # Check that the open, due and answer dates are in increasing order. | ||
| 1180 : | # Bail if this is not correct. | ||
| 1181 : | ################################################### | ||
| 1182 : | if ($Set->open_date > $Set->due_date) { | ||
| 1183 : | return CGI::div({class=>'ResultsWithError'}, "Error: Due date must come after open date in set $setID"); | ||
| 1184 : | } | ||
| 1185 : | if ($Set->due_date > $Set->answer_date) { | ||
| 1186 : | return CGI::div({class=>'ResultsWithError'}, "Error: Answer date must come after due date in set $setID"); | ||
| 1187 : | } | ||
| 1188 : | ################################################### | ||
| 1189 : | # End date check section. | ||
| 1190 : | ################################################### | ||
| 1191 : | $db->putGlobalSet($Set); | ||
| 1192 : | } | ||
| 1193 : | |||
| 1194 : | if (defined $r->param("prev_visible_sets")) { | ||
| 1195 : | $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; | ||
| 1196 : | } elsif (defined $r->param("no_prev_visble_sets")) { | ||
| 1197 : | $self->{visibleSetIDs} = []; | ||
| 1198 : | } else { | ||
| 1199 : | # leave it alone | ||
| 1200 : | } | ||
| 1201 : | |||
| 1202 : | $self->{editMode} = 0; | ||
| 1203 : | |||
| 1204 : | return "changes saved"; | ||
| 1205 : | } | ||
| 1206 : | |||
| 1207 : | ################################################################################ | ||
| 1208 : | # sorts | ||
| 1209 : | ################################################################################ | ||
| 1210 : | |||
| 1211 : | sub bySetID { $a->set_id cmp $b->set_id } | ||
| 1212 : | sub bySetHeader { $a->set_header cmp $b->set_header } | ||
| 1213 : | gage | 2536 | sub byHardcopyHeader { $a->hardcopy_header cmp $b->hardcopy_header } |
| 1214 : | toenail | 2246 | sub byOpenDate { $a->open_date <=> $b->open_date } |
| 1215 : | sub byDueDate { $a->due_date <=> $b->due_date } | ||
| 1216 : | sub byAnswerDate { $a->answer_date <=> $b->answer_date } | ||
| 1217 : | sub byPublished { $a->published cmp $b->published } | ||
| 1218 : | |||
| 1219 : | sub byOpenDue { &byOpenDate || &byDueDate } | ||
| 1220 : | |||
| 1221 : | ################################################################################ | ||
| 1222 : | # utilities | ||
| 1223 : | ################################################################################ | ||
| 1224 : | |||
| 1225 : | # generate labels for open_date/due_date/answer_date popup menus | ||
| 1226 : | sub menuLabels { | ||
| 1227 : | my ($self, $hashRef) = @_; | ||
| 1228 : | my %hash = %$hashRef; | ||
| 1229 : | |||
| 1230 : | my %result; | ||
| 1231 : | foreach my $key (keys %hash) { | ||
| 1232 : | my $count = @{ $hash{$key} }; | ||
| 1233 : | my $displayKey = formatDateTime($key) || "<none>"; | ||
| 1234 : | $result{$key} = "$displayKey ($count sets)"; | ||
| 1235 : | } | ||
| 1236 : | return %result; | ||
| 1237 : | } | ||
| 1238 : | |||
| 1239 : | sub importSetsFromDef { | ||
| 1240 : | my ($self, $newSetName, $assign, @setDefFiles) = @_; | ||
| 1241 : | my $r = $self->r; | ||
| 1242 : | my $ce = $r->ce; | ||
| 1243 : | my $db = $r->db; | ||
| 1244 : | my $dir = $ce->{courseDirs}->{templates}; | ||
| 1245 : | |||
| 1246 : | # FIXME: do we really want everything to fail on one bad file name? | ||
| 1247 : | foreach my $fileName (@setDefFiles) { | ||
| 1248 : | die "won't be able to read from file $dir/$fileName: does it exist? is it readable?" | ||
| 1249 : | unless -r "$dir/$fileName"; | ||
| 1250 : | } | ||
| 1251 : | |||
| 1252 : | my @allSetIDs = $db->listGlobalSets(); | ||
| 1253 : | # FIXME: getGlobalSets takes a lot of time just for checking to see if a set already exists | ||
| 1254 : | # this could be avoided by waiting until the call to addGlobalSet below | ||
| 1255 : | # and checking to see if the error message says that the set already exists | ||
| 1256 : | # but if the error message is ever changed the code here might be broken | ||
| 1257 : | # then again, one call to getGlobalSets and skipping unnecessary calls to addGlobalSet | ||
| 1258 : | # could be faster than no call to getGlobalSets and lots of unnecessary calls to addGlobalSet | ||
| 1259 : | my %allSets = map { $_->set_id => 1 if $_} $db->getGlobalSets(@allSetIDs); # checked | ||
| 1260 : | |||
| 1261 : | my (@added, @skipped); | ||
| 1262 : | |||
| 1263 : | foreach my $set_definition_file (@setDefFiles) { | ||
| 1264 : | |||
| 1265 : | $WeBWorK::timer->continue("$set_definition_file: reading set definition file") if defined $WeBWorK::timer; | ||
| 1266 : | # read data in set definition file | ||
| 1267 : | glarose | 2343 | my ($setName, $paperHeaderFile, $screenHeaderFile, $openDate, |
| 1268 : | $dueDate, $answerDate, $ra_problemData, | ||
| 1269 : | $assignmentType, $attemptsPerVersion, $timeInterval, | ||
| 1270 : | $versionsPerInterval, $versionTimeLimit, | ||
| 1271 : | $problemRandOrder) = $self->readSetDef($set_definition_file); | ||
| 1272 : | toenail | 2246 | my @problemList = @{$ra_problemData}; |
| 1273 : | |||
| 1274 : | # Use the original name if form doesn't specify a new one. | ||
| 1275 : | # The set acquires the new name specified by the form. A blank | ||
| 1276 : | # entry on the form indicates that the imported set name will be used. | ||
| 1277 : | $setName = $newSetName if $newSetName; | ||
| 1278 : | |||
| 1279 : | if ($allSets{$setName}) { | ||
| 1280 : | # this set already exists!! | ||
| 1281 : | push @skipped, $setName; | ||
| 1282 : | next; | ||
| 1283 : | } else { | ||
| 1284 : | push @added, $setName; | ||
| 1285 : | } | ||
| 1286 : | |||
| 1287 : | $WeBWorK::timer->continue("$set_definition_file: adding set") if defined $WeBWorK::timer; | ||
| 1288 : | # add the data to the set record | ||
| 1289 : | my $newSetRecord = $db->newGlobalSet; | ||
| 1290 : | $newSetRecord->set_id($setName); | ||
| 1291 : | $newSetRecord->set_header($screenHeaderFile); | ||
| 1292 : | gage | 2536 | $newSetRecord->hardcopy_header($paperHeaderFile); |
| 1293 : | toenail | 2246 | $newSetRecord->open_date($openDate); |
| 1294 : | $newSetRecord->due_date($dueDate); | ||
| 1295 : | $newSetRecord->answer_date($answerDate); | ||
| 1296 : | toenail | 2280 | $newSetRecord->published(DEFAULT_PUBLISHED_STATE); |
| 1297 : | toenail | 2246 | |
| 1298 : | glarose | 2343 | # gateway/version data. I'm not sure why I'm bothering to put these in a conditional. |
| 1299 : | # in that we return '' for missing gateway data, it should just keep all of these | ||
| 1300 : | # values null for non-versioned/non-gateway sets | ||
| 1301 : | $newSetRecord->assignment_type($assignmentType) if ( $assignmentType ); | ||
| 1302 : | $newSetRecord->attempts_per_version($attemptsPerVersion) if ( $attemptsPerVersion ); | ||
| 1303 : | $newSetRecord->time_interval($timeInterval) if ( $timeInterval ); | ||
| 1304 : | $newSetRecord->versions_per_interval($versionsPerInterval) if ( $versionsPerInterval ); | ||
| 1305 : | $newSetRecord->version_time_limit($versionTimeLimit) if ( $versionTimeLimit ); | ||
| 1306 : | $newSetRecord->problem_randorder($problemRandOrder) if ( $problemRandOrder ); | ||
| 1307 : | |||
| 1308 : | toenail | 2246 | #create the set |
| 1309 : | eval {$db->addGlobalSet($newSetRecord)}; | ||
| 1310 : | die "addGlobalSet $setName in ProblemSetList: $@" if $@; | ||
| 1311 : | |||
| 1312 : | $WeBWorK::timer->continue("$set_definition_file: adding problems to database") if defined $WeBWorK::timer; | ||
| 1313 : | # add problems | ||
| 1314 : | my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; | ||
| 1315 : | foreach my $rh_problem (@problemList) { | ||
| 1316 : | jj | 2284 | $self->addProblemToSet( |
| 1317 : | setName => $setName, | ||
| 1318 : | sourceFile => $rh_problem->{source_file}, | ||
| 1319 : | problemID => $freeProblemID++, | ||
| 1320 : | value => $rh_problem->{value}, | ||
| 1321 : | maxAttempts => $rh_problem->{max_attempts}); | ||
| 1322 : | toenail | 2246 | } |
| 1323 : | |||
| 1324 : | |||
| 1325 : | if ($assign eq "all") { | ||
| 1326 : | $self->assignSetToAllUsers($setName); | ||
| 1327 : | } | ||
| 1328 : | } | ||
| 1329 : | |||
| 1330 : | |||
| 1331 : | return \@added, \@skipped; | ||
| 1332 : | } | ||
| 1333 : | |||
| 1334 : | gage | 1428 | sub readSetDef { |
| 1335 : | toenail | 2246 | my ($self, $fileName) = @_; |
| 1336 : | gage | 1428 | my $templateDir = $self->{ce}->{courseDirs}->{templates}; |
| 1337 : | my $filePath = "$templateDir/$fileName"; | ||
| 1338 : | |||
| 1339 : | toenail | 2246 | my $setName = ''; |
| 1340 : | gage | 1428 | |
| 1341 : | toenail | 2246 | if ($fileName =~ m|^set([\w-]+)\.def$|) { |
| 1342 : | $setName = $1; | ||
| 1343 : | } else { | ||
| 1344 : | warn qq{The setDefinition file name must begin with <CODE>set</CODE>}, | ||
| 1345 : | qq{and must end with <CODE>.def</CODE> . Every thing in between becomes the name of the set. }, | ||
| 1346 : | qq{For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE> }, | ||
| 1347 : | qq{define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. }, | ||
| 1348 : | qq{The filename, $fileName, you entered is not legal\n }; | ||
| 1349 : | |||
| 1350 : | } | ||
| 1351 : | |||
| 1352 : | my ($line, $name, $value, $attemptLimit, $continueFlag); | ||
| 1353 : | gage | 1428 | my $paperHeaderFile = ''; |
| 1354 : | my $screenHeaderFile = ''; | ||
| 1355 : | toenail | 2246 | my ($dueDate, $openDate, $answerDate); |
| 1356 : | gage | 1428 | my @problemData; |
| 1357 : | toenail | 2246 | |
| 1358 : | glarose | 2343 | # added fields for gateway test/versioned set definitions: |
| 1359 : | my ( $assignmentType, $attemptsPerVersion, $timeInterval, | ||
| 1360 : | $versionsPerInterval, $versionTimeLimit, $problemRandOrder ) = | ||
| 1361 : | ('')x6; # initialize these to '' | ||
| 1362 : | toenail | 2246 | |
| 1363 : | glarose | 2343 | |
| 1364 : | toenail | 2246 | my %setInfo; |
| 1365 : | if ( open (SETFILENAME, "$filePath") ) { | ||
| 1366 : | gage | 1428 | ##################################################################### |
| 1367 : | # Read and check set data | ||
| 1368 : | ##################################################################### | ||
| 1369 : | while (<SETFILENAME>) { | ||
| 1370 : | toenail | 2246 | |
| 1371 : | gage | 1428 | chomp($line = $_); |
| 1372 : | $line =~ s|(#.*)||; ## don't read past comments | ||
| 1373 : | unless ($line =~ /\S/) {next;} ## skip blank lines | ||
| 1374 : | $line =~ s|\s*$||; ## trim trailing spaces | ||
| 1375 : | $line =~ m|^\s*(\w+)\s*=\s*(.*)|; | ||
| 1376 : | gage | 1726 | |
| 1377 : | ###################### | ||
| 1378 : | # sanity check entries | ||
| 1379 : | ###################### | ||
| 1380 : | my $item = $1; | ||
| 1381 : | $item = '' unless defined $item; | ||
| 1382 : | my $value = $2; | ||
| 1383 : | $value = '' unless defined $value; | ||
| 1384 : | |||
| 1385 : | if ($item eq 'setNumber') { | ||
| 1386 : | gage | 1428 | next; |
| 1387 : | gage | 1726 | } elsif ($item eq 'paperHeaderFile') { |
| 1388 : | $paperHeaderFile = $value; | ||
| 1389 : | } elsif ($item eq 'screenHeaderFile') { | ||
| 1390 : | $screenHeaderFile = $value; | ||
| 1391 : | } elsif ($item eq 'dueDate') { | ||
| 1392 : | $dueDate = $value; | ||
| 1393 : | } elsif ($item eq 'openDate') { | ||
| 1394 : | $openDate = $value; | ||
| 1395 : | toenail | 2246 | } elsif ($item eq 'answerDate') { |
| 1396 : | gage | 1726 | $answerDate = $value; |
| 1397 : | glarose | 2343 | } elsif ($item eq 'assignmentType') { |
| 1398 : | $assignmentType = $value; | ||
| 1399 : | } elsif ($item eq 'attemptsPerVersion') { | ||
| 1400 : | $attemptsPerVersion = $value; | ||
| 1401 : | } elsif ($item eq 'timeInterval') { | ||
| 1402 : | $timeInterval = $value; | ||
| 1403 : | } elsif ($item eq 'versionsPerInterval') { | ||
| 1404 : | $versionsPerInterval = $value; | ||
| 1405 : | } elsif ($item eq 'versionTimeLimit') { | ||
| 1406 : | $versionTimeLimit = $value; | ||
| 1407 : | } elsif ($item eq 'problemRandOrder') { | ||
| 1408 : | $problemRandOrder = $value; | ||
| 1409 : | gage | 1726 | } elsif ($item eq 'problemList') { |
| 1410 : | gage | 1428 | last; |
| 1411 : | } else { | ||
| 1412 : | gage | 1726 | warn "readSetDef error, can't read the line: ||$line||"; |
| 1413 : | gage | 1428 | } |
| 1414 : | } | ||
| 1415 : | toenail | 2246 | |
| 1416 : | ##################################################################### | ||
| 1417 : | # Check and format dates | ||
| 1418 : | ##################################################################### | ||
| 1419 : | my ($time1, $time2, $time3) = map { $_ =~ s/\s*at\s*/ /; WeBWorK::Utils::parseDateTime($_); } ($openDate, $dueDate, $answerDate); | ||
| 1420 : | gage | 1428 | |
| 1421 : | unless ($time1 <= $time2 and $time2 <= $time3) { | ||
| 1422 : | toenail | 2246 | warn "The open date: $openDate, due date: $dueDate, and answer date: $answerDate must be defined and in chronological order."; |
| 1423 : | gage | 1428 | } |
| 1424 : | toenail | 2246 | |
| 1425 : | # Check header file names | ||
| 1426 : | gage | 1428 | $paperHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space |
| 1427 : | $screenHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space | ||
| 1428 : | glarose | 2343 | |
| 1429 : | ##################################################################### | ||
| 1430 : | # Gateway/version variable cleanup | ||
| 1431 : | |||
| 1432 : | $assignmentType =~ s/(.*?)\s*/$1/; # remove trailing | ||
| 1433 : | $attemptsPerVersion =~ s/(.*?)\s*/$1/; # white space | ||
| 1434 : | $timeInterval =~ s/(.*?)\s*/$1/; | ||
| 1435 : | $versionsPerInterval =~ s/(.*?)\s*/$1/; | ||
| 1436 : | $versionTimeLimit =~ s/(.*?)\s*/$1/; | ||
| 1437 : | $problemRandOrder =~ s/(.*?)\s*/$1/; | ||
| 1438 : | |||
| 1439 : | # convert times into seconds | ||
| 1440 : | glarose | 3275 | $timeInterval = WeBWorK::Utils::timeToSec( $timeInterval ) |
| 1441 : | if ( $timeInterval ); | ||
| 1442 : | $versionTimeLimit = WeBWorK::Utils::timeToSec( $versionTimeLimit ) | ||
| 1443 : | if ( $versionTimeLimit ); | ||
| 1444 : | gage | 1428 | |
| 1445 : | toenail | 2246 | ##################################################################### |
| 1446 : | # Read and check list of problems for the set | ||
| 1447 : | ##################################################################### | ||
| 1448 : | gage | 1428 | while(<SETFILENAME>) { |
| 1449 : | chomp($line=$_); | ||
| 1450 : | $line =~ s/(#.*)//; ## don't read past comments | ||
| 1451 : | unless ($line =~ /\S/) {next;} ## skip blank lines | ||
| 1452 : | |||
| 1453 : | ($name, $value, $attemptLimit, $continueFlag) = split (/\s*,\s*/,$line); | ||
| 1454 : | ##################### | ||
| 1455 : | # clean up problem values | ||
| 1456 : | ########################### | ||
| 1457 : | $name =~ s/\s*//g; | ||
| 1458 : | $value = "" unless defined($value); | ||
| 1459 : | $value =~ s/[^\d\.]*//g; | ||
| 1460 : | unless ($value =~ /\d+/) {$value = 1;} | ||
| 1461 : | $attemptLimit = "" unless defined($attemptLimit); | ||
| 1462 : | $attemptLimit =~ s/[^\d-]*//g; | ||
| 1463 : | unless ($attemptLimit =~ /\d+/) {$attemptLimit = -1;} | ||
| 1464 : | $continueFlag = "0" unless( defined($continueFlag) && @problemData ); | ||
| 1465 : | toenail | 2246 | # can't put continuation flag onto the first problem |
| 1466 : | gage | 1428 | push(@problemData, {source_file => $name, |
| 1467 : | value => $value, | ||
| 1468 : | max_attempts =>, $attemptLimit, | ||
| 1469 : | continuation => $continueFlag | ||
| 1470 : | }); | ||
| 1471 : | } | ||
| 1472 : | close(SETFILENAME); | ||
| 1473 : | toenail | 2246 | ($setName, |
| 1474 : | gage | 1428 | $paperHeaderFile, |
| 1475 : | $screenHeaderFile, | ||
| 1476 : | $time1, | ||
| 1477 : | $time2, | ||
| 1478 : | $time3, | ||
| 1479 : | \@problemData, | ||
| 1480 : | glarose | 2343 | $assignmentType, $attemptsPerVersion, $timeInterval, |
| 1481 : | $versionsPerInterval, $versionTimeLimit, $problemRandOrder, | ||
| 1482 : | gage | 1428 | ); |
| 1483 : | } else { | ||
| 1484 : | warn "Can't open file $filePath\n"; | ||
| 1485 : | } | ||
| 1486 : | } | ||
| 1487 : | |||
| 1488 : | gage | 2536 | sub exportSetsToDef { |
| 1489 : | my ($self, %filenames) = @_; | ||
| 1490 : | |||
| 1491 : | my $r = $self->r; | ||
| 1492 : | my $ce = $r->ce; | ||
| 1493 : | my $db = $r->db; | ||
| 1494 : | |||
| 1495 : | my (@exported, @skipped, %reason); | ||
| 1496 : | |||
| 1497 : | SET: foreach my $set (keys %filenames) { | ||
| 1498 : | |||
| 1499 : | my $fileName = $filenames{$set}; | ||
| 1500 : | $fileName .= ".def" unless $fileName =~ m/\.def$/; | ||
| 1501 : | $fileName = "set" . $fileName unless $fileName =~ m/^set/; | ||
| 1502 : | # files can be exported to sub directories but not parent directories | ||
| 1503 : | if ($fileName =~ /\.\./) { | ||
| 1504 : | push @skipped, $set; | ||
| 1505 : | $reason{$set} = "Illegal filename contains '..'"; | ||
| 1506 : | next SET; | ||
| 1507 : | } | ||
| 1508 : | |||
| 1509 : | my $setRecord = $db->getGlobalSet($set); | ||
| 1510 : | unless (defined $setRecord) { | ||
| 1511 : | push @skipped, $set; | ||
| 1512 : | $reason{$set} = "No record found."; | ||
| 1513 : | next SET; | ||
| 1514 : | } | ||
| 1515 : | my $filePath = $ce->{courseDirs}->{templates} . '/' . $fileName; | ||
| 1516 : | |||
| 1517 : | # back up existing file | ||
| 1518 : | if(-e $filePath) { | ||
| 1519 : | rename($filePath, "$filePath.bak") or | ||
| 1520 : | $reason{$set} = "Existing file $filePath could not be backed up and was lost."; | ||
| 1521 : | } | ||
| 1522 : | |||
| 1523 : | my $openDate = formatDateTime($setRecord->open_date); | ||
| 1524 : | my $dueDate = formatDateTime($setRecord->due_date); | ||
| 1525 : | my $answerDate = formatDateTime($setRecord->answer_date); | ||
| 1526 : | my $setHeader = $setRecord->set_header; | ||
| 1527 : | my @problemList = $db->listGlobalProblems($set); | ||
| 1528 : | |||
| 1529 : | my $problemList = ''; | ||
| 1530 : | foreach my $prob (sort {$a <=> $b} @problemList) { | ||
| 1531 : | my $problemRecord = $db->getGlobalProblem($set, $prob); # checked | ||
| 1532 : | unless (defined $problemRecord) { | ||
| 1533 : | push @skipped, $set; | ||
| 1534 : | $reason{$set} = "No record found for problem $prob."; | ||
| 1535 : | next SET; | ||
| 1536 : | } | ||
| 1537 : | my $source_file = $problemRecord->source_file(); | ||
| 1538 : | my $value = $problemRecord->value(); | ||
| 1539 : | my $max_attempts = $problemRecord->max_attempts(); | ||
| 1540 : | $problemList .= "$source_file, $value, $max_attempts \n"; | ||
| 1541 : | } | ||
| 1542 : | my $fileContents = <<EOF; | ||
| 1543 : | |||
| 1544 : | openDate = $openDate | ||
| 1545 : | dueDate = $dueDate | ||
| 1546 : | answerDate = $answerDate | ||
| 1547 : | paperHeaderFile = $setHeader | ||
| 1548 : | screenHeaderFile = $setHeader | ||
| 1549 : | problemList = | ||
| 1550 : | |||
| 1551 : | $problemList | ||
| 1552 : | |||
| 1553 : | |||
| 1554 : | |||
| 1555 : | EOF | ||
| 1556 : | |||
| 1557 : | $filePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, $filePath); | ||
| 1558 : | eval { | ||
| 1559 : | local *SETDEF; | ||
| 1560 : | open SETDEF, ">$filePath" or die "Failed to open $filePath"; | ||
| 1561 : | print SETDEF $fileContents; | ||
| 1562 : | close SETDEF; | ||
| 1563 : | }; | ||
| 1564 : | |||
| 1565 : | if ($@) { | ||
| 1566 : | push @skipped, $set; | ||
| 1567 : | $reason{$set} = $@; | ||
| 1568 : | } else { | ||
| 1569 : | push @exported, $set; | ||
| 1570 : | } | ||
| 1571 : | |||
| 1572 : | } | ||
| 1573 : | |||
| 1574 : | return \@exported, \@skipped, \%reason; | ||
| 1575 : | |||
| 1576 : | } | ||
| 1577 : | |||
| 1578 : | |||
| 1579 : | toenail | 2246 | # search recursively through a directory looking for all filenames matching a given pattern |
| 1580 : | sub recurseDirectory { | ||
| 1581 : | |||
| 1582 : | my ($self, $dir, $pattern) = @_; | ||
| 1583 : | |||
| 1584 : | my @dirs = grep {$_ ne "." and $_ ne ".." and $_ ne "Library" and $_ ne "CVS" and -d "$dir/$_"} readDirectory($dir); | ||
| 1585 : | |||
| 1586 : | my @files = map { "$dir/$_" } $self->read_dir($dir, $pattern); | ||
| 1587 : | |||
| 1588 : | foreach (@dirs) { | ||
| 1589 : | push (@files, $self->recurseDirectory("$dir/$_", $pattern)); | ||
| 1590 : | } | ||
| 1591 : | |||
| 1592 : | return @files; | ||
| 1593 : | } | ||
| 1594 : | |||
| 1595 : | ################################################################################ | ||
| 1596 : | # "display" methods | ||
| 1597 : | ################################################################################ | ||
| 1598 : | |||
| 1599 : | sub fieldEditHTML { | ||
| 1600 : | my ($self, $fieldName, $value, $properties) = @_; | ||
| 1601 : | my $size = $properties->{size}; | ||
| 1602 : | my $type = $properties->{type}; | ||
| 1603 : | my $access = $properties->{access}; | ||
| 1604 : | my $items = $properties->{items}; | ||
| 1605 : | my $synonyms = $properties->{synonyms}; | ||
| 1606 : | my $headerFiles = $self->{headerFiles}; | ||
| 1607 : | |||
| 1608 : | if ($access eq "readonly") { | ||
| 1609 : | return $value; | ||
| 1610 : | } | ||
| 1611 : | |||
| 1612 : | if ($type eq "number" or $type eq "text") { | ||
| 1613 : | return CGI::input({type=>"text", name=>$fieldName, value=>$value, size=>$size}); | ||
| 1614 : | } | ||
| 1615 : | |||
| 1616 : | if ($type eq "filelist") { | ||
| 1617 : | return CGI::popup_menu({ | ||
| 1618 : | name => $fieldName, | ||
| 1619 : | value => [ sort keys %$headerFiles ], | ||
| 1620 : | labels => $headerFiles, | ||
| 1621 : | default => $value || 0, | ||
| 1622 : | }); | ||
| 1623 : | } | ||
| 1624 : | |||
| 1625 : | if ($type eq "enumerable") { | ||
| 1626 : | my $matched = undef; # Whether a synonym match has occurred | ||
| 1627 : | |||
| 1628 : | # Process synonyms for enumerable objects | ||
| 1629 : | foreach my $synonym (keys %$synonyms) { | ||
| 1630 : | if ($synonym ne "*" and $value =~ m/$synonym/) { | ||
| 1631 : | $value = $synonyms->{$synonym}; | ||
| 1632 : | $matched = 1; | ||
| 1633 : | } | ||
| 1634 : | } | ||
| 1635 : | |||
| 1636 : | if (!$matched and exists $synonyms->{"*"}) { | ||
| 1637 : | $value = $synonyms->{"*"}; | ||
| 1638 : | } | ||
| 1639 : | |||
| 1640 : | return CGI::popup_menu({ | ||
| 1641 : | name => $fieldName, | ||
| 1642 : | values => [keys %$items], | ||
| 1643 : | default => $value, | ||
| 1644 : | labels => $items, | ||
| 1645 : | }); | ||
| 1646 : | } | ||
| 1647 : | |||
| 1648 : | if ($type eq "checked") { | ||
| 1649 : | |||
| 1650 : | # FIXME: kludge (R) | ||
| 1651 : | # if the checkbox is checked it returns a 1, if it is unchecked it returns nothing | ||
| 1652 : | # in which case the hidden field overrides the parameter with a 0 | ||
| 1653 : | return CGI::checkbox( | ||
| 1654 : | -name => $fieldName, | ||
| 1655 : | -checked => $value, | ||
| 1656 : | -label => "", | ||
| 1657 : | -value => 1 | ||
| 1658 : | ) . CGI::hidden( | ||
| 1659 : | -name => $fieldName, | ||
| 1660 : | -value => 0 | ||
| 1661 : | ); | ||
| 1662 : | } | ||
| 1663 : | } | ||
| 1664 : | |||
| 1665 : | sub recordEditHTML { | ||
| 1666 : | my ($self, $Set, %options) = @_; | ||
| 1667 : | my $r = $self->r; | ||
| 1668 : | my $urlpath = $r->urlpath; | ||
| 1669 : | my $ce = $r->ce; | ||
| 1670 : | my $db = $r->db; | ||
| 1671 : | gage | 2536 | my $authz = $r->authz; |
| 1672 : | my $user = $r->param('user'); | ||
| 1673 : | toenail | 2246 | my $root = $ce->{webworkURLs}->{root}; |
| 1674 : | my $courseName = $urlpath->arg("courseID"); | ||
| 1675 : | |||
| 1676 : | my $editMode = $options{editMode}; | ||
| 1677 : | gage | 2536 | my $exportMode = $options{exportMode}; |
| 1678 : | toenail | 2246 | my $setSelected = $options{setSelected}; |
| 1679 : | |||
| 1680 : | my $publishedClass = $Set->published ? "Published" : "Unpublished"; | ||
| 1681 : | |||
| 1682 : | my $users = $db->countSetUsers($Set->set_id); | ||
| 1683 : | my $totalUsers = $self->{totalUsers}; | ||
| 1684 : | my $problems = $db->listGlobalProblems($Set->set_id); | ||
| 1685 : | |||
| 1686 : | my $usersAssignedToSetURL = $self->systemLink($urlpath->new(type=>'instructor_users_assigned_to_set', args=>{courseID => $courseName, setID => $Set->set_id} )); | ||
| 1687 : | my $problemListURL = $self->systemLink($urlpath->new(type=>'instructor_problem_list', args=>{courseID => $courseName, setID => $Set->set_id} )); | ||
| 1688 : | toenail | 2285 | my $problemSetListURL = $self->systemLink($urlpath->new(type=>'instructor_set_list', args=>{courseID => $courseName, setID => $Set->set_id})) . "&editMode=1&visible_sets=" . $Set->set_id; |
| 1689 : | my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/edit.gif"; | ||
| 1690 : | my $imageLink = CGI::a({href => $problemSetListURL}, CGI::img({src=>$imageURL, border=>0})); | ||
| 1691 : | toenail | 2246 | |
| 1692 : | my @tableCells; | ||
| 1693 : | my %fakeRecord; | ||
| 1694 : | gage | 2536 | my $set_id = $Set->set_id; |
| 1695 : | $fakeRecord{select} = CGI::checkbox(-name => "selected_sets", -value => $set_id, -checked => $setSelected, -label => "", ); | ||
| 1696 : | $fakeRecord{set_id} = CGI::font({class=>$publishedClass}, $set_id) . ($editMode ? "" : $imageLink); | ||
| 1697 : | $fakeRecord{problems} = (FIELD_PERMS()->{problems} and not $authz->hasPermissions($user, FIELD_PERMS()->{problems})) | ||
| 1698 : | ? "$problems" | ||
| 1699 : | : CGI::a({href=>$problemListURL}, "$problems"); | ||
| 1700 : | $fakeRecord{users} = (FIELD_PERMS()->{users} and not $authz->hasPermissions($user, FIELD_PERMS()->{users})) | ||
| 1701 : | ? "$users/$totalUsers" | ||
| 1702 : | : CGI::a({href=>$usersAssignedToSetURL}, "$users/$totalUsers"); | ||
| 1703 : | $fakeRecord{filename} = CGI::input({-name => "set.$set_id", -value=>"set$set_id.def", -size=>60}); | ||
| 1704 : | |||
| 1705 : | toenail | 2246 | |
| 1706 : | # Select | ||
| 1707 : | if ($editMode) { | ||
| 1708 : | # column not there | ||
| 1709 : | } else { | ||
| 1710 : | # selection checkbox | ||
| 1711 : | push @tableCells, CGI::checkbox( | ||
| 1712 : | -name => "selected_sets", | ||
| 1713 : | gage | 2536 | -value => $set_id, |
| 1714 : | toenail | 2246 | -checked => $setSelected, |
| 1715 : | -label => "", | ||
| 1716 : | ); | ||
| 1717 : | } | ||
| 1718 : | |||
| 1719 : | # Set ID | ||
| 1720 : | gage | 2536 | push @tableCells, CGI::font({class=>$publishedClass}, $set_id . $imageLink); |
| 1721 : | toenail | 2246 | |
| 1722 : | # Problems link | ||
| 1723 : | if ($editMode) { | ||
| 1724 : | # column not there | ||
| 1725 : | } else { | ||
| 1726 : | # "problem list" link | ||
| 1727 : | push @tableCells, CGI::a({href=>$problemListURL}, "$problems"); | ||
| 1728 : | } | ||
| 1729 : | |||
| 1730 : | # Users link | ||
| 1731 : | if ($editMode) { | ||
| 1732 : | # column not there | ||
| 1733 : | } else { | ||
| 1734 : | # "edit users assigned to set" link | ||
| 1735 : | push @tableCells, CGI::a({href=>$usersAssignedToSetURL}, "$users/$totalUsers"); | ||
| 1736 : | } | ||
| 1737 : | |||
| 1738 : | # Set Fields | ||
| 1739 : | foreach my $field ($Set->NONKEYFIELDS) { | ||
| 1740 : | gage | 2536 | my $fieldName = "set." . $set_id . "." . $field, |
| 1741 : | toenail | 2246 | my $fieldValue = $Set->$field; |
| 1742 : | my %properties = %{ FIELD_PROPERTIES()->{$field} }; | ||
| 1743 : | $properties{access} = "readonly" unless $editMode; | ||
| 1744 : | $fieldValue = formatDateTime($fieldValue) if $field =~ /_date/; | ||
| 1745 : | glarose | 2343 | $fieldValue = '' if ( ! defined( $fieldValue ) ); |
| 1746 : | toenail | 2246 | $fieldValue =~ s/ / /g unless $editMode; |
| 1747 : | $fieldValue = ($fieldValue) ? "Yes" : "No" if $field =~ /published/ and not $editMode; | ||
| 1748 : | push @tableCells, CGI::font({class=>$publishedClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); | ||
| 1749 : | $fakeRecord{$field} = CGI::font({class=>$publishedClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); | ||
| 1750 : | } | ||
| 1751 : | |||
| 1752 : | my @fieldsToShow; | ||
| 1753 : | if ($editMode) { | ||
| 1754 : | @fieldsToShow = @{ EDIT_FIELD_ORDER() }; | ||
| 1755 : | } else { | ||
| 1756 : | @fieldsToShow = @{ VIEW_FIELD_ORDER() }; | ||
| 1757 : | } | ||
| 1758 : | gage | 2536 | |
| 1759 : | if ($exportMode) { | ||
| 1760 : | @fieldsToShow = @{ EXPORT_FIELD_ORDER() }; | ||
| 1761 : | } | ||
| 1762 : | toenail | 2246 | |
| 1763 : | @tableCells = map { $fakeRecord{$_} } @fieldsToShow; | ||
| 1764 : | |||
| 1765 : | return CGI::Tr({}, CGI::td({}, \@tableCells)); | ||
| 1766 : | } | ||
| 1767 : | |||
| 1768 : | sub printTableHTML { | ||
| 1769 : | my ($self, $SetsRef, $fieldNamesRef, %options) = @_; | ||
| 1770 : | my $r = $self->r; | ||
| 1771 : | gage | 2536 | my $authz = $r->authz; |
| 1772 : | my $user = $r->param('user'); | ||
| 1773 : | toenail | 2246 | my $setTemplate = $self->{setTemplate}; |
| 1774 : | my @Sets = @$SetsRef; | ||
| 1775 : | my %fieldNames = %$fieldNamesRef; | ||
| 1776 : | |||
| 1777 : | my $editMode = $options{editMode}; | ||
| 1778 : | gage | 2536 | my $exportMode = $options{exportMode}; |
| 1779 : | toenail | 2246 | my %selectedSetIDs = map { $_ => 1 } @{ $options{selectedSetIDs} }; |
| 1780 : | my $currentSort = $options{currentSort}; | ||
| 1781 : | |||
| 1782 : | # names of headings: | ||
| 1783 : | my @realFieldNames = ( | ||
| 1784 : | $setTemplate->KEYFIELDS, | ||
| 1785 : | $setTemplate->NONKEYFIELDS, | ||
| 1786 : | ); | ||
| 1787 : | |||
| 1788 : | if ($editMode) { | ||
| 1789 : | @realFieldNames = @{ EDIT_FIELD_ORDER() }; | ||
| 1790 : | } else { | ||
| 1791 : | @realFieldNames = @{ VIEW_FIELD_ORDER() }; | ||
| 1792 : | } | ||
| 1793 : | gage | 2536 | |
| 1794 : | if ($exportMode) { | ||
| 1795 : | @realFieldNames = @{ EXPORT_FIELD_ORDER() }; | ||
| 1796 : | } | ||
| 1797 : | toenail | 2246 | |
| 1798 : | |||
| 1799 : | my %sortSubs = %{ SORT_SUBS() }; | ||
| 1800 : | |||
| 1801 : | # FIXME: should this always presume to use the templates directory? | ||
| 1802 : | my @headers = $self->recurseDirectory($self->{ce}->{courseDirs}->{templates}, '(?i)header.*?\\.pg$'); | ||
| 1803 : | map { s|^$self->{ce}->{courseDirs}->{templates}/?|| } @headers; | ||
| 1804 : | @headers = sort @headers; | ||
| 1805 : | my %headers = map { $_ => $_ } @headers; | ||
| 1806 : | $headers{""} = "Use System Default"; | ||
| 1807 : | $self->{headerFiles} = \%headers; # store these header files so we don't have to look for them later. | ||
| 1808 : | |||
| 1809 : | gage | 2536 | |
| 1810 : | my @tableHeadings = map { $fieldNames{$_} } @realFieldNames; | ||
| 1811 : | toenail | 2246 | |
| 1812 : | # prepend selection checkbox? only if we're NOT editing! | ||
| 1813 : | # unshift @tableHeadings, "Select", "Set", "Problems" unless $editMode; | ||
| 1814 : | |||
| 1815 : | # print the table | ||
| 1816 : | gage | 2536 | if ($editMode or $exportMode) { |
| 1817 : | toenail | 2246 | print CGI::start_table({}); |
| 1818 : | } else { | ||
| 1819 : | print CGI::start_table({-border=>1}); | ||
| 1820 : | } | ||
| 1821 : | |||
| 1822 : | print CGI::Tr({}, CGI::th({}, \@tableHeadings)); | ||
| 1823 : | |||
| 1824 : | |||
| 1825 : | for (my $i = 0; $i < @Sets; $i++) { | ||
| 1826 : | my $Set = $Sets[$i]; | ||
| 1827 : | |||
| 1828 : | print $self->recordEditHTML($Set, | ||
| 1829 : | editMode => $editMode, | ||
| 1830 : | gage | 2536 | exportMode => $exportMode, |
| 1831 : | toenail | 2246 | setSelected => exists $selectedSetIDs{$Set->set_id} |
| 1832 : | ); | ||
| 1833 : | } | ||
| 1834 : | |||
| 1835 : | print CGI::end_table(); | ||
| 1836 : | ######################################### | ||
| 1837 : | # if there are no users shown print message | ||
| 1838 : | # | ||
| 1839 : | ########################################## | ||
| 1840 : | |||
| 1841 : | print CGI::p( | ||
| 1842 : | CGI::i("No sets shown. Choose one of the options above to list the sets in the course.") | ||
| 1843 : | ) unless @Sets; | ||
| 1844 : | } | ||
| 1845 : | |||
| 1846 : | malsyned | 832 | 1; |
| 1847 : | toenail | 2246 |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |