[system] / branches / rel-2-3-dev / webwork-modperl / lib / WeBWorK / ContentGenerator / Instructor / ProblemSetList.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1427 Revision 1428
… …
10use strict; 10use strict;
11use warnings; 11use warnings;
12use Apache::Constants qw(REDIRECT); 12use Apache::Constants qw(REDIRECT);
13use CGI qw(); 13use CGI qw();
14use WeBWorK::Utils qw(formatDateTime); 14use WeBWorK::Utils qw(formatDateTime);
15
16use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts continuation)];
15 17
16sub header { 18sub header {
17 my $self = shift; 19 my $self = shift;
18 my $r = $self->{r}; 20 my $r = $self->{r};
19 my $ce = $self->{ce}; 21 my $ce = $self->{ce};
… …
47 foreach my $wannaDelete ($r->param('selectedSet')) { 49 foreach my $wannaDelete ($r->param('selectedSet')) {
48 $db->deleteGlobalSet($wannaDelete); 50 $db->deleteGlobalSet($wannaDelete);
49 } 51 }
50 } elsif (defined($r->param('scoreSelected'))) { 52 } elsif (defined($r->param('scoreSelected'))) {
51 53
52 }elsif (defined($r->param('makeNewSet'))) { 54 }elsif ( defined($r->param('makeNewSet')) ) {
53 my $newSetRecord = $db->{set}->{record}->new(); 55 my $newSetRecord = $db->{set}->{record}->new();
54 my $newSetName = $r->param('newSetName'); 56 my $newSetName = $r->param('newSetName');
55 $newSetRecord->set_id($newSetName); 57 $newSetRecord->set_id($newSetName);
56 $newSetRecord->set_header(""); 58 $newSetRecord->set_header("");
57 $newSetRecord->problem_header(""); 59 $newSetRecord->problem_header("");
58 $newSetRecord->open_date("0"); 60 $newSetRecord->open_date("0");
59 $newSetRecord->due_date("0"); 61 $newSetRecord->due_date("0");
60 $newSetRecord->answer_date("0"); 62 $newSetRecord->answer_date("0");
61 eval {$db->addGlobalSet($newSetRecord)}; 63 eval {$db->addGlobalSet($newSetRecord)};
64 } elsif (defined($r->param('importSet') ) ) {
65 my $newSetRecord = $db->{set}->{record}->new();
66 my $newSetName = $r->param('newSetName');
67 ##############################################
68 # read data in set definition file
69 # add the data to the set record
70 ##############################################
71 my $set_definition_file = $r->param('set_definition_file');
72
73
74 my ( $setName, $paperHeaderFile, $screenHeaderFile,
75 $openDate, $dueDate, $answerDate,
76 $ra_problemData,
77 ) = $self->readSetDef($set_definition_file);
78
79 # Use the original name if form doesn't specify a new one.
80 $newSetName = $setName unless $newSetName;
81
82 # The set acquires the new name specified by the form. A blank
83 # entry on the form indicates that the imported set name will be used.
84 $newSetRecord->set_id($newSetName);
85 $newSetRecord->set_header($screenHeaderFile);
86 $newSetRecord->problem_header($paperHeaderFile);
87 $newSetRecord->open_date($openDate);
88 $newSetRecord->due_date($dueDate);
89 $newSetRecord->answer_date($answerDate);
90
91 #create the set
92 eval {$db->addGlobalSet($newSetRecord)};
93 die "addGlobalSet $newSetName in ProblemSetList: $@" if $@;
94 ##############################################
95 my @problemList = @{$ra_problemData};
96 # add problems
97 my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($newSetName)) + 1;
98 foreach my $rh_problem (@problemList) {
99
100 my $problemRecord = new WeBWorK::DB::Record::Problem;
101 $problemRecord->problem_id($freeProblemID++);
102 #warn "Adding problem $freeProblemID ", $rh_problem->source_file;
103 $problemRecord->set_id($newSetName);
104 $problemRecord->source_file($rh_problem->{source_file});
105 $problemRecord->value($rh_problem->{value});
106 $problemRecord->max_attempts($rh_problem->{max_attempts});
107 # continuation flags???
108 $db->addGlobalProblem($problemRecord);
109 $self->assignProblemToAllSetUsers($problemRecord); # handled by parent
62 } 110 }
111
112 }
63} 113}
64 114
65sub path { 115sub path {
66 my ($self, $args) = @_; 116 my ($self, $args) = @_;
67 117
… …
174 $self->hidden_authen_fields,"\n", 224 $self->hidden_authen_fields,"\n",
175 "New Set Name: ", 225 "New Set Name: ",
176 CGI::input({type=>"text", name=>"newSetName", value=>""}), 226 CGI::input({type=>"text", name=>"newSetName", value=>""}),
177 CGI::submit({"name"=>"makeNewSet", "label"=>"Create"}),"\n", 227 CGI::submit({"name"=>"makeNewSet", "label"=>"Create"}),"\n",
178 CGI::end_form(),"\n", 228 CGI::end_form(),"\n",
179 CGI::start_form({"method"=>"POST", "action"=>$importURL}),"\n", 229 CGI::start_form({"method"=>"POST", "action"=>$r->uri}),"\n",
180 $self->hidden_authen_fields,"\n", 230 $self->hidden_authen_fields,"\n",
181 CGI::submit({"name"=>"importSet", "label"=>"Import"}),"\n", 231 CGI::submit({"name"=>"importSet", "label"=>"Import"}),"\n",
182 CGI::popup_menu(-name=>'set_definition_file', 232 CGI::popup_menu(-name=>'set_definition_file',
183 -values=>\@set_definition_files, 233 -values=>\@set_definition_files,
184 ),' as set ', 234 ),' as set ',
185 CGI::input({type=>"text", name=>"importedSetName", value=>""}), 235 CGI::input({type=>"text", name=>"newSetName", value=>""}),
186 CGI::end_form(),"\n" 236 CGI::end_form(),"\n"
187 ); 237 );
188 print $form; 238 print $form;
189 239
190 return ""; 240 return "";
191} 241}
192 242
243##############################################################################################
244# Utility scripts -- may be moved to Utils.pm
245##############################################################################################
246
247
248sub readSetDef {
249 my $self = shift;
250 my $fileName = shift;
251 my $templateDir = $self->{ce}->{courseDirs}->{templates};
252 my $filePath = "$templateDir/$fileName";
253 my $setNumber = '';
254 if ($fileName =~ m|^set(\w+)\.def$|) {
255 $setNumber = $1;
256 } else {
257 warn qq{The setDefinition file name must begin with <CODE>set</CODE>},
258 qq{and must end with <CODE>.def</CODE> . Every thing in between becomes the name of the set. },
259 qq{For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE> },
260 qq{define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. },
261 qq{The filename, $fileName, you entered is not legal\n };
262
263 }
264
265 my ($line,$name,$value,$attemptLimit,$continueFlag);
266 my $paperHeaderFile = '';
267 my $screenHeaderFile = '';
268 my ($dueDate,$openDate,$answerDate);
269 my @problemData;
270 if ( open (SETFILENAME, "$filePath") ) {
271 #####################################################################
272 # Read and check set data
273 #####################################################################
274 while (<SETFILENAME>) {
275 chomp($line = $_);
276 $line =~ s|(#.*)||; ## don't read past comments
277 unless ($line =~ /\S/) {next;} ## skip blank lines
278 $line =~ s|\s*$||; ## trim trailing spaces
279 $line =~ m|^\s*(\w+)\s*=\s*(.*)|;
280 if ($1 eq 'setNumber') {
281 next;
282 } elsif ($1 eq 'paperHeaderFile') {
283 $paperHeaderFile = $2;
284 } elsif ($1 eq 'screenHeaderFile') {
285 $screenHeaderFile = $2;
286 } elsif ($1 eq 'dueDate') {
287 $dueDate = $2;
288 } elsif ($1 eq 'openDate') {
289 $openDate = $2;
290 } elsif ($1 eq 'answerDate') {
291 $answerDate = $2;
292 } elsif ($1 eq 'problemList') {
293 last;
294 } else {
295 warn "readSetDef error, can't read the line: $line";
296 }
297 }
298 #####################################################################
299 # Check and format dates
300 #####################################################################
301 my ($time1,$time2,$time3) = map { $_ =~ s/\s*at\s*/ /; WeBWorK::Utils::parseDateTime($_); } ($openDate, $dueDate, $answerDate);
302
303 unless ($time1 <= $time2 and $time2 <= $time3) {
304 warn "The open date: $openDate, due date: $dueDate, and answer date: $answerDate must be defined and in chronologicasl order.";
305 }
306 # Check header file names
307 $paperHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space
308 $screenHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space
309
310 # warn "setNumber: $setNumber\ndueDate: $dueDate\nopenDate: $openDate\nanswerDate: $answerDate\n";
311 # warn "time1 $time1 time2 $time2 time3 $time3";
312 #####################################################################
313 # Read and check list of problems for the set
314 #####################################################################
315
316 while(<SETFILENAME>) {
317 chomp($line=$_);
318 $line =~ s/(#.*)//; ## don't read past comments
319 unless ($line =~ /\S/) {next;} ## skip blank lines
320
321 ($name, $value, $attemptLimit, $continueFlag) = split (/\s*,\s*/,$line);
322 #####################
323 # clean up problem values
324 ###########################
325 $name =~ s/\s*//g;
326 # push(@problemList, $name);
327 $value = "" unless defined($value);
328 $value =~ s/[^\d\.]*//g;
329 unless ($value =~ /\d+/) {$value = 1;}
330 # push(@problemValueList, $value);
331 $attemptLimit = "" unless defined($attemptLimit);
332 $attemptLimit =~ s/[^\d-]*//g;
333 unless ($attemptLimit =~ /\d+/) {$attemptLimit = -1;}
334 # push(@problemAttemptLimitList, $attemptLimit);
335 $continueFlag = "0" unless( defined($continueFlag) && @problemData );
336 # can't put continuation flag ont the first problem
337 # push(@problemContinuationFlagList, $continueFlag);
338 push(@problemData, {source_file => $name,
339 value => $value,
340 max_attempts =>, $attemptLimit,
341 continuation => $continueFlag
342 });
343 }
344 close(SETFILENAME);
345 ($setNumber,
346 $paperHeaderFile,
347 $screenHeaderFile,
348 $time1,
349 $time2,
350 $time3,
351 \@problemData,
352 );
353 } else {
354 warn "Can't open file $filePath\n";
355 }
356}
357
1931; 3581;
Legend:
Removed from v.1427  
changed lines
  Added in v.1428
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9