Parent Directory
| 
Revision Log
Normalized headers. All files now contain the text below as a header. This is important since all files now (a) use the full name of the package, (b) assign copyright to "The WeBWorK Project", (c) give the full path of the file (relative to CVSROOT) instead of simply the file name, and (d) include license and warranty information. Here is the new header: ################################################################################ # WeBWorK Online Homework Delivery System # Copyright © 2000-2003 The WeBWorK Projcct, http://openwebwork.sf.net/ # $CVSHeader$ # # This program is free software; you can redistribute it and/or modify it under # the terms of either: (a) the GNU General Public License as published by the # Free Software Foundation; either version 2, or (at your option) any later # version, or (b) the "Artistic License" which comes with this package. # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the # Artistic License for more details. ################################################################################
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader$ 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::Feedback; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Feedback - Send mail to professors. 23 24 =cut 25 26 # *** feedback should be exempt from authentication, so that people can send 27 # feedback from the login page! 28 29 use strict; 30 use warnings; 31 use Data::Dumper; 32 use CGI qw(); 33 use Mail::Sender; 34 use Text::Wrap qw(wrap); 35 36 # request paramaters used 37 # 38 # user 39 # key 40 # module 41 # set (if from ProblemSet or Problem) 42 # problem (if from Problem) 43 # displayMode (if from Problem) 44 # showOldAnswers (if from Problem) 45 # showCorrectAnswers (if from Problem) 46 # showHints (if from Problem) 47 # showSolutions (if from Problem) 48 49 # state data sent 50 # 51 # user object for current user 52 # permission level of current user 53 # current session key 54 # which ContentGenerator module called Feedback? 55 # set object for current set (if from ProblemSet or Problem) 56 # problem object for current problem (if from Problem) 57 # display options (if from Problem) 58 59 sub path { 60 my ($self, $args) = @_; 61 62 my $ce = $self->{ce}; 63 my $root = $ce->{webworkURLs}->{root}; 64 my $courseName = $ce->{courseName}; 65 return $self->pathMacro($args, 66 "Home" => "$root", 67 $courseName => "$root/$courseName", 68 "Feedback" => "", 69 ); 70 } 71 72 sub title { 73 return "Feedback"; 74 } 75 76 sub body { 77 my $self = shift; 78 my $r = $self->{r}; 79 my $ce = $self->{ce}; 80 my $db = $self->{db}; 81 82 # get form fields 83 my $key = $r->param("key"); 84 my $userName = $r->param("user"); 85 my $module = $r->param("module"); 86 my $setName = $r->param("set"); 87 my $problemNumber = $r->param("problem"); 88 my $displayMode = $r->param("displayMode"); 89 my $showOldAnswers = $r->param("showOldAnswers"); 90 my $showCorrectAnswers = $r->param("showCorrectAnswers"); 91 my $showHints = $r->param("showHints"); 92 my $showSolutions = $r->param("showSolutions"); 93 my $from = $r->param("from"); 94 my $feedback = $r->param("feedback"); 95 96 my ($user, $set, $problem); 97 $user = $db->getUser($userName) # checked 98 if defined $userName and $userName ne ""; 99 if (defined $user) { 100 $set = $db->getMergedSet($userName, $setName) # checked 101 if defined $setName and $setName ne ""; 102 $problem = $db->getMergedProblem($userName, $setName, $problemNumber) # checked 103 if defined $set and defined $problemNumber && $problemNumber ne ""; 104 } else { 105 $set = $db->getGlobalSet($setName) # checked 106 if defined $setName and $setName ne ""; 107 $problem = $db->getGlobalProblem($setName, $problemNumber) # checked 108 if defined $set and defined $problemNumber && $problemNumber ne ""; 109 } 110 111 # get some network settings 112 my $hostname = $r->hostname(); 113 my $port = $r->get_server_port(); 114 my $remoteIdent = $r->get_remote_logname() || "UNKNOWN"; 115 my $remoteHost = $r->get_remote_host(); 116 117 # generate context URL 118 my $URL; 119 my $emailableURL; 120 my $returnURL; 121 if ($user) { 122 $URL = "http://$hostname:$port" 123 . $ce->{webworkURLs}->{root} 124 . "/" . $ce->{courseName} 125 . ($set 126 ? "/".$set->set_id . ($problem ? "/".$problem->problem_id : "") 127 : "") 128 . "/?" 129 . ($problem 130 ? "&displayMode=$displayMode" 131 . "&showOldAnswers=$showOldAnswers" 132 . "&showCorrectAnswers=$showCorrectAnswers" 133 . "&showHints=$showHints" 134 . "&showSolutions=$showSolutions" 135 : "" ); 136 $emailableURL = $URL . "&effectiveUser=$userName"; 137 $returnURL = $URL . '&'. $self->url_authen_args; 138 } else { 139 $URL = $emailableURL = "(not available)"; 140 $returnURL = ""; 141 } 142 143 if (defined $r->param("sendFeedback")) { 144 # get verbosity level 145 my $verbosity = $ce->{mail}->{feedbackVerbosity}; 146 147 # determine the sender of the email 148 my $sender = ($user && $user->email_address 149 ? $user->email_address 150 : $from); 151 152 # determine the recipients of the email 153 my @recipients; 154 if (defined $ce->{mail}->{feedbackRecipients}) { 155 @recipients = @{$ce->{mail}->{feedbackRecipients}}; 156 } else { 157 # send to all professors and TAs 158 foreach my $rcptName ($db->listUsers()) { 159 my $rcptPerm = $db->getPermissionLevel($rcptName); # checked 160 next unless $rcptPerm; 161 if ($rcptPerm->permission() == 5 or $rcptPerm->permission() == 10) { 162 my $rcpt = $db->getUser($rcptName); # checked 163 if ($rcpt and $rcpt->email_address) { 164 push @recipients, $rcpt->email_address; 165 } 166 } 167 } 168 } 169 170 # sanity checks 171 unless ($sender) { 172 $self->feedbackForm($user, $returnURL, 173 "No Sender specified."); 174 return ""; 175 } 176 unless (@recipients) { 177 $self->feedbackForm($user, $returnURL, 178 "No recipients specified."); 179 return ""; 180 } 181 unless ($feedback) { 182 $self->feedbackForm($user, $returnURL, 183 "Message was blank."); 184 return ""; 185 } 186 187 # get some network settings 188 my $hostname = $r->hostname(); 189 my $port = $r->get_server_port(); 190 my $remoteIdent = $r->get_remote_logname() || "UNKNOWN"; 191 my $remoteHost = $r->get_remote_host(); 192 193 # generate context URL 194 my $URL; 195 if ($user) { 196 $URL = "http://$hostname:$port" 197 . $ce->{webworkURLs}->{root} 198 . "/" . $ce->{courseName} 199 . ($set 200 ? "/".$set->set_id . ($problem ? "/".$problem->problem_id : "") 201 : "") 202 . "/" . "?effectiveUser=$userName" 203 . ($problem 204 ? "&displayMode=$displayMode" 205 . "&showOldAnswers=$showOldAnswers" 206 . "&showCorrectAnswers=$showCorrectAnswers" 207 . "&showHints=$showHints" 208 . "&showSolutions=$showSolutions" 209 : "" ); 210 } else { 211 $URL = "(not available)"; 212 } 213 214 # bring up a mailer 215 my $mailer = Mail::Sender->new({ 216 from => $sender, 217 to => join(",", @recipients), 218 # *** we might want to have a CE setting for 219 # "additional recipients" 220 smtp => $ce->{mail}->{smtpServer}, 221 subject => "WeBWorK feedback: ".$user->first_name." ".$user->last_name. 222 ( ( defined($setName) && defined($problemNumber) ) ? 223 " set$setName/prob$problemNumber" : "" 224 ), 225 headers => "X-Remote-Host: ".$r->get_remote_host(), 226 }); 227 unless (ref $mailer) { 228 $self->feedbackForm($user, $returnURL, 229 "Failed to create a mailer: $Mail::Sender::Error"); 230 return ""; 231 } 232 unless (ref $mailer->Open()) { 233 $self->feedbackForm($user, $returnURL, 234 "Failed to open the mailer: $Mail::Sender::Error"); 235 return ""; 236 } 237 my $MAIL = $mailer->GetHandle(); 238 239 # print message 240 print $MAIL 241 wrap("", "", "This feedback message was automatically", 242 "generated by the WeBWorK system at", 243 "$hostname:$port, in response to a request from", 244 "$remoteIdent\@$remoteHost."), "\n\n"; 245 print $MAIL "Context: $emailableURL\n\n"; 246 247 if ($feedback) { 248 print $MAIL 249 "***** The feedback message: *****\n\n", 250 wrap("", "", $feedback), "\n\n"; 251 } 252 if ($problem and $verbosity >= 1) { 253 print $MAIL 254 "***** Data about the problem processor: *****\n\n", 255 256 "Display Mode: $displayMode\n", 257 "Show Old Answers? $showOldAnswers\n", 258 "Show Correct Answers? $showCorrectAnswers\n", 259 "Show Hints? $showHints\n", 260 "Show Solutions? $showSolutions\n\n", 261 } 262 if ($user and $verbosity >= 1) { 263 print $MAIL 264 "***** Data about the user: *****\n\n", 265 $user->toString(), "\n\n"; 266 267 } 268 if ($problem and $verbosity >= 1) { 269 print $MAIL 270 "***** Data about the problem: *****\n\n", 271 $problem->toString(), "\n\n"; 272 273 } 274 if ($set and $verbosity >= 1) { 275 print $MAIL 276 "***** Data about the problem set: *****\n\n", 277 $set->toString(), "\n\n"; 278 279 } 280 if ($ce and $verbosity >= 2) { 281 print $MAIL 282 "***** Data about the environment: *****\n\n", 283 Dumper($ce), "\n\n"; 284 285 } 286 287 # end the message 288 close $MAIL; 289 290 # print confirmation 291 print CGI::p("Your message was sent successfully."); 292 print CGI::p(CGI::a({-href => $returnURL}, "Return to your work")); 293 print CGI::p( wrap("", "", $feedback) ); 294 } else { 295 # just print the feedback form, with no message 296 $self->feedbackForm( $user, $returnURL,"",); 297 } 298 299 return ""; 300 } 301 302 sub feedbackForm($;$$$) { 303 my ($self, $user,$returnURL, $message, ) = @_; 304 my $r = $self->{r}; 305 306 print CGI::start_form(-method=>"POST", -action=>$r->uri); 307 print $self->hidden_authen_fields; 308 print $self->hidden_state_fields($r); 309 print CGI::p(CGI::b("From:"), " ", 310 ($user && $user->email_address 311 ? CGI::tt($user->email_address) 312 : CGI::textfield("from", "", 40)) 313 ); 314 print CGI::p("Use this form to report to your professor a 315 problem with the WeBWorK system or an error in a problem 316 you are attempting. Along with your message, additional 317 information about the state of the system will be 318 included."); 319 print CGI::p(CGI::i($message)) if $message; 320 print CGI::p( 321 CGI::b("Feedback:"), CGI::br(), 322 CGI::textarea("feedback", "", 20, 80), 323 ); 324 print CGI::submit("sendFeedback", "Send Feedback"); 325 print CGI::end_form(); 326 print CGI::p(CGI::a({-href=>$returnURL}, "Cancel feedback")); 327 328 } 329 330 sub hidden_state_fields($) { 331 my $self = shift; 332 my $r = $self->{r}; 333 334 print CGI::hidden("$_", $r->param("$_")) 335 foreach (qw(module set problem displayMode showOldAnswers 336 showCorrectAnswers showHints showSolutions)); 337 } 338 339 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |