Parent Directory
| 
Revision Log
Revision 1934 - (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 : | gage | 1934 | # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm,v 1.45 2004/03/28 03:25:47 gage Exp $ |
| 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 : | WeBWorK::ContentGenerator::Instructor::ProblemSetList - Entry point for Problem and Set editing | ||
| 23 : | |||
| 24 : | =cut | ||
| 25 : | |||
| 26 : | use strict; | ||
| 27 : | use warnings; | ||
| 28 : | malsyned | 1410 | use Apache::Constants qw(REDIRECT); |
| 29 : | malsyned | 832 | use CGI qw(); |
| 30 : | malsyned | 877 | use WeBWorK::Utils qw(formatDateTime); |
| 31 : | gage | 1843 | use WeBWorK::Compatibility; |
| 32 : | malsyned | 832 | |
| 33 : | gage | 1428 | use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts continuation)]; |
| 34 : | |||
| 35 : | malsyned | 1410 | sub header { |
| 36 : | gage | 1928 | my $self = shift; |
| 37 : | my $r = $self->r; | ||
| 38 : | my $urlpath = $r->urlpath; | ||
| 39 : | my $ce = $r->ce; | ||
| 40 : | my $courseName = $urlpath->arg("courseID"); | ||
| 41 : | gage | 1934 | my $scoringPage = $urlpath -> newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', |
| 42 : | courseID => $courseName | ||
| 43 : | ); | ||
| 44 : | malsyned | 1410 | if (defined $r->param('scoreSelected')) { |
| 45 : | gage | 1934 | my $scoringPageURL = $self->systemLink($scoringPage, |
| 46 : | params=>['scoreSelected','selectedSet','recordSingleSetScores' ] | ||
| 47 : | ); | ||
| 48 : | $r->header_out(Location => $scoringPageURL); | ||
| 49 : | malsyned | 1410 | $self->{noContent} = 1; |
| 50 : | return REDIRECT; | ||
| 51 : | } | ||
| 52 : | $r->content_type("text/html"); | ||
| 53 : | $r->send_http_header(); | ||
| 54 : | } | ||
| 55 : | |||
| 56 : | malsyned | 963 | sub initialize { |
| 57 : | gage | 1928 | my $self = shift; |
| 58 : | my $r = $self->r; | ||
| 59 : | my $urlpath = $r->urlpath; | ||
| 60 : | my $db = $r->db; | ||
| 61 : | my $ce = $r->ce; | ||
| 62 : | my $authz = $r->authz; | ||
| 63 : | my $courseName = $urlpath->arg("courseID"); | ||
| 64 : | my $user = $r->param('user'); | ||
| 65 : | malsyned | 963 | |
| 66 : | malsyned | 1017 | unless ($authz->hasPermissions($user, "create_and_delete_problem_sets")) { |
| 67 : | $self->{submitError} = "You aren't authorized to create or delete problems"; | ||
| 68 : | return; | ||
| 69 : | } | ||
| 70 : | gage | 1843 | if (defined($r->param('update_global_user')) ){ |
| 71 : | my $global_user_message = WeBWorK::Compatibility::update_global_user($self); | ||
| 72 : | $self->{global_user_message} = $global_user_message; | ||
| 73 : | } | ||
| 74 : | if (defined($r->param('deleteSelected')) and defined($r->param('deleteSelectedSafety') ) | ||
| 75 : | and $r->param('deleteSelectedSafety') == 1) { | ||
| 76 : | |||
| 77 : | malsyned | 963 | foreach my $wannaDelete ($r->param('selectedSet')) { |
| 78 : | $db->deleteGlobalSet($wannaDelete); | ||
| 79 : | } | ||
| 80 : | sh002i | 1660 | } elsif (defined $r->param('scoreSelected')) { |
| 81 : | # FIXME: this doesn't do anything! | ||
| 82 : | } elsif (defined $r->param('makeNewSet')) { | ||
| 83 : | malsyned | 1020 | my $newSetRecord = $db->{set}->{record}->new(); |
| 84 : | malsyned | 963 | my $newSetName = $r->param('newSetName'); |
| 85 : | $newSetRecord->set_id($newSetName); | ||
| 86 : | malsyned | 977 | $newSetRecord->set_header(""); |
| 87 : | $newSetRecord->problem_header(""); | ||
| 88 : | $newSetRecord->open_date("0"); | ||
| 89 : | $newSetRecord->due_date("0"); | ||
| 90 : | $newSetRecord->answer_date("0"); | ||
| 91 : | malsyned | 1020 | eval {$db->addGlobalSet($newSetRecord)}; |
| 92 : | sh002i | 1660 | } elsif (defined $r->param('importSet') or defined $r->param('importSets')) { |
| 93 : | my @setDefFiles = (); | ||
| 94 : | my $newSetName = ""; | ||
| 95 : | if (defined $r->param('importSet')) { | ||
| 96 : | @setDefFiles = $r->param('set_definition_file'); | ||
| 97 : | $newSetName = $r->param('newSetName'); | ||
| 98 : | } elsif (defined $r->param('importSets')) { | ||
| 99 : | @setDefFiles = $r->param('set_definition_files'); | ||
| 100 : | } | ||
| 101 : | gage | 1428 | |
| 102 : | sh002i | 1660 | foreach my $set_definition_file (@setDefFiles) { |
| 103 : | sh002i | 1790 | $WeBWorK::timer->continue("$set_definition_file: reading set definition file") if defined $WeBWorK::timer; |
| 104 : | sh002i | 1660 | # read data in set definition file |
| 105 : | my ($setName, $paperHeaderFile, $screenHeaderFile, | ||
| 106 : | $openDate, $dueDate, $answerDate, $ra_problemData, | ||
| 107 : | ) = $self->readSetDef($set_definition_file); | ||
| 108 : | my @problemList = @{$ra_problemData}; | ||
| 109 : | |||
| 110 : | # Use the original name if form doesn't specify a new one. | ||
| 111 : | # The set acquires the new name specified by the form. A blank | ||
| 112 : | # entry on the form indicates that the imported set name will be used. | ||
| 113 : | $setName = $newSetName if $newSetName; | ||
| 114 : | gage | 1428 | |
| 115 : | sh002i | 1790 | $WeBWorK::timer->continue("$set_definition_file: adding set") if defined $WeBWorK::timer; |
| 116 : | sh002i | 1660 | # add the data to the set record |
| 117 : | #my $newSetRecord = $db->{set}->{record}->new(); | ||
| 118 : | my $newSetRecord = $db->newGlobalSet; | ||
| 119 : | $newSetRecord->set_id($setName); | ||
| 120 : | $newSetRecord->set_header($screenHeaderFile); | ||
| 121 : | $newSetRecord->problem_header($paperHeaderFile); | ||
| 122 : | $newSetRecord->open_date($openDate); | ||
| 123 : | $newSetRecord->due_date($dueDate); | ||
| 124 : | $newSetRecord->answer_date($answerDate); | ||
| 125 : | |||
| 126 : | #create the set | ||
| 127 : | eval {$db->addGlobalSet($newSetRecord)}; | ||
| 128 : | die "addGlobalSet $setName in ProblemSetList: $@" if $@; | ||
| 129 : | |||
| 130 : | sh002i | 1790 | $WeBWorK::timer->continue("$set_definition_file: adding problems to database") if defined $WeBWorK::timer; |
| 131 : | sh002i | 1660 | # add problems |
| 132 : | my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; | ||
| 133 : | foreach my $rh_problem (@problemList) { | ||
| 134 : | #my $problemRecord = new WeBWorK::DB::Record::Problem; | ||
| 135 : | my $problemRecord = $db->newGlobalProblem; | ||
| 136 : | $problemRecord->problem_id($freeProblemID++); | ||
| 137 : | #warn "Adding problem $freeProblemID ", $rh_problem->source_file; | ||
| 138 : | $problemRecord->set_id($setName); | ||
| 139 : | $problemRecord->source_file($rh_problem->{source_file}); | ||
| 140 : | $problemRecord->value($rh_problem->{value}); | ||
| 141 : | $problemRecord->max_attempts($rh_problem->{max_attempts}); | ||
| 142 : | # continuation flags??? | ||
| 143 : | $db->addGlobalProblem($problemRecord); | ||
| 144 : | #$self->assignProblemToAllSetUsers($problemRecord); # handled by parent | ||
| 145 : | } | ||
| 146 : | |||
| 147 : | sh002i | 1702 | if ($r->param("assignNewSet")) { |
| 148 : | sh002i | 1790 | $WeBWorK::timer->continue("$set_definition_file: assigning set to all users") if defined $WeBWorK::timer; |
| 149 : | sh002i | 1702 | # assign the set to all users |
| 150 : | $self->assignSetToAllUsers($setName); | ||
| 151 : | } | ||
| 152 : | gage | 1428 | } |
| 153 : | } | ||
| 154 : | malsyned | 963 | } |
| 155 : | |||
| 156 : | gage | 1295 | |
| 157 : | malsyned | 836 | |
| 158 : | gage | 1928 | |
| 159 : | malsyned | 836 | sub body { |
| 160 : | gage | 1928 | my $self = shift; |
| 161 : | my $r = $self->r; | ||
| 162 : | my $urlpath = $r->urlpath; | ||
| 163 : | my $db = $r->db; | ||
| 164 : | my $ce = $r->ce; | ||
| 165 : | my $authz = $r->authz; | ||
| 166 : | my $root = $ce->{webworkURLs}->{root}; | ||
| 167 : | my $courseName = $urlpath->arg("courseID"); | ||
| 168 : | my $user = $r->param('user'); | ||
| 169 : | my $key = $r->param('key'); | ||
| 170 : | gage | 859 | my $effectiveUserName = $r->param('effectiveUser'); |
| 171 : | gage | 1934 | |
| 172 : | my $problemSetListPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName) ; | ||
| 173 : | my $problemSetListURL = $self->systemLink($problemSetListPage); | ||
| 174 : | #my $instructorBaseURL = "$root/$courseName/instructor"; | ||
| 175 : | #my $importURL = "$instructorBaseURL/problemSetImport/"; | ||
| 176 : | my $instructorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::Index", | ||
| 177 : | courseID => $courseName | ||
| 178 : | ); | ||
| 179 : | malsyned | 883 | my $sort = $r->param('sort') ? $r->param('sort') : "due_date"; |
| 180 : | gage | 859 | |
| 181 : | gage | 1399 | my @set_definition_files = $self->read_dir($ce->{courseDirs}->{templates},'\\.def'); |
| 182 : | gage | 1934 | return CGI::em("You are not authorized to access the instructor tools") |
| 183 : | unless $authz->hasPermissions($user, "access_instructor_tools"); | ||
| 184 : | gage | 1843 | |
| 185 : | ############################################################################### | ||
| 186 : | malsyned | 883 | # Slurp each set record for this course in @sets |
| 187 : | malsyned | 952 | # Gather data from the database |
| 188 : | gage | 1843 | ############################################################################### |
| 189 : | malsyned | 952 | my @users = $db->listUsers; |
| 190 : | gage | 1843 | ############################################################################### |
| 191 : | # for compatibility check to make sure that the global user has been defined. | ||
| 192 : | ############################################################################### | ||
| 193 : | my $globalUser = $ce->{dbLayout}->{set}->{params}->{globalUserID}; | ||
| 194 : | my $database_type = $ce->{dbLayoutName}; | ||
| 195 : | my $global_user_alert = ""; | ||
| 196 : | my $global_user_message = ""; | ||
| 197 : | $global_user_message = $self->{global_user_message} if defined($self->{global_user_message}); | ||
| 198 : | if (defined($globalUser) and $globalUser and $database_type eq 'gdbm') { # if a name for the global user has been defined in database.conf | ||
| 199 : | my $flag = 0; | ||
| 200 : | foreach $user (@users) { | ||
| 201 : | $flag = 1 if $user eq $globalUser; | ||
| 202 : | } | ||
| 203 : | |||
| 204 : | if ($flag == 0 ) { # no global user has been added to this course | ||
| 205 : | $global_user_alert = join("", | ||
| 206 : | CGI::div({class=>'ResultsWithError'}, | ||
| 207 : | CGI::p("This is the first time that this course | ||
| 208 : | has been used with WeBWorK 2.0 and no 'Global User' has been defined. In WeBWorK 2.0 | ||
| 209 : | a set and it's problems can exist without being assigned to any real student or instructor -- | ||
| 210 : | instead it is assigned to this fictional 'Global User' whose id is $globalUser. | ||
| 211 : | Press this button to initialize the global user files so that you can view sets built in | ||
| 212 : | WW1.9 in 2.0. You should only need to do this once -- the first time you use WW2.0 on a pre-existing course." | ||
| 213 : | ), | ||
| 214 : | CGI::p("Depending on the number of sets, this operation may take many minutes. Even if your browser times out | ||
| 215 : | the updating process will continue until it is done. Time for coffee? :-)" | ||
| 216 : | ), | ||
| 217 : | gage | 1934 | CGI::start_form({"method"=>"POST", "action"=>$self->systemLink($problemSetListPage)}), |
| 218 : | gage | 1843 | $self->hidden_authen_fields, |
| 219 : | CGI::submit({-name=>'update_global_user', -value=>"Update Global User" }), | ||
| 220 : | CGI::end_form(), | ||
| 221 : | ), | ||
| 222 : | ); | ||
| 223 : | #$global_user_message = WeBWorK::Compatibility::update_global_user($self); | ||
| 224 : | } | ||
| 225 : | } | ||
| 226 : | ############################################################################### | ||
| 227 : | # end compatibility check | ||
| 228 : | ############################################################################### | ||
| 229 : | gage | 1606 | my @set_IDs = $db->listGlobalSets; |
| 230 : | gage | 1667 | my @sets = $db->getGlobalSets(@set_IDs); #checked |
| 231 : | malsyned | 883 | my %counts; |
| 232 : | malsyned | 954 | my %problemCounts; |
| 233 : | gage | 1606 | |
| 234 : | gage | 1843 | |
| 235 : | sh002i | 1651 | $WeBWorK::timer->continue("Begin obtaining problem info on sets") if defined $WeBWorK::timer; |
| 236 : | gage | 1606 | foreach my $set_id (@set_IDs) { |
| 237 : | malsyned | 955 | $problemCounts{$set_id} = scalar($db->listGlobalProblems($set_id)); |
| 238 : | sh002i | 1661 | #$counts{$set_id} = $db->listSetUsers($set_id); |
| 239 : | malsyned | 883 | } |
| 240 : | sh002i | 1651 | $WeBWorK::timer->continue("End obtaining problem on sets") if defined $WeBWorK::timer; |
| 241 : | malsyned | 883 | |
| 242 : | sh002i | 1651 | $WeBWorK::timer->continue("Begin obtaining assigned user info on sets") if defined $WeBWorK::timer; |
| 243 : | gage | 1606 | foreach my $set_id (@set_IDs) { |
| 244 : | sh002i | 1661 | #$problemCounts{$set_id} = scalar($db->listGlobalProblems($set_id)); |
| 245 : | #$counts{$set_id} = $db->listSetUsers($set_id); | ||
| 246 : | $counts{$set_id} = $db->countSetUsers($set_id); | ||
| 247 : | gage | 1606 | } |
| 248 : | sh002i | 1651 | $WeBWorK::timer->continue("End obtaining assigned user info on sets") if defined $WeBWorK::timer; |
| 249 : | gage | 1606 | |
| 250 : | malsyned | 883 | # Sort @sets based on the sort parameter |
| 251 : | # Invalid sort types will just cause an unpredictable ordering, which is no big deal. | ||
| 252 : | @sets = sort { | ||
| 253 : | if ($sort eq "set_id") { | ||
| 254 : | return $a->$sort cmp $b->$sort; | ||
| 255 : | }elsif ($sort =~ /_date$/) { | ||
| 256 : | return $a->$sort <=> $b->$sort; | ||
| 257 : | } elsif ($sort eq "num_probs") { | ||
| 258 : | malsyned | 954 | return $problemCounts{$a->set_id} <=> $problemCounts{$b->set_id}; |
| 259 : | malsyned | 883 | } elsif ($sort eq "num_students") { |
| 260 : | return $counts{$a->set_id} <=> $counts{$b->set_id}; | ||
| 261 : | } | ||
| 262 : | } @sets; | ||
| 263 : | |||
| 264 : | my $table = CGI::Tr({}, | ||
| 265 : | gage | 1934 | CGI::th([ |
| 266 : | "Sel.", | ||
| 267 : | CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'set_id' })}, "Sort by name" ), | ||
| 268 : | CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'open_date' })}, "Sort by Open Date" ), | ||
| 269 : | CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'due_date' })}, "Sort by Due Date" ), | ||
| 270 : | CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'answer_date' })}, "Sort by Answer Date" ), | ||
| 271 : | "Edit problems", | ||
| 272 : | "Assign users" , | ||
| 273 : | ]) | ||
| 274 : | ); | ||
| 275 : | |||
| 276 : | malsyned | 883 | foreach my $set (@sets) { |
| 277 : | gage | 1727 | my $count = $counts{$set->set_id}; |
| 278 : | my $totalUsers = scalar(@users); #FIXME -- probably shouldn't count those who have dropped. | ||
| 279 : | malsyned | 1005 | my $userCountMessage = $self->userCountMessage($count, scalar(@users)); |
| 280 : | gage | 1934 | my $problemListPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ProblemList", |
| 281 : | courseID => $courseName, | ||
| 282 : | setID => $set->set_id, | ||
| 283 : | ); | ||
| 284 : | my $usersAssignedToSetPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", | ||
| 285 : | courseID => $courseName, | ||
| 286 : | setID => $set->set_id, | ||
| 287 : | ); | ||
| 288 : | my $problemSetEditorPage = $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::ProblemSetEditor', | ||
| 289 : | courseID => $courseName, | ||
| 290 : | setID => $set->set_id, | ||
| 291 : | ); | ||
| 292 : | malsyned | 877 | $table .= CGI::Tr({}, |
| 293 : | gage | 1934 | CGI::td([ |
| 294 : | malsyned | 877 | CGI::checkbox({ |
| 295 : | malsyned | 883 | "name"=>"selectedSet", |
| 296 : | malsyned | 877 | "value"=>$set->set_id, |
| 297 : | "label"=>"", | ||
| 298 : | "checked"=>"0" | ||
| 299 : | gage | 1934 | }), |
| 300 : | ' '.$set->set_id . ' '.CGI::a({href=>$self->systemLink($problemListPage)}, 'Edit'), | ||
| 301 : | formatDateTime($set->open_date), | ||
| 302 : | formatDateTime($set->due_date), | ||
| 303 : | formatDateTime($set->answer_date), | ||
| 304 : | CGI::a({href=>$self->systemLink($problemListPage )}, $problemCounts{$set->set_id}), | ||
| 305 : | CGI::a({href=>$self->systemLink($usersAssignedToSetPage)}, "$count/$totalUsers") , | ||
| 306 : | ]) | ||
| 307 : | malsyned | 877 | ) . "\n" |
| 308 : | } | ||
| 309 : | malsyned | 883 | $table = CGI::table({"border"=>"1"}, "\n".$table."\n"); |
| 310 : | sh002i | 1804 | |
| 311 : | my $slownessWarning = ""; | ||
| 312 : | if ($ce->{dbLayoutName} eq "sql") { | ||
| 313 : | $slownessWarning = "In this version of WeBWorK, assigning sets is very slow. Your browser" | ||
| 314 : | . " may time out if you import many sets or have many users to whom to assign them. If this" | ||
| 315 : | . " happens, click your browser's reload button. This issue will be resolved in a later" | ||
| 316 : | . " version of WeBWorK. (Hopefully the next version!)" | ||
| 317 : | . CGI::br(); | ||
| 318 : | } | ||
| 319 : | malsyned | 883 | |
| 320 : | sh002i | 1702 | print join("\n", |
| 321 : | gage | 1843 | $global_user_alert, |
| 322 : | $global_user_message, | ||
| 323 : | sh002i | 1702 | # Set table form (for deleting checked sets) |
| 324 : | gage | 1934 | CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}), |
| 325 : | sh002i | 1702 | $self->hidden_authen_fields, |
| 326 : | $table, | ||
| 327 : | CGI::br(), | ||
| 328 : | gage | 1723 | |
| 329 : | sh002i | 1702 | CGI::submit({"name"=>"scoreSelected", "label"=>"Score Selected"}), |
| 330 : | gage | 1843 | CGI::div( {class=>'ResultsWithError'}, |
| 331 : | gage | 1723 | "There is NO undo when deleting sets. Use cautiously. All data for the set is lost. |
| 332 : | <br>If the set is re-assigned (rebuilt) all of the problem versions will be different.", | ||
| 333 : | CGI::br(), | ||
| 334 : | CGI::submit({"name"=>"deleteSelected", "label"=>"Delete Selected"}), | ||
| 335 : | gage | 1843 | CGI::radio_group(-name=>"deleteSelectedSafety", -values=>[0,1], -default=>0, -labels=>{0=>'Read only', 1=>'Allow delete'}), |
| 336 : | |||
| 337 : | gage | 1723 | ), |
| 338 : | sh002i | 1702 | CGI::end_form(), |
| 339 : | CGI::br(), | ||
| 340 : | sh002i | 1660 | |
| 341 : | sh002i | 1702 | # Empty set creation form |
| 342 : | gage | 1934 | CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}), |
| 343 : | sh002i | 1702 | $self->hidden_authen_fields, |
| 344 : | CGI::b("Create an Empty Set"), | ||
| 345 : | CGI::br(), | ||
| 346 : | gage | 1400 | "New Set Name: ", |
| 347 : | CGI::input({type=>"text", name=>"newSetName", value=>""}), | ||
| 348 : | sh002i | 1702 | CGI::submit({"name"=>"makeNewSet", "label"=>"Create"}), |
| 349 : | CGI::end_form(), | ||
| 350 : | CGI::br(), | ||
| 351 : | sh002i | 1660 | |
| 352 : | sh002i | 1702 | # Single set import form |
| 353 : | gage | 1723 | CGI::hr(), |
| 354 : | gage | 1934 | CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}), |
| 355 : | sh002i | 1702 | $self->hidden_authen_fields, |
| 356 : | CGI::b("Import a Single Set"), | ||
| 357 : | CGI::br(), | ||
| 358 : | "From file: ", | ||
| 359 : | CGI::popup_menu(-name=>'set_definition_file', -values=>\@set_definition_files), | ||
| 360 : | CGI::br(), | ||
| 361 : | "Set name: ", | ||
| 362 : | CGI::input({type=>"text", name=>"newSetName", value=>""}), | ||
| 363 : | " (leave blank to use name of set definition file)", | ||
| 364 : | CGI::br(), | ||
| 365 : | CGI::checkbox(-name=>"assignNewSet", | ||
| 366 : | -label=>"Assign imported set to all users"), | ||
| 367 : | CGI::br(), | ||
| 368 : | CGI::submit({"name"=>"importSet", "label"=>"Import a Single Set"}), | ||
| 369 : | CGI::end_form(), | ||
| 370 : | CGI::br(), | ||
| 371 : | |||
| 372 : | # Multiple set import form | ||
| 373 : | gage | 1723 | CGI::hr(), |
| 374 : | gage | 1934 | CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}), |
| 375 : | sh002i | 1702 | $self->hidden_authen_fields, |
| 376 : | CGI::b("Import Multiple Sets"), | ||
| 377 : | CGI::br(), | ||
| 378 : | sh002i | 1660 | "Each set will be named based on the name of the set definition file, omitting", |
| 379 : | " any leading ", CGI::i("set"), " and trailing ", CGI::i(".def"), ". Note that", | ||
| 380 : | " the name of a set cannot be changed once it has been created.", | ||
| 381 : | sh002i | 1702 | CGI::br(), |
| 382 : | CGI::scrolling_list(-name=>"set_definition_files", -values=>\@set_definition_files, -size=>10, -multiple=>"true"), | ||
| 383 : | CGI::br(), | ||
| 384 : | CGI::checkbox(-name=>"assignNewSet", -label=>"Assign imported sets to all users"), | ||
| 385 : | CGI::br(), | ||
| 386 : | sh002i | 1804 | $slownessWarning, |
| 387 : | sh002i | 1702 | CGI::submit({"name"=>"importSets", "label"=>"Import Multiple Sets"}), |
| 388 : | CGI::end_form(), | ||
| 389 : | gage | 1400 | ); |
| 390 : | malsyned | 877 | |
| 391 : | return ""; | ||
| 392 : | malsyned | 836 | } |
| 393 : | malsyned | 924 | |
| 394 : | gage | 1428 | ############################################################################################## |
| 395 : | # Utility scripts -- may be moved to Utils.pm | ||
| 396 : | ############################################################################################## | ||
| 397 : | |||
| 398 : | |||
| 399 : | sub readSetDef { | ||
| 400 : | my $self = shift; | ||
| 401 : | my $fileName = shift; | ||
| 402 : | my $templateDir = $self->{ce}->{courseDirs}->{templates}; | ||
| 403 : | my $filePath = "$templateDir/$fileName"; | ||
| 404 : | my $setNumber = ''; | ||
| 405 : | if ($fileName =~ m|^set(\w+)\.def$|) { | ||
| 406 : | $setNumber = $1; | ||
| 407 : | } else { | ||
| 408 : | warn qq{The setDefinition file name must begin with <CODE>set</CODE>}, | ||
| 409 : | qq{and must end with <CODE>.def</CODE> . Every thing in between becomes the name of the set. }, | ||
| 410 : | qq{For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE> }, | ||
| 411 : | qq{define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. }, | ||
| 412 : | qq{The filename, $fileName, you entered is not legal\n }; | ||
| 413 : | |||
| 414 : | } | ||
| 415 : | |||
| 416 : | my ($line,$name,$value,$attemptLimit,$continueFlag); | ||
| 417 : | my $paperHeaderFile = ''; | ||
| 418 : | my $screenHeaderFile = ''; | ||
| 419 : | my ($dueDate,$openDate,$answerDate); | ||
| 420 : | my @problemData; | ||
| 421 : | if ( open (SETFILENAME, "$filePath") ) { | ||
| 422 : | ##################################################################### | ||
| 423 : | # Read and check set data | ||
| 424 : | ##################################################################### | ||
| 425 : | while (<SETFILENAME>) { | ||
| 426 : | chomp($line = $_); | ||
| 427 : | $line =~ s|(#.*)||; ## don't read past comments | ||
| 428 : | unless ($line =~ /\S/) {next;} ## skip blank lines | ||
| 429 : | $line =~ s|\s*$||; ## trim trailing spaces | ||
| 430 : | $line =~ m|^\s*(\w+)\s*=\s*(.*)|; | ||
| 431 : | gage | 1726 | |
| 432 : | ###################### | ||
| 433 : | # sanity check entries | ||
| 434 : | ###################### | ||
| 435 : | my $item = $1; | ||
| 436 : | $item = '' unless defined $item; | ||
| 437 : | my $value = $2; | ||
| 438 : | $value = '' unless defined $value; | ||
| 439 : | |||
| 440 : | if ($item eq 'setNumber') { | ||
| 441 : | gage | 1428 | next; |
| 442 : | gage | 1726 | } elsif ($item eq 'paperHeaderFile') { |
| 443 : | $paperHeaderFile = $value; | ||
| 444 : | } elsif ($item eq 'screenHeaderFile') { | ||
| 445 : | $screenHeaderFile = $value; | ||
| 446 : | } elsif ($item eq 'dueDate') { | ||
| 447 : | $dueDate = $value; | ||
| 448 : | } elsif ($item eq 'openDate') { | ||
| 449 : | $openDate = $value; | ||
| 450 : | gage | 1428 | } elsif ($1 eq 'answerDate') { |
| 451 : | gage | 1726 | $answerDate = $value; |
| 452 : | } elsif ($item eq 'problemList') { | ||
| 453 : | gage | 1428 | last; |
| 454 : | } else { | ||
| 455 : | gage | 1726 | warn "readSetDef error, can't read the line: ||$line||"; |
| 456 : | gage | 1428 | } |
| 457 : | } | ||
| 458 : | ##################################################################### | ||
| 459 : | # Check and format dates | ||
| 460 : | ##################################################################### | ||
| 461 : | my ($time1,$time2,$time3) = map { $_ =~ s/\s*at\s*/ /; WeBWorK::Utils::parseDateTime($_); } ($openDate, $dueDate, $answerDate); | ||
| 462 : | |||
| 463 : | unless ($time1 <= $time2 and $time2 <= $time3) { | ||
| 464 : | warn "The open date: $openDate, due date: $dueDate, and answer date: $answerDate must be defined and in chronologicasl order."; | ||
| 465 : | } | ||
| 466 : | # Check header file names | ||
| 467 : | $paperHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space | ||
| 468 : | $screenHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space | ||
| 469 : | |||
| 470 : | # warn "setNumber: $setNumber\ndueDate: $dueDate\nopenDate: $openDate\nanswerDate: $answerDate\n"; | ||
| 471 : | # warn "time1 $time1 time2 $time2 time3 $time3"; | ||
| 472 : | ##################################################################### | ||
| 473 : | # Read and check list of problems for the set | ||
| 474 : | ##################################################################### | ||
| 475 : | |||
| 476 : | while(<SETFILENAME>) { | ||
| 477 : | chomp($line=$_); | ||
| 478 : | $line =~ s/(#.*)//; ## don't read past comments | ||
| 479 : | unless ($line =~ /\S/) {next;} ## skip blank lines | ||
| 480 : | |||
| 481 : | ($name, $value, $attemptLimit, $continueFlag) = split (/\s*,\s*/,$line); | ||
| 482 : | ##################### | ||
| 483 : | # clean up problem values | ||
| 484 : | ########################### | ||
| 485 : | $name =~ s/\s*//g; | ||
| 486 : | # push(@problemList, $name); | ||
| 487 : | $value = "" unless defined($value); | ||
| 488 : | $value =~ s/[^\d\.]*//g; | ||
| 489 : | unless ($value =~ /\d+/) {$value = 1;} | ||
| 490 : | # push(@problemValueList, $value); | ||
| 491 : | $attemptLimit = "" unless defined($attemptLimit); | ||
| 492 : | $attemptLimit =~ s/[^\d-]*//g; | ||
| 493 : | unless ($attemptLimit =~ /\d+/) {$attemptLimit = -1;} | ||
| 494 : | # push(@problemAttemptLimitList, $attemptLimit); | ||
| 495 : | $continueFlag = "0" unless( defined($continueFlag) && @problemData ); | ||
| 496 : | # can't put continuation flag ont the first problem | ||
| 497 : | # push(@problemContinuationFlagList, $continueFlag); | ||
| 498 : | push(@problemData, {source_file => $name, | ||
| 499 : | value => $value, | ||
| 500 : | max_attempts =>, $attemptLimit, | ||
| 501 : | continuation => $continueFlag | ||
| 502 : | }); | ||
| 503 : | } | ||
| 504 : | close(SETFILENAME); | ||
| 505 : | ($setNumber, | ||
| 506 : | $paperHeaderFile, | ||
| 507 : | $screenHeaderFile, | ||
| 508 : | $time1, | ||
| 509 : | $time2, | ||
| 510 : | $time3, | ||
| 511 : | \@problemData, | ||
| 512 : | ); | ||
| 513 : | } else { | ||
| 514 : | warn "Can't open file $filePath\n"; | ||
| 515 : | } | ||
| 516 : | } | ||
| 517 : | |||
| 518 : | malsyned | 832 | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |