Parent Directory
| 
Revision Log
Cleaning up commented out code. Added a "due date is...." message to the top of the ProblemSet page.
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/ProblemSet.pm,v 1.38 2003/12/12 02:24:29 gage 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 17 package WeBWorK::ContentGenerator::ProblemSet; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::ProblemSet - display an index of the problems in a 23 problem set. 24 25 =cut 26 27 use strict; 28 use warnings; 29 use CGI qw(); 30 use WeBWorK::PG; 31 32 sub initialize { 33 my ($self, $setName) = @_; 34 my $courseEnvironment = $self->{ce}; 35 my $r = $self->{r}; 36 my $db = $self->{db}; 37 my $userName = $r->param("user"); 38 my $effectiveUserName = $r->param("effectiveUser"); 39 40 my $user = $db->getUser($userName); # checked 41 my $effectiveUser = $db->getUser($effectiveUserName); # checked 42 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked 43 my $permissionLevel = $db->getPermissionLevel($userName)->permission(); # checked 44 45 die "user $user (real user) not found." unless $user; 46 die "effective user $effectiveUserName not found. One 'acts as' the effective user." unless $effectiveUser; 47 die "set $setName for effectiveUser $effectiveUserName not found." unless $set; 48 die "permisson level for user $userName not found." unless defined $permissionLevel; 49 50 $self->{userName} = $userName; 51 $self->{user} = $user; 52 $self->{effectiveUser} = $effectiveUser; 53 $self->{set} = $set; 54 $self->{permissionLevel} = $permissionLevel; 55 56 ##### permissions ##### 57 58 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; 59 } 60 61 sub path { 62 my ($self, $setName, $args) = @_; 63 64 my $ce = $self->{ce}; 65 my $root = $ce->{webworkURLs}->{root}; 66 my $courseName = $ce->{courseName}; 67 return $self->pathMacro($args, 68 "Home" => "$root", 69 $courseName => "$root/$courseName", 70 $setName => "", 71 ); 72 } 73 74 sub nav { 75 my ($self, $setName, $args) = @_; 76 77 my $ce = $self->{ce}; 78 my $root = $ce->{webworkURLs}->{root}; 79 my $courseName = $ce->{courseName}; 80 my @links = ("Problem Sets" , "$root/$courseName", "navUp"); 81 my $tail = ""; 82 83 return $self->navMacro($args, $tail, @links); 84 } 85 86 87 sub siblings { 88 my ($self, $setName) = @_; 89 # $WeBWorK::timer0->continue('begin siblings'); 90 my $ce = $self->{ce}; 91 my $db = $self->{db}; 92 my $root = $ce->{webworkURLs}->{root}; 93 my $courseName = $ce->{courseName}; 94 my $effectiveUser = $self->{r}->param("effectiveUser"); 95 96 print CGI::strong("Problem Sets"), CGI::br(); 97 98 my @sets; 99 100 # FIXME The following access to the complete list of sets is very slow. 101 # $WeBWorK::timer0->continue('collect siblings'); 102 # push @sets, $db->getMergedSet($effectiveUser, $_) 103 # foreach ($db->listUserSets($effectiveUser)); 104 105 my @setNames = $db->listUserSets($effectiveUser); 106 @setNames = sort @setNames; 107 # $WeBWorK::timer0->continue('done collecting siblings'); 108 # FIXME only experience will tell us the best sorting procedure. 109 # due_date seems right for students, but alphabetically may be more 110 # useful for professors? 111 112 # my @sorted_sets; 113 # 114 # # sort by set name 115 # #@sorted_sets = sort { $a->set_id cmp $b->set_id } @sets; 116 # 117 # # sort by set due date 118 # $WeBWorK::timer0->continue('begin sorting siblings'); 119 # @sorted_sets = sort { $a->due_date <=> $b->due_date } @sets; 120 # 121 # # ...and put closed sets last; 122 # my $now = time(); 123 # my @open_sets = grep { $_->due_date > $now } @sorted_sets; 124 # my @closed_sets = grep { $_->due_date <= $now } @sorted_sets; 125 # @sorted_sets = (@open_sets,@closed_sets); 126 # $WeBWorK::timer0->continue('end sorting siblings'); 127 # foreach my $set (@sorted_sets) { 128 # if (time >= $set->open_date) { 129 # print CGI::a({-href=>"$root/$courseName/".$set->set_id."/?" 130 # . $self->url_authen_args}, $set->set_id), CGI::br(); 131 # } else { 132 # print $set->set_id, CGI::br(); 133 # } 134 # } 135 # hack to put links up quickly FIXME when database is faster. 136 foreach my $setName (@setNames) { 137 138 print ' '.CGI::a({-href=>"$root/$courseName/".$setName."/?" 139 . $self->url_authen_args}, $setName), CGI::br(); 140 141 142 } 143 } 144 145 sub title { 146 my ($self, $setName) = @_; 147 148 return $setName; 149 } 150 151 sub info { 152 my ($self, $setName) = @_; 153 154 my $r = $self->{r}; 155 my $ce = $self->{ce}; 156 my $db = $self->{db}; 157 158 return "" unless $self->{isOpen}; 159 160 my $effectiveUser = $db->getUser($r->param("effectiveUser")); # checked 161 die "effective user ".$r->param("effectiveUser")." not found. One 'acts as' the effective user." unless $effectiveUser; 162 my $set = $db->getMergedSet($effectiveUser->user_id, $setName); # checked 163 die "set $setName for effectiveUser ".$effectiveUser->user_id." not found." unless $set; 164 my $psvn = $set->psvn(); 165 166 my $screenSetHeader = $set->set_header || $ce->{webworkFiles}->{screenSnippets}->{setHeader}; 167 my $displayMode = $ce->{pg}->{options}->{displayMode}; 168 169 return "" unless defined $screenSetHeader and $screenSetHeader; 170 171 # decide what to do about problem number 172 my $problem = WeBWorK::DB::Record::UserProblem->new( 173 problem_id => 0, 174 set_id => $set->set_id, 175 login_id => $effectiveUser->user_id, 176 source_file => $screenSetHeader, 177 # the rest of Problem's fields are not needed, i think 178 ); 179 180 my $pg = WeBWorK::PG->new( 181 $ce, 182 $effectiveUser, 183 $r->param('key'), 184 $set, 185 $problem, 186 $psvn, 187 {}, # no form fields! 188 { # translation options 189 displayMode => $displayMode, 190 showHints => 0, 191 showSolutions => 0, 192 processAnswers => 0, 193 }, 194 ); 195 # Add link for editor 196 #### link to edit setHeader 197 my $editor_link = ''; 198 if (defined($set) and $set->set_header and 199 $self->{permissionLevel} >= $ce->{permissionLevels}->{modify_problem_sets} ) { 200 #FIXME ? can't edit the default set header this way 201 $editor_link = CGI::p( 202 CGI::a({-href=>$ce->{webworkURLs}->{root}.'/'.$ce->{courseName}. 203 '/instructor/pgProblemEditor/'. 204 $set->set_id.'/0'. '?'.$self->url_authen_args}, 205 'Edit set header: '.$set->set_header 206 ) 207 ); 208 } 209 # handle translation errors 210 if ($pg->{flags}->{error_flag}) { 211 return $self->errorOutput($pg->{errors}, $pg->{body_text}.$editor_link); 212 } else { 213 return $pg->{body_text}.$editor_link; 214 } 215 } 216 217 sub body { 218 my ($self, $setName) = @_; 219 my $r = $self->{r}; 220 my $courseEnvironment = $self->{ce}; 221 my $db = $self->{db}; 222 my $effectiveUser = $r->param('effectiveUser'); 223 my $set = $db->getMergedSet($effectiveUser, $setName); # checked 224 die "set $setName for user $effectiveUser not found" unless $set; 225 226 print "$setName is due: ",WeBWorK::Utils::formatDateTime($set->due_date); 227 return CGI::p(CGI::font({-color=>"red"}, "This problem set is not available because it is not yet open.")) 228 unless ($self->{isOpen}); 229 230 my $hardcopyURL = 231 $courseEnvironment->{webworkURLs}->{root} . "/" 232 . $courseEnvironment->{courseName} . "/" 233 . "hardcopy/$setName/?" . $self->url_authen_args; 234 print CGI::p(CGI::a({-href=>$hardcopyURL}, "Download a hardcopy"), 235 "of this problem set."); 236 237 print CGI::start_table(); 238 print CGI::Tr( 239 CGI::th("Name"), 240 CGI::th("Attempts"), 241 CGI::th("Remaining"), 242 CGI::th("Status"), 243 ); 244 245 246 my @problemNumbers = $db->listUserProblems($effectiveUser, $setName); 247 foreach my $problemNumber (sort { $a <=> $b } @problemNumbers) { 248 my $problem = $db->getMergedProblem($effectiveUser, $setName, $problemNumber); # checked 249 die "problem $problemNumber in set $setName for user $effectiveUser not found." unless $problem; 250 print $self->problemListRow($set, $problem); 251 } 252 253 print CGI::end_table(); 254 255 # feedback form 256 my $ce = $self->{ce}; 257 my $root = $ce->{webworkURLs}->{root}; 258 my $courseName = $ce->{courseName}; 259 my $feedbackURL = "$root/$courseName/feedback/"; 260 # print 261 # CGI::startform("POST", $feedbackURL), 262 # $self->hidden_authen_fields, 263 # CGI::hidden("module", __PACKAGE__), 264 # CGI::hidden("set", $set->set_id), 265 # CGI::p({-align=>"right"}, 266 # CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback") 267 # ), 268 # CGI::endform(); 269 #print feedback form 270 print 271 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 272 $self->hidden_authen_fields,"\n", 273 CGI::hidden("module", __PACKAGE__),"\n", 274 CGI::hidden("set", $self->{set}->set_id),"\n", 275 CGI::hidden("problem", ""),"\n", 276 CGI::hidden("displayMode", $self->{displayMode}),"\n", 277 CGI::hidden("showOldAnswers", ''),"\n", 278 CGI::hidden("showCorrectAnswers", ''),"\n", 279 CGI::hidden("showHints", ''),"\n", 280 CGI::hidden("showSolutions", ''),"\n", 281 CGI::p({-align=>"left"}, 282 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 283 ), 284 CGI::endform(),"\n"; 285 return ""; 286 } 287 288 sub problemListRow($$$) { 289 my $self = shift; 290 my $set = shift; 291 my $problem = shift; 292 293 my $name = $problem->problem_id; 294 my $interactiveURL = "$name/?" . $self->url_authen_args; 295 my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name"); 296 my $attempts = $problem->num_correct + $problem->num_incorrect; 297 my $remaining = $problem->max_attempts < 0 298 ? "unlimited" 299 : $problem->max_attempts - $attempts; 300 my $status = sprintf("%.0f%%", $problem->status * 100); # round to whole number 301 302 return CGI::Tr(CGI::td({-nowrap=>1}, [ 303 $interactive, 304 $attempts, 305 $remaining, 306 $status, 307 ])); 308 } 309 310 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |