Parent Directory
| 
Revision Log
updated copyright dates
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Feedback.pm,v 1.43 2007/02/14 18:16:46 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::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(-nosticky ); 33 use WeBWorK::CGI; 34 use Mail::Sender; 35 use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info 36 use Text::Wrap qw(wrap); 37 use WeBWorK::Utils qw/formatDateTime decodeAnswers/; 38 39 use mod_perl; 40 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ); 41 42 # request paramaters used 43 # 44 # user 45 # key 46 # module 47 # set (if from ProblemSet or Problem) 48 # problem (if from Problem) 49 # displayMode (if from Problem) 50 # showOldAnswers (if from Problem) 51 # showCorrectAnswers (if from Problem) 52 # showHints (if from Problem) 53 # showSolutions (if from Problem) 54 55 # state data sent 56 # 57 # user object for current user 58 # permission level of current user 59 # current session key 60 # which ContentGenerator module called Feedback? 61 # set object for current set (if from ProblemSet or Problem) 62 # problem object for current problem (if from Problem) 63 # display options (if from Problem) 64 65 sub body { 66 my ($self) = @_; 67 my $r = $self->r; 68 my $ce = $r->ce; 69 my $db = $r->db; 70 my $authz = $r->authz; 71 72 # get form fields 73 my $key = $r->param("key"); 74 my $userName = $r->param("user"); 75 my $module = $r->param("module"); 76 my $setName = $r->param("set"); 77 my $problemNumber = $r->param("problem"); 78 my $displayMode = $r->param("displayMode"); 79 my $showOldAnswers = $r->param("showOldAnswers"); 80 my $showCorrectAnswers = $r->param("showCorrectAnswers"); 81 my $showHints = $r->param("showHints"); 82 my $showSolutions = $r->param("showSolutions"); 83 my $from = $r->param("from"); 84 my $feedback = $r->param("feedback"); 85 my $courseID = $r->urlpath->arg("courseID"); 86 87 my ($user, $set, $problem); 88 $user = $db->getUser($userName) # checked 89 if defined $userName and $userName ne ""; 90 if (defined $user) { 91 $set = $db->getMergedSet($userName, $setName) # checked 92 if defined $setName and $setName ne ""; 93 $problem = $db->getMergedProblem($userName, $setName, $problemNumber) # checked 94 if defined $set and defined $problemNumber && $problemNumber ne ""; 95 } else { 96 $set = $db->getGlobalSet($setName) # checked 97 if defined $setName and $setName ne ""; 98 $problem = $db->getGlobalProblem($setName, $problemNumber) # checked 99 if defined $set and defined $problemNumber && $problemNumber ne ""; 100 } 101 102 # generate context URLs 103 my $emailableURL; 104 my $returnURL; 105 if ($user) { 106 my $modulePath; 107 my @args; 108 if ($set) { 109 if ($problem) { 110 $modulePath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", 111 courseID => $r->urlpath->arg("courseID"), 112 setID => $set->set_id, 113 problemID => $problem->problem_id, 114 ); 115 @args = qw/displayMode showOldAnswers showCorrectAnswers showHints showSolutions/; 116 } else { 117 $modulePath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSet", 118 courseID => $r->urlpath->arg("courseID"), 119 setID => $set->set_id, 120 ); 121 @args = (); 122 } 123 } else { 124 $modulePath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", 125 courseID => $r->urlpath->arg("courseID"), 126 ); 127 @args = (); 128 } 129 $emailableURL = $self->systemLink($modulePath, 130 authen => 0, 131 params => [ "effectiveUser", @args ], 132 use_abs_url => 1, 133 ); 134 $returnURL = $self->systemLink($modulePath, 135 authen => 1, 136 params => [ @args ], 137 ); 138 } else { 139 $emailableURL = "(not available)"; 140 $returnURL = ""; 141 } 142 my $homeModulePath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::Home"); 143 my $systemURL = $self->systemLink($homeModulePath, authen=>0, use_abs_url=>1); 144 145 unless ($authz->hasPermissions($userName, "submit_feedback")) { 146 $self->feedbackNotAllowed($returnURL); 147 return ""; 148 } 149 150 # determine the recipients of the email 151 my @recipients = $self->getFeedbackRecipients(); 152 153 unless (@recipients) { 154 $self->noRecipientsAvailable($returnURL); 155 return ""; 156 } 157 158 if (defined $r->param("sendFeedback")) { 159 # get verbosity level 160 my $verbosity = $ce->{mail}->{feedbackVerbosity}; 161 162 # determine the sender of the email 163 my $sender; 164 if ($user) { 165 if ($user->email_address) { 166 $sender = $user->rfc822_mailbox; 167 } else { 168 if ($user->full_name) { 169 $sender = $user->full_name . " <$from>" 170 } else { 171 $sender = $from; 172 } 173 } 174 } else { 175 $sender = $from; 176 } 177 178 # sanity checks 179 unless ($sender) { 180 $self->feedbackForm($user, $returnURL, 181 "No Sender specified."); 182 return ""; 183 } 184 unless ($feedback) { 185 $self->feedbackForm($user, $returnURL, 186 "Message was blank."); 187 return ""; 188 } 189 190 my %subject_map = ( 191 'c' => $courseID, 192 'u' => $user ? $user->user_id : undef, 193 's' => $set ? $set->set_id : undef, 194 'p' => $problem ? $problem->problem_id : undef, 195 'x' => $user ? $user->section : undef, 196 'r' => $user ? $user->recitation : undef, 197 '%' => '%', 198 ); 199 my $chars = join("", keys %subject_map); 200 my $subject = $ce->{mail}{feedbackSubjectFormat} 201 || "WeBWorK feedback from %c: %u set %s/prob %p"; # default if not entered 202 $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ""/eg; 203 204 # get info about remote user (stolen from &WeBWorK::Authen::write_log_entry) 205 my ($remote_host, $remote_port); 206 if (MP2) { 207 $remote_host = $r->connection->remote_addr->ip_get || "UNKNOWN"; 208 $remote_port = $r->connection->remote_addr->port || "UNKNOWN"; 209 } else { 210 ($remote_port, $remote_host) = unpack_sockaddr_in($r->connection->remote_addr); 211 $remote_host = defined $remote_host ? inet_ntoa($remote_host) : "UNKNOWN"; 212 $remote_port = "UNKNOWN" unless defined $remote_port; 213 } 214 #my $user_agent = $r->headers_in("User-Agent"); 215 216 my $headers = "X-Remote-Host: $remote_host\n"; 217 $headers .= "X-WeBWorK-Module: $module\n" if defined $module; 218 $headers .= "X-WeBWorK-Course: $courseID\n" if defined $courseID; 219 if ($user) { 220 $headers .= "X-WeBWorK-User: ".$user->user_id."\n"; 221 $headers .= "X-WeBWorK-Section: ".$user->section."\n"; 222 $headers .= "X-WeBWorK-Recitation: ".$user->recitation."\n"; 223 } 224 $headers .= "X-WeBWorK-Set: ".$set->set_id."\n" if $set; 225 $headers .= "X-WeBWorK-Problem: ".$problem->problem_id."\n" if $problem; 226 227 # bring up a mailer 228 my $mailer = Mail::Sender->new({ 229 from => $ce->{mail}{smtpSender}, 230 fake_from => $sender, 231 to => join(",", @recipients), 232 smtp => $ce->{mail}->{smtpServer}, 233 subject => $subject, 234 headers => $headers, 235 }); 236 unless (ref $mailer) { 237 $self->feedbackForm($user, $returnURL, 238 "Failed to create a mailer: $Mail::Sender::Error"); 239 return ""; 240 } 241 unless (ref $mailer->Open()) { 242 $self->feedbackForm($user, $returnURL, 243 "Failed to open the mailer: $Mail::Sender::Error"); 244 return ""; 245 } 246 my $MAIL = $mailer->GetHandle(); 247 248 # print message 249 print $MAIL 250 wrap("", "", "This feedback message was automatically generated by the WeBWorK", 251 "system at $systemURL, in response to a request from $remote_host:$remote_port." 252 ), "\n\n"; 253 254 print $MAIL "Click this link to see the page from which the user sent feedback:\n", 255 "$emailableURL\n\n"; 256 257 if ($feedback) { 258 print $MAIL 259 "***** The feedback message: *****\n\n", 260 wrap("", "", $feedback), "\n\n"; 261 } 262 if ($problem and $verbosity >= 1) { 263 print $MAIL 264 "***** Data about the problem processor: *****\n\n", 265 266 "Display Mode: $displayMode\n", 267 "Show Old Answers: " . ($showOldAnswers ? "yes" : "no") . "\n", 268 "Show Correct Answers: " . ($showCorrectAnswers ? "yes" : "no") . "\n", 269 "Show Hints: " . ($showHints ? "yes" : "no") . "\n", 270 "Show Solutions: " . ($showSolutions ? "yes" : "no") . "\n\n", 271 } 272 if ($user and $verbosity >= 1) { 273 print $MAIL 274 "***** Data about the user: *****\n\n", 275 #$user->toString(), "\n\n"; 276 $self->format_user($user), "\n"; 277 } 278 if ($problem and $verbosity >= 1) { 279 print $MAIL 280 "***** Data about the problem: *****\n\n", 281 #$problem->toString(), "\n\n"; 282 $self->format_userproblem($problem), "\n"; 283 } 284 if ($set and $verbosity >= 1) { 285 print $MAIL 286 "***** Data about the homework set: *****\n\n", 287 #$set->toString(), "\n\n"; 288 $self->format_userset($set), "\n"; 289 } 290 if ($ce and $verbosity >= 2) { 291 print $MAIL 292 "***** Data about the environment: *****\n\n", 293 Dumper($ce), "\n\n"; 294 } 295 296 # Close returns the mailer object on success, a negative value on failure, 297 # zero if mailer was not opened. 298 my $result = $mailer->Close; 299 300 if (ref $result) { 301 # print confirmation 302 print CGI::p("Your message was sent successfully."); 303 print CGI::p(CGI::a({-href => $returnURL}, "Return to your work")); 304 print CGI::pre(wrap("", "", $feedback)); 305 } else { 306 $self->feedbackForm($user, $returnURL, 307 "Failed to send message ($result): $Mail::Sender::Error"); 308 } 309 } else { 310 # just print the feedback form, with no message 311 $self->feedbackForm($user, $returnURL, ""); 312 } 313 314 return ""; 315 } 316 317 sub feedbackNotAllowed { 318 my ($self, $returnURL) = @_; 319 320 print CGI::p("You are not allowed to send feedback."); 321 print CGI::p(CGI::a({-href=>$returnURL}, "Cancel Feedback")) if $returnURL; 322 } 323 324 sub noRecipientsAvailable { 325 my ($self, $returnURL) = @_; 326 327 print CGI::p("No feedback recipients are listed for this course."); 328 print CGI::p(CGI::a({-href=>$returnURL}, "Cancel Feedback")) if $returnURL; 329 } 330 331 sub feedbackForm { 332 my ($self, $user, $returnURL, $message) = @_; 333 my $r = $self->r; 334 335 print CGI::start_form(-method=>"POST", -action=>$r->uri); 336 print $self->hidden_authen_fields; 337 print $self->hidden_fields(qw( 338 module set problem displayMode showOldAnswers showCorrectAnswers 339 showHints showSolutions 340 )); 341 print CGI::p(CGI::b("From:"), " ", 342 ($user && $user->email_address 343 ? CGI::tt($user->email_address) 344 : CGI::textfield("from", "", 40)) 345 ); 346 print CGI::p("Use this form to report to your professor a 347 problem with the WeBWorK system or an error in a problem 348 you are attempting. Along with your message, additional 349 information about the state of the system will be 350 included."); 351 print CGI::p(CGI::i($message)) if $message; 352 print CGI::p( 353 CGI::b("Feedback:"), CGI::br(), 354 CGI::textarea("feedback", "", 20, 80), 355 ); 356 print CGI::submit("sendFeedback", "Send Feedback"); 357 print CGI::end_form(); 358 print CGI::p(CGI::a({-href=>$returnURL}, "Cancel Feedback")) if $returnURL; 359 } 360 361 sub getFeedbackRecipients { 362 my ($self) = @_; 363 my $ce = $self->r->ce; 364 my $db = $self->r->db; 365 my $authz = $self->r->authz; 366 367 my @recipients; 368 369 # send to all users with permission to receive_feedback and an email address 370 # DBFIXME iterator? 371 foreach my $rcptName ($db->listUsers()) { 372 if ($authz->hasPermissions($rcptName, "receive_feedback")) { 373 my $rcpt = $db->getUser($rcptName); # checked 374 if ($rcpt and $rcpt->email_address) { 375 push @recipients, $rcpt->rfc822_mailbox; 376 } 377 } 378 } 379 380 if (defined $ce->{mail}->{feedbackRecipients}) { 381 push @recipients, @{$ce->{mail}->{feedbackRecipients}}; 382 } 383 384 return @recipients; 385 } 386 387 sub format_user { 388 my ($self, $User) = @_; 389 my $ce = $self->r->ce; 390 391 my $result = "User ID: " . $User->user_id . "\n"; 392 $result .= "Name: " . $User->full_name . "\n"; 393 $result .= "Email: " . $User->email_address . "\n"; 394 $result .= "Student ID: " . $User->student_id . "\n"; 395 396 my $status_name = $ce->status_abbrev_to_name($User->status); 397 my $status_string = defined $status_name 398 ? "$status_name ('" . $User->status . "')" 399 : $User->status . " (unknown status abbreviation)"; 400 $result .= "Status: $status_string\n"; 401 402 $result .= "Section: " . $User->section . "\n"; 403 $result .= "Recitation: " . $User->recitation . "\n"; 404 $result .= "Comment: " . $User->comment . "\n"; 405 406 return $result; 407 } 408 409 sub format_userset { 410 my ($self, $Set) = @_; 411 my $ce = $self->r->ce; 412 413 my $result = "Set ID: " . $Set->set_id . "\n"; 414 $result .= "Set header file: " . $Set->set_header . "\n"; 415 $result .= "Hardcopy header file: " . $Set->hardcopy_header . "\n"; 416 417 my $tz = $ce->{siteDefaults}{timezone}; 418 $result .= "Open date: " . formatDateTime($Set->open_date, $tz) . "\n"; 419 $result .= "Due date: " . formatDateTime($Set->due_date, $tz) . "\n"; 420 $result .= "Answer date: " . formatDateTime($Set->answer_date, $tz) . "\n"; 421 $result .= "Published: " . ($Set->published ? "yes" : "no") . "\n"; 422 $result .= "Assignment type: " . $Set->assignment_type . "\n"; 423 if ($Set->assignment_type =~ /gateway/) { 424 $result .= "Attempts per version: " . $Set->assignment_type . "\n"; 425 $result .= "Time interval: " . $Set->time_interval . "\n"; 426 $result .= "Versions per interval: " . $Set->versions_per_interval . "\n"; 427 $result .= "Version time limit: " . $Set->version_time_limit . "\n"; 428 $result .= "Version creation time: " . formatDateTime($Set->version_creation_time, $tz) . "\n"; 429 $result .= "Problem randorder: " . $Set->problem_randorder . "\n"; 430 $result .= "Version last attempt time: " . $Set->version_last_attempt_time . "\n"; 431 } 432 433 return $result; 434 } 435 436 sub format_userproblem { 437 my ($self, $Problem) = @_; 438 my $ce = $self->r->ce; 439 440 my $result = "Problem ID: " . $Problem->problem_id . "\n"; 441 $result .= "Source file: " . $Problem->source_file . "\n"; 442 $result .= "Value: " . $Problem->value . "\n"; 443 $result .= "Max attempts " . ($Problem->max_attempts == -1 ? "unlimited" : $Problem->max_attempts) . "\n"; 444 $result .= "Random seed: " . $Problem->problem_seed . "\n"; 445 $result .= "Status: " . $Problem->status . "\n"; 446 $result .= "Attempted: " . ($Problem->attempted ? "yes" : "no") . "\n"; 447 448 my %last_answer = decodeAnswers($Problem->last_answer); 449 if (%last_answer) { 450 $result .= "Last answer:\n"; 451 foreach my $key (sort keys %last_answer) { 452 $result .= "\t$key: $last_answer{$key}\n"; 453 } 454 } else { 455 $result .= "Last answer: none\n"; 456 } 457 458 $result .= "Number of correct attempts: " . $Problem->num_correct . "\n"; 459 $result .= "Number of incorrect attempts: " . $Problem->num_incorrect . "\n"; 460 461 return $result; 462 } 463 464 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |