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