[system] / trunk / webwork-modperl / lib / WeBWorK / ContentGenerator / Instructor / ProblemSetList.pm Repository:
ViewVC logotype

Diff of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm

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

Revision 836 Revision 2109
1################################################################################
2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm,v 1.49 2004/05/13 16:02:55 toenail Exp $
5#
6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package.
10#
11# This program is distributed in the hope that it will be useful, but WITHOUT
12# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14# Artistic License for more details.
15################################################################################
16
1package WeBWorK::ContentGenerator::Instructor::ProblemSetList; 17package WeBWorK::ContentGenerator::Instructor::ProblemSetList;
2use base qw(WeBWorK::ContentGenerator::Instructor); 18use base qw(WeBWorK::ContentGenerator::Instructor);
3 19
4=head1 NAME 20=head1 NAME
5 21
… …
7 23
8=cut 24=cut
9 25
10use strict; 26use strict;
11use warnings; 27use warnings;
28use Apache::Constants qw(REDIRECT);
12use CGI qw(); 29use CGI qw();
30use WeBWorK::Utils qw(formatDateTime);
31use WeBWorK::Compatibility;
13 32
14sub title { 33use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts continuation)];
34
35sub header {
15 my $self = shift; 36 my $self = shift;
16 return "Instructor Tools - Problem Set List for ".$self->{ce}->{courseName}; 37 my $r = $self->r;
38 my $urlpath = $r->urlpath;
39 my $ce = $r->ce;
40 my $courseName = $urlpath->arg("courseID");
41 my $scoringPage = $urlpath -> newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring',
42 courseID => $courseName
43 );
44 if (defined $r->param('scoreSelected')) {
45 my $scoringPageURL = $self->systemLink($scoringPage,
46 params=>['scoreSelected','selectedSet','recordSingleSetScores' ]
47 );
48 $r->header_out(Location => $scoringPageURL);
49 $self->{noContent} = 1;
50 return REDIRECT;
51 }
52 $r->content_type("text/html");
53 $r->send_http_header();
17} 54}
18 55
56sub initialize {
57 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
66 unless ($authz->hasPermissions($user, "create_and_delete_problem_sets")) {
67 $self->addmessage(CGI::div({class=>"ResultsWithError"}, CGI::p("You aren't authorized to create or delete problems")));
68 return;
69 }
70 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 foreach my $wannaDelete ($r->param('selectedSet')) {
78 $db->deleteGlobalSet($wannaDelete);
79 }
80 } elsif (defined $r->param('scoreSelected')) {
81 # FIXME: this doesn't do anything!
82 } elsif (defined $r->param('makeNewSet')) {
83 my $newSetRecord = $db->{set}->{record}->new();
84 my $newSetName = $r->param('newSetName');
85 $newSetRecord->set_id($newSetName);
86 $newSetRecord->set_header("");
87 $newSetRecord->problem_header("");
88 $newSetRecord->open_date("0");
89 $newSetRecord->due_date("0");
90 $newSetRecord->answer_date("0");
91 eval {$db->addGlobalSet($newSetRecord)};
92 } 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
102 foreach my $set_definition_file (@setDefFiles) {
103 $WeBWorK::timer->continue("$set_definition_file: reading set definition file") if defined $WeBWorK::timer;
104 # 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
115 $WeBWorK::timer->continue("$set_definition_file: adding set") if defined $WeBWorK::timer;
116 # 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 $WeBWorK::timer->continue("$set_definition_file: adding problems to database") if defined $WeBWorK::timer;
131 # 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 if ($r->param("assignNewSet")) {
148 $WeBWorK::timer->continue("$set_definition_file: assigning set to all users") if defined $WeBWorK::timer;
149 # assign the set to all users
150 $self->assignSetToAllUsers($setName);
151 }
152 }
153 }
154}
155
156
157
158
19sub body { 159sub body {
160 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 my $effectiveUserName = $r->param('effectiveUser');
171
172 my $problemSetListPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName) ;
173 my $problemSetListURL = $self->systemLink($problemSetListPage, authen=>0);
174
175 #my $instructorBaseURL = "$root/$courseName/instructor";
176 #my $importURL = "$instructorBaseURL/problemSetImport/";
177 my $instructorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::Index",
178 courseID => $courseName
179 );
180 my $sort = $r->param('sort') ? $r->param('sort') : "due_date";
181
182 my @set_definition_files = $self->read_dir($ce->{courseDirs}->{templates},'\\.def');
183 return CGI::em("You are not authorized to access the instructor tools")
184 unless $authz->hasPermissions($user, "access_instructor_tools");
185
186 ###############################################################################
187 # Slurp each set record for this course in @sets
188 # Gather data from the database
189 ###############################################################################
190 my @users = $db->listUsers;
191 ###############################################################################
192 # for compatibility check to make sure that the global user has been defined.
193 ###############################################################################
194 my $globalUser = $ce->{dbLayout}->{set}->{params}->{globalUserID};
195 my $database_type = $ce->{dbLayoutName};
196 my $global_user_alert = "";
197 my $global_user_message = "";
198 $global_user_message = $self->{global_user_message} if defined($self->{global_user_message});
199 if (defined($globalUser) and $globalUser and $database_type eq 'gdbm') { # if a name for the global user has been defined in database.conf
200 my $flag = 0;
201 foreach $user (@users) {
202 $flag = 1 if $user eq $globalUser;
203 }
204
205 if ($flag == 0 ) { # no global user has been added to this course
206 $global_user_alert = join("",
207 CGI::div({class=>'ResultsWithError'},
208 CGI::p("This is the first time that this course
209 has been used with WeBWorK 2.0 and no 'Global User' has been defined. In WeBWorK 2.0
210 a set and it's problems can exist without being assigned to any real student or instructor --
211 instead it is assigned to this fictional 'Global User' whose id is $globalUser.
212 Press this button to initialize the global user files so that you can view sets built in
213 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."
214 ),
215 CGI::p("Depending on the number of sets, this operation may take many minutes. Even if your browser times out
216 the updating process will continue until it is done. Time for coffee? :-)"
217 ),
218 CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}),
219 $self->hidden_authen_fields,
220 CGI::submit({-name=>'update_global_user', -value=>"Update Global User" }),
221 CGI::end_form(),
222 ),
223 );
224 #$global_user_message = WeBWorK::Compatibility::update_global_user($self);
225 }
226 }
227 ###############################################################################
228 # end compatibility check
229 ###############################################################################
230 my @set_IDs = $db->listGlobalSets;
231 my @sets = $db->getGlobalSets(@set_IDs); #checked
232 my %counts;
233 my %problemCounts;
234
235
236 $WeBWorK::timer->continue("Begin obtaining problem info on sets") if defined $WeBWorK::timer;
237 foreach my $set_id (@set_IDs) {
238 $problemCounts{$set_id} = scalar($db->listGlobalProblems($set_id));
239 #$counts{$set_id} = $db->listSetUsers($set_id);
240 }
241 $WeBWorK::timer->continue("End obtaining problem on sets") if defined $WeBWorK::timer;
242
243 $WeBWorK::timer->continue("Begin obtaining assigned user info on sets") if defined $WeBWorK::timer;
244 foreach my $set_id (@set_IDs) {
245 #$problemCounts{$set_id} = scalar($db->listGlobalProblems($set_id));
246 #$counts{$set_id} = $db->listSetUsers($set_id);
247 $counts{$set_id} = $db->countSetUsers($set_id);
248 }
249 $WeBWorK::timer->continue("End obtaining assigned user info on sets") if defined $WeBWorK::timer;
20 250
251 # Sort @sets based on the sort parameter
252 # Invalid sort types will just cause an unpredictable ordering, which is no big deal.
253 @sets = sort {
254 if ($sort eq "set_id") {
255 return $a->$sort cmp $b->$sort;
256 }elsif ($sort =~ /_date$/) {
257 return $a->$sort <=> $b->$sort;
258 } elsif ($sort eq "num_probs") {
259 return $problemCounts{$a->set_id} <=> $problemCounts{$b->set_id};
260 } elsif ($sort eq "num_students") {
261 return $counts{$a->set_id} <=> $counts{$b->set_id};
262 }
263 } @sets;
264
265 my $table = CGI::Tr({},
266 CGI::th([
267 "Sel.",
268 CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'set_id' })}, "Sort by name" ),
269 CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'open_date' })}, "Sort by Open Date" ),
270 CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'due_date' })}, "Sort by Due Date" ),
271 CGI::a({"href"=>$self->systemLink($problemSetListPage,params=>{sort=>'answer_date' })}, "Sort by Answer Date" ),
272 "Edit problems",
273 "Assign users" ,
274 ])
275 );
276
277 foreach my $set (@sets) {
278 my $count = $counts{$set->set_id};
279 my $totalUsers = scalar(@users); #FIXME -- probably shouldn't count those who have dropped.
280 my $userCountMessage = $self->userCountMessage($count, scalar(@users));
281 my $setEditorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ProblemSetEditor",
282 courseID => $courseName,
283 setID => $set->set_id,
284 );
285 my $problemListPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ProblemList",
286 courseID => $courseName,
287 setID => $set->set_id,
288 );
289 my $usersAssignedToSetPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet",
290 courseID => $courseName,
291 setID => $set->set_id,
292 );
293 my $problemSetEditorPage = $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::ProblemSetEditor',
294 courseID => $courseName,
295 setID => $set->set_id,
296 );
297
298 my $publishedClass = ($set->published) ? "Published" : "Unpublished";
299 $table .= CGI::Tr({},
300 CGI::td([
301 CGI::checkbox({
302 "name"=>"selectedSet",
303 "value"=>$set->set_id,
304 "label"=>"",
305 "checked"=>"0"
306 }),
307 CGI::font({class=>$publishedClass}, '&nbsp;&nbsp;'.$set->set_id) . '&nbsp;'.CGI::a({href=>$self->systemLink($setEditorPage)}, 'Edit'),
308 formatDateTime($set->open_date),
309 formatDateTime($set->due_date),
310 formatDateTime($set->answer_date),
311 CGI::a({href=>$self->systemLink($problemListPage )}, $problemCounts{$set->set_id}),
312 CGI::a({href=>$self->systemLink($usersAssignedToSetPage)}, "$count/$totalUsers") ,
313 ])
314 ) . "\n"
315 }
316 $table = CGI::table({"border"=>"1"}, "\n".$table."\n");
317
318 my $slownessWarning = "";
319 if ($ce->{dbLayoutName} eq "sql") {
320 $slownessWarning = "In this version of WeBWorK, assigning sets is very slow. Your browser"
321 . " may time out if you import many sets or have many users to whom to assign them. If this"
322 . " happens, click your browser's reload button. This issue will be resolved in a later"
323 . " version of WeBWorK. (Hopefully the next version!)"
324 . CGI::br();
325 }
326
327 print join("\n",
328 $global_user_alert,
329 $global_user_message,
330 # Set table form (for deleting checked sets)
331 CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}),
332 $self->hidden_authen_fields,
333 $table,
334 CGI::br(),
335
336 CGI::submit({"name"=>"scoreSelected", "label"=>"Score Selected"}),
337 CGI::div( {class=>'ResultsWithError'},
338 "There is NO undo when deleting sets. Use cautiously. All data for the set is lost.
339 <br>If the set is re-assigned (rebuilt) all of the problem versions will be different.",
340 CGI::br(),
341 CGI::submit({"name"=>"deleteSelected", "label"=>"Delete Selected"}),
342 CGI::radio_group(-name=>"deleteSelectedSafety", -values=>[0,1], -default=>0, -labels=>{0=>'Read only', 1=>'Allow delete'}),
343
344 ),
345 CGI::end_form(),
346 CGI::br(),
347
348 # Empty set creation form
349 CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}),
350 $self->hidden_authen_fields,
351 CGI::b("Create an Empty Set"),
352 CGI::br(),
353 "New Set Name: ",
354 CGI::input({type=>"text", name=>"newSetName", value=>""}),
355 CGI::submit({"name"=>"makeNewSet", "label"=>"Create"}),
356 CGI::end_form(),
357 CGI::br(),
358
359 # Single set import form
360 CGI::hr(),
361 CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}),
362 $self->hidden_authen_fields,
363 CGI::b("Import a Single Set"),
364 CGI::br(),
365 "From file: ",
366 CGI::popup_menu(-name=>'set_definition_file', -values=>\@set_definition_files),
367 CGI::br(),
368 "Set name: ",
369 CGI::input({type=>"text", name=>"newSetName", value=>""}),
370 " (leave blank to use name of set definition file)",
371 CGI::br(),
372 CGI::checkbox(-name=>"assignNewSet",
373 -label=>"Assign imported set to all current users"),
374 CGI::br(),
375 CGI::submit({"name"=>"importSet", "label"=>"Import a Single Set"}),
376 CGI::end_form(),
377 CGI::br(),
378
379 # Multiple set import form
380 CGI::hr(),
381 CGI::start_form({"method"=>"POST", "action"=>$problemSetListURL}),
382 $self->hidden_authen_fields,
383 CGI::b("Import Multiple Sets"),
384 CGI::br(),
385 "Each set will be named based on the name of the set definition file, omitting",
386 " any leading ", CGI::i("set"), " and trailing ", CGI::i(".def"), ". Note that",
387 " the name of a set cannot be changed once it has been created.",
388 CGI::br(),
389 CGI::scrolling_list(-name=>"set_definition_files", -values=>\@set_definition_files, -size=>10, -multiple=>"true"),
390 CGI::br(),
391 CGI::checkbox(-name=>"assignNewSet", -label=>"Assign imported sets to all current users"),
392 CGI::br(),
393 $slownessWarning,
394 CGI::submit({"name"=>"importSets", "label"=>"Import Multiple Sets"}),
395 CGI::end_form(),
396 );
397
398 return "";
21} 399}
22 400
401##############################################################################################
402# Utility scripts -- may be moved to Utils.pm
403##############################################################################################
404
405
406sub readSetDef {
407 my $self = shift;
408 my $fileName = shift;
409 my $templateDir = $self->{ce}->{courseDirs}->{templates};
410 my $filePath = "$templateDir/$fileName";
411 my $setNumber = '';
412 if ($fileName =~ m|^set(\w+)\.def$|) {
413 $setNumber = $1;
414 } else {
415 warn qq{The setDefinition file name must begin with <CODE>set</CODE>},
416 qq{and must end with <CODE>.def</CODE> . Every thing in between becomes the name of the set. },
417 qq{For example <CODE>set1.def</CODE>, <CODE>setExam.def</CODE>, and <CODE>setsample7.def</CODE> },
418 qq{define sets named <CODE>1</CODE>, <CODE>Exam</CODE>, and <CODE>sample7</CODE> respectively. },
419 qq{The filename, $fileName, you entered is not legal\n };
420
421 }
422
423 my ($line,$name,$value,$attemptLimit,$continueFlag);
424 my $paperHeaderFile = '';
425 my $screenHeaderFile = '';
426 my ($dueDate,$openDate,$answerDate);
427 my @problemData;
428 if ( open (SETFILENAME, "$filePath") ) {
429 #####################################################################
430 # Read and check set data
431 #####################################################################
432 while (<SETFILENAME>) {
433 chomp($line = $_);
434 $line =~ s|(#.*)||; ## don't read past comments
435 unless ($line =~ /\S/) {next;} ## skip blank lines
436 $line =~ s|\s*$||; ## trim trailing spaces
437 $line =~ m|^\s*(\w+)\s*=\s*(.*)|;
438
439 ######################
440 # sanity check entries
441 ######################
442 my $item = $1;
443 $item = '' unless defined $item;
444 my $value = $2;
445 $value = '' unless defined $value;
446
447 if ($item eq 'setNumber') {
448 next;
449 } elsif ($item eq 'paperHeaderFile') {
450 $paperHeaderFile = $value;
451 } elsif ($item eq 'screenHeaderFile') {
452 $screenHeaderFile = $value;
453 } elsif ($item eq 'dueDate') {
454 $dueDate = $value;
455 } elsif ($item eq 'openDate') {
456 $openDate = $value;
457 } elsif ($1 eq 'answerDate') {
458 $answerDate = $value;
459 } elsif ($item eq 'problemList') {
460 last;
461 } else {
462 warn "readSetDef error, can't read the line: ||$line||";
463 }
464 }
465 #####################################################################
466 # Check and format dates
467 #####################################################################
468 my ($time1,$time2,$time3) = map { $_ =~ s/\s*at\s*/ /; WeBWorK::Utils::parseDateTime($_); } ($openDate, $dueDate, $answerDate);
469
470 unless ($time1 <= $time2 and $time2 <= $time3) {
471 warn "The open date: $openDate, due date: $dueDate, and answer date: $answerDate must be defined and in chronologicasl order.";
472 }
473 # Check header file names
474 $paperHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space
475 $screenHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space
476
477 # warn "setNumber: $setNumber\ndueDate: $dueDate\nopenDate: $openDate\nanswerDate: $answerDate\n";
478 # warn "time1 $time1 time2 $time2 time3 $time3";
479 #####################################################################
480 # Read and check list of problems for the set
481 #####################################################################
482
483 while(<SETFILENAME>) {
484 chomp($line=$_);
485 $line =~ s/(#.*)//; ## don't read past comments
486 unless ($line =~ /\S/) {next;} ## skip blank lines
487
488 ($name, $value, $attemptLimit, $continueFlag) = split (/\s*,\s*/,$line);
489 #####################
490 # clean up problem values
491 ###########################
492 $name =~ s/\s*//g;
493 # push(@problemList, $name);
494 $value = "" unless defined($value);
495 $value =~ s/[^\d\.]*//g;
496 unless ($value =~ /\d+/) {$value = 1;}
497 # push(@problemValueList, $value);
498 $attemptLimit = "" unless defined($attemptLimit);
499 $attemptLimit =~ s/[^\d-]*//g;
500 unless ($attemptLimit =~ /\d+/) {$attemptLimit = -1;}
501 # push(@problemAttemptLimitList, $attemptLimit);
502 $continueFlag = "0" unless( defined($continueFlag) && @problemData );
503 # can't put continuation flag ont the first problem
504 # push(@problemContinuationFlagList, $continueFlag);
505 push(@problemData, {source_file => $name,
506 value => $value,
507 max_attempts =>, $attemptLimit,
508 continuation => $continueFlag
509 });
510 }
511 close(SETFILENAME);
512 ($setNumber,
513 $paperHeaderFile,
514 $screenHeaderFile,
515 $time1,
516 $time2,
517 $time3,
518 \@problemData,
519 );
520 } else {
521 warn "Can't open file $filePath\n";
522 }
523}
524
231; 5251;
Legend:
Removed from v.836  
changed lines
  Added in v.2109
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9