Parent Directory
| 
Revision Log
As best I can determine all "get" commands to the database are now checked and appropriate action (usually "die") is taken if no object is returned. One exception. The multiple "gets" such as getGlobalSets(@setNames) are not checked -- if a given setName is not found is an empty object returned? in the list or is nothing returned? --Mike
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.37 2003/12/09 01:12:31 sh002i 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 224 return CGI::p(CGI::font({-color=>"red"}, "This problem set is not available because it is not yet open.")) 225 unless ($self->{isOpen}); 226 227 my $hardcopyURL = 228 $courseEnvironment->{webworkURLs}->{root} . "/" 229 . $courseEnvironment->{courseName} . "/" 230 . "hardcopy/$setName/?" . $self->url_authen_args; 231 print CGI::p(CGI::a({-href=>$hardcopyURL}, "Download a hardcopy"), 232 "of this problem set."); 233 234 print CGI::start_table(); 235 print CGI::Tr( 236 CGI::th("Name"), 237 CGI::th("Attempts"), 238 CGI::th("Remaining"), 239 CGI::th("Status"), 240 ); 241 242 my $set = $db->getMergedSet($effectiveUser, $setName); # checked 243 die "set $setName for user $effectiveUser not found" unless $set; 244 my @problemNumbers = $db->listUserProblems($effectiveUser, $setName); 245 foreach my $problemNumber (sort { $a <=> $b } @problemNumbers) { 246 my $problem = $db->getMergedProblem($effectiveUser, $setName, $problemNumber); # checked 247 die "problem $problemNumber in set $setName for user $effectiveUser not found." unless $problem; 248 print $self->problemListRow($set, $problem); 249 } 250 251 print CGI::end_table(); 252 253 # feedback form 254 my $ce = $self->{ce}; 255 my $root = $ce->{webworkURLs}->{root}; 256 my $courseName = $ce->{courseName}; 257 my $feedbackURL = "$root/$courseName/feedback/"; 258 # print 259 # CGI::startform("POST", $feedbackURL), 260 # $self->hidden_authen_fields, 261 # CGI::hidden("module", __PACKAGE__), 262 # CGI::hidden("set", $set->set_id), 263 # CGI::p({-align=>"right"}, 264 # CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback") 265 # ), 266 # CGI::endform(); 267 #print feedback form 268 print 269 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 270 $self->hidden_authen_fields,"\n", 271 CGI::hidden("module", __PACKAGE__),"\n", 272 CGI::hidden("set", $self->{set}->set_id),"\n", 273 CGI::hidden("problem", ""),"\n", 274 CGI::hidden("displayMode", $self->{displayMode}),"\n", 275 CGI::hidden("showOldAnswers", ''),"\n", 276 CGI::hidden("showCorrectAnswers", ''),"\n", 277 CGI::hidden("showHints", ''),"\n", 278 CGI::hidden("showSolutions", ''),"\n", 279 CGI::p({-align=>"left"}, 280 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 281 ), 282 CGI::endform(),"\n"; 283 return ""; 284 } 285 286 sub problemListRow($$$) { 287 my $self = shift; 288 my $set = shift; 289 my $problem = shift; 290 291 my $name = $problem->problem_id; 292 my $interactiveURL = "$name/?" . $self->url_authen_args; 293 my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name"); 294 my $attempts = $problem->num_correct + $problem->num_incorrect; 295 my $remaining = $problem->max_attempts < 0 296 ? "unlimited" 297 : $problem->max_attempts - $attempts; 298 my $status = sprintf("%.0f%%", $problem->status * 100); # round to whole number 299 300 return CGI::Tr(CGI::td({-nowrap=>1}, [ 301 $interactive, 302 $attempts, 303 $remaining, 304 $status, 305 ])); 306 } 307 308 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |