Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-1-patches'.
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/ProblemSets.pm,v 1.55 2004/09/13 19:35:05 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::ProblemSets; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::ProblemSets - Display a list of built problem sets. 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI qw(); 29 use WeBWorK::Utils qw(readFile sortByName); 30 31 # what do we consider a "recent" problem set? 32 use constant RECENT => 2*7*24*60*60 ; # Two-Weeks in seconds 33 34 sub info { 35 my ($self) = @_; 36 my $r = $self->r; 37 my $ce = $r->ce; 38 my $db = $r->db; 39 my $urlpath = $r->urlpath; 40 my $authz = $r->authz; 41 42 my $courseID = $urlpath->arg("courseID"); 43 my $user = $r->param("user"); 44 45 my $course_info = $ce->{courseFiles}->{course_info}; 46 47 if (defined $course_info and $course_info) { 48 my $course_info_path = $ce->{courseDirs}->{templates} . "/$course_info"; 49 50 # deal with instructor crap 51 if ($authz->hasPermissions($user, "access_instructor_tools")) { 52 if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile") { 53 $course_info_path .= ".$user.tmp"; # this gets a big FIXME for obvious reasons 54 } 55 56 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", courseID => $courseID); 57 my $editorURL = $self->systemLink($editorPage, params => { file_type => "course_info" }); 58 59 print CGI::p(CGI::b("Course Info"), " ", 60 CGI::a({href=>$editorURL}, "[edit]")); 61 } else { 62 print CGI::p(CGI::b("Course Info")); 63 } 64 65 if (-f $course_info_path) { 66 my $text = eval { readFile($course_info_path) }; 67 if ($@) { 68 print CGI::div({class=>"ResultsWithError"}, 69 CGI::p("$@"), 70 ); 71 } else { 72 print $text; 73 } 74 } 75 76 return ""; 77 } 78 } 79 sub help { # non-standard help, since the file path includes the course name 80 my $self = shift; 81 my $args = shift; 82 my $name = $args->{name}; 83 $name = lc('course home') unless defined($name); 84 $name =~ s/\s/_/g; 85 $self->helpMacro($name); 86 } 87 sub body { 88 my ($self) = @_; 89 my $r = $self->r; 90 my $ce = $r->ce; 91 my $db = $r->db; 92 my $authz = $r->authz; 93 my $urlpath = $r->urlpath; 94 95 my $user = $r->param("user"); 96 my $effectiveUser = $r->param("effectiveUser"); 97 my $sort = $r->param("sort") || "status"; 98 99 my $courseName = $urlpath->arg("courseID"); 100 101 # Print link to instructor page for instructors 102 if ($authz->hasPermissions($user, "access_instructor_tools")) { 103 my $instructorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::Index", courseID => $courseName); 104 my $instructorLink = $self->systemLink($instructorPage); 105 print CGI::p({-align=>'center'},CGI::a({-href=>$instructorLink},'Instructor Tools')); 106 } 107 108 $sort = "status" unless $sort eq "status" or $sort eq "name"; 109 my $nameHeader = $sort eq "name" 110 ? CGI::u("Name") 111 : CGI::a({href=>$self->systemLink($urlpath, params=>{sort=>"name"})}, "Name"); 112 my $statusHeader = $sort eq "status" 113 ? CGI::u("Status") 114 : CGI::a({href=>$self->systemLink($urlpath, params=>{sort=>"status"})}, "Status"); 115 my $hardcopyPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Hardcopy", courseID => $courseName); 116 my $actionURL = $self->systemLink($hardcopyPage, authen => 0); # no authen info for form action 117 118 print CGI::startform(-method=>"POST", -action=>$actionURL); 119 print $self->hidden_authen_fields; 120 print CGI::start_table(); 121 print CGI::Tr( 122 CGI::th("Sel."), 123 CGI::th($nameHeader), 124 CGI::th($statusHeader), 125 ); 126 127 my @setIDs = $db->listUserSets($effectiveUser); 128 129 my @userSetIDs = map {[$effectiveUser, $_]} @setIDs; 130 $WeBWorK::timer->continue("Begin collecting merged sets") if defined($WeBWorK::timer); 131 my @sets = $db->getMergedSets( @userSetIDs ); 132 133 $WeBWorK::timer->continue("Begin fixing merged sets") if defined($WeBWorK::timer); 134 135 # Database fix (in case of undefined published values) 136 # this may take some extra time the first time but should NEVER need to be run twice 137 # this is only necessary because some people keep holding to ww1.9 which did not have a published field 138 foreach my $set (@sets) { 139 # make sure published is set to 0 or 1 140 if ( $set and $set->published ne "0" and $set->published ne "1") { 141 my $globalSet = $db->getGlobalSet($set->set_id); 142 $globalSet->published("1"); # defaults to published 143 $db->putGlobalSet($globalSet); 144 $set = $db->getMergedSet($effectiveUser, $set->set_id); 145 } else { 146 die "set $set not defined" unless $set; 147 } 148 } 149 150 $WeBWorK::timer->continue("Begin sorting merged sets") if defined($WeBWorK::timer); 151 152 @sets = sortByName("set_id", @sets) if $sort eq "name"; 153 @sets = sort byUrgency @sets if $sort eq "status"; 154 155 $WeBWorK::timer->continue("End preparing merged sets") if defined($WeBWorK::timer); 156 157 foreach my $set (@sets) { 158 die "set $set not defined" unless $set; 159 160 if ($set->published || $authz->hasPermissions($user, "view_unpublished_sets")) { 161 print $self->setListRow($set, $authz->hasPermissions($user, "view_multiple_sets"), $authz->hasPermissions($user, "view_unopened_sets")); 162 } 163 } 164 165 print CGI::end_table(); 166 my $pl = ($authz->hasPermissions($user, "view_multiple_sets") ? "s" : ""); 167 print CGI::p(CGI::submit("hardcopy", "Download Hardcopy for Selected Set$pl")); 168 print CGI::endform(); 169 170 # feedback form url 171 my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", courseID => $courseName); 172 my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action 173 174 #print feedback form 175 print 176 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 177 $self->hidden_authen_fields,"\n", 178 CGI::hidden("module", __PACKAGE__),"\n", 179 CGI::hidden("set", ''),"\n", 180 CGI::hidden("problem", ''),"\n", 181 CGI::hidden("displayMode", ''),"\n", 182 CGI::hidden("showOldAnswers", ''),"\n", 183 CGI::hidden("showCorrectAnswers", ''),"\n", 184 CGI::hidden("showHints", ''),"\n", 185 CGI::hidden("showSolutions", ''),"\n", 186 CGI::p({-align=>"left"}, 187 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 188 ), 189 CGI::endform(),"\n"; 190 191 return ""; 192 } 193 194 sub setListRow { 195 my ($self, $set, $multiSet, $preOpenSets) = @_; 196 my $r = $self->r; 197 my $ce = $r->ce; 198 my $urlpath = $r->urlpath; 199 200 my $name = $set->set_id; 201 my $courseName = $urlpath->arg("courseID"); 202 203 my $problemSetPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSet", 204 courseID => $courseName, setID => $name); 205 my $interactiveURL = $self->systemLink($problemSetPage); 206 207 my $openDate = $self->formatDateTime($set->open_date); 208 my $dueDate = $self->formatDateTime($set->due_date); 209 my $answerDate = $self->formatDateTime($set->answer_date); 210 211 my $control = ""; 212 if ($multiSet) { 213 $control = CGI::checkbox( 214 -name=>"hcSet", 215 -value=>$name, 216 -label=>"", 217 ); 218 } else { 219 $control = CGI::radio_group( 220 -name=>"hcSet", 221 -values=>[$name], 222 -default=>"-", 223 -labels=>{$name => ""}, 224 ); 225 } 226 227 $name =~ s/_/ /g; 228 my $interactive = CGI::a({-href=>$interactiveURL}, "$name"); 229 230 my $status; 231 if (time < $set->open_date) { 232 $status = "will open on $openDate"; 233 $control = "" unless $preOpenSets; 234 $interactive = $name unless $preOpenSets; 235 } elsif (time < $set->due_date) { 236 $status = "now open, due $dueDate"; 237 } elsif (time < $set->answer_date) { 238 $status = "closed, answers on $answerDate"; 239 } elsif ($set->answer_date <= time and time < $set->answer_date +RECENT ) { 240 $status = "closed, answers recently available"; 241 } else { 242 $status = "closed, answers available"; 243 } 244 245 my $publishedClass = ($set->published) ? "Published" : "Unpublished"; 246 247 $status = CGI::font({class=>$publishedClass}, $status) if $preOpenSets; 248 249 return CGI::Tr(CGI::td([ 250 $control, 251 $interactive, 252 $status, 253 ])); 254 } 255 256 sub byname { $a->set_id cmp $b->set_id; } 257 258 sub byUrgency { 259 my $mytime = time; 260 my @a_parts = ($a->answer_date + RECENT <= $mytime) ? (4, $a->open_date, $a->due_date, $a->set_id) 261 : ($a->answer_date <= $mytime and $mytime < $a->answer_date + RECENT) ? (3, $a-> answer_date, $a-> due_date, $a->set_id) 262 : ($a->due_date <= $mytime and $mytime < $a->answer_date ) ? (2, $a->answer_date, $a->due_date, $a->set_id) 263 : ($mytime < $a->open_date) ? (1, $a->open_date, $a->due_date, $a->set_id) 264 : (0, $a->due_date, $a->open_date, $a->set_id); 265 my @b_parts = ($b->answer_date + RECENT <= $mytime) ? (4, $b->open_date, $b->due_date, $b->set_id) 266 : ($b->answer_date <= $mytime and $mytime < $b->answer_date + RECENT) ? (3, $b-> answer_date, $b-> due_date, $b->set_id) 267 : ($b->due_date <= $mytime and $mytime < $b->answer_date ) ? (2, $b->answer_date, $b->due_date, $b->set_id) 268 : ($mytime < $b->open_date) ? (1, $b->open_date, $b->due_date, $b->set_id) 269 : (0, $b->due_date, $b->open_date, $b->set_id); 270 my $returnIt=0; 271 while (scalar(@a_parts) > 1) { 272 if ($returnIt = ( (shift @a_parts) <=> (shift @b_parts) ) ) { 273 return($returnIt); 274 } 275 } 276 return ( $a_parts[0] cmp $b_parts[0] ); 277 } 278 279 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |