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