Parent Directory
| 
Revision Log
Revision 5319 -
(view)
(download)
(as text)
Original Path: trunk/webwork2/lib/WeBWorK/ContentGenerator/Feedback.pm
| 1 : | sh002i | 668 | ################################################################################ |
| 2 : | sh002i | 1663 | # WeBWorK Online Homework Delivery System |
| 3 : | sh002i | 5319 | # 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 : | sh002i | 1663 | # |
| 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 : | sh002i | 668 | ################################################################################ |
| 16 : | |||
| 17 : | package WeBWorK::ContentGenerator::Feedback; | ||
| 18 : | sh002i | 818 | use base qw(WeBWorK::ContentGenerator); |
| 19 : | sh002i | 668 | |
| 20 : | =head1 NAME | ||
| 21 : | |||
| 22 : | WeBWorK::ContentGenerator::Feedback - Send mail to professors. | ||
| 23 : | |||
| 24 : | =cut | ||
| 25 : | |||
| 26 : | sh002i | 818 | # *** feedback should be exempt from authentication, so that people can send |
| 27 : | sh002i | 668 | # feedback from the login page! |
| 28 : | |||
| 29 : | use strict; | ||
| 30 : | use warnings; | ||
| 31 : | use Data::Dumper; | ||
| 32 : | gage | 4235 | #use CGI qw(-nosticky ); |
| 33 : | use WeBWorK::CGI; | ||
| 34 : | sh002i | 668 | use Mail::Sender; |
| 35 : | sh002i | 4108 | use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info |
| 36 : | sh002i | 668 | use Text::Wrap qw(wrap); |
| 37 : | sh002i | 3639 | use WeBWorK::Utils qw/formatDateTime decodeAnswers/; |
| 38 : | sh002i | 668 | |
| 39 : | sh002i | 4594 | use mod_perl; |
| 40 : | use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ); | ||
| 41 : | |||
| 42 : | sh002i | 668 | # 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 : | sh002i | 1876 | my ($self) = @_; |
| 67 : | my $r = $self->r; | ||
| 68 : | my $ce = $r->ce; | ||
| 69 : | my $db = $r->db; | ||
| 70 : | sh002i | 2724 | my $authz = $r->authz; |
| 71 : | sh002i | 668 | |
| 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 : | gage | 3127 | my $courseID = $r->urlpath->arg("courseID"); |
| 86 : | sh002i | 668 | |
| 87 : | sh002i | 1636 | 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 : | sh002i | 668 | |
| 102 : | sh002i | 1883 | # generate context URLs |
| 103 : | sh002i | 1636 | my $emailableURL; |
| 104 : | my $returnURL; | ||
| 105 : | if ($user) { | ||
| 106 : | sh002i | 1883 | 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 : | sh002i | 4108 | $emailableURL = $self->systemLink($modulePath, |
| 130 : | sh002i | 1883 | authen => 0, |
| 131 : | params => [ "effectiveUser", @args ], | ||
| 132 : | sh002i | 4108 | use_abs_url => 1, |
| 133 : | sh002i | 1883 | ); |
| 134 : | sh002i | 4108 | $returnURL = $self->systemLink($modulePath, |
| 135 : | sh002i | 1883 | authen => 1, |
| 136 : | params => [ @args ], | ||
| 137 : | ); | ||
| 138 : | sh002i | 1636 | } else { |
| 139 : | sh002i | 1883 | $emailableURL = "(not available)"; |
| 140 : | sh002i | 1636 | $returnURL = ""; |
| 141 : | } | ||
| 142 : | sh002i | 4108 | my $homeModulePath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::Home"); |
| 143 : | my $systemURL = $self->systemLink($homeModulePath, authen=>0, use_abs_url=>1); | ||
| 144 : | sh002i | 1636 | |
| 145 : | sh002i | 2849 | unless ($authz->hasPermissions($userName, "submit_feedback")) { |
| 146 : | $self->feedbackNotAllowed($returnURL); | ||
| 147 : | return ""; | ||
| 148 : | } | ||
| 149 : | |||
| 150 : | sh002i | 3623 | # determine the recipients of the email |
| 151 : | my @recipients = $self->getFeedbackRecipients(); | ||
| 152 : | |||
| 153 : | unless (@recipients) { | ||
| 154 : | $self->noRecipientsAvailable($returnURL); | ||
| 155 : | return ""; | ||
| 156 : | } | ||
| 157 : | |||
| 158 : | sh002i | 668 | if (defined $r->param("sendFeedback")) { |
| 159 : | sh002i | 740 | # get verbosity level |
| 160 : | my $verbosity = $ce->{mail}->{feedbackVerbosity}; | ||
| 161 : | |||
| 162 : | sh002i | 668 | # determine the sender of the email |
| 163 : | sh002i | 3698 | 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 : | sh002i | 668 | |
| 178 : | sh002i | 740 | # sanity checks |
| 179 : | sh002i | 668 | unless ($sender) { |
| 180 : | malsyned | 830 | $self->feedbackForm($user, $returnURL, |
| 181 : | sh002i | 668 | "No Sender specified."); |
| 182 : | return ""; | ||
| 183 : | } | ||
| 184 : | gage | 1501 | unless ($feedback) { |
| 185 : | $self->feedbackForm($user, $returnURL, | ||
| 186 : | "Message was blank."); | ||
| 187 : | return ""; | ||
| 188 : | } | ||
| 189 : | sh002i | 668 | |
| 190 : | sh002i | 3645 | 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 : | sh002i | 4594 | # 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 : | sh002i | 3646 | $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 : | sh002i | 668 | # bring up a mailer |
| 228 : | my $mailer = Mail::Sender->new({ | ||
| 229 : | sh002i | 4778 | from => $ce->{mail}{smtpSender}, |
| 230 : | fake_from => $sender, | ||
| 231 : | sh002i | 668 | to => join(",", @recipients), |
| 232 : | smtp => $ce->{mail}->{smtpServer}, | ||
| 233 : | sh002i | 3645 | subject => $subject, |
| 234 : | sh002i | 3646 | headers => $headers, |
| 235 : | sh002i | 668 | }); |
| 236 : | unless (ref $mailer) { | ||
| 237 : | malsyned | 830 | $self->feedbackForm($user, $returnURL, |
| 238 : | sh002i | 668 | "Failed to create a mailer: $Mail::Sender::Error"); |
| 239 : | return ""; | ||
| 240 : | } | ||
| 241 : | unless (ref $mailer->Open()) { | ||
| 242 : | malsyned | 830 | $self->feedbackForm($user, $returnURL, |
| 243 : | sh002i | 668 | "Failed to open the mailer: $Mail::Sender::Error"); |
| 244 : | return ""; | ||
| 245 : | } | ||
| 246 : | my $MAIL = $mailer->GetHandle(); | ||
| 247 : | |||
| 248 : | sh002i | 740 | # print message |
| 249 : | sh002i | 668 | print $MAIL |
| 250 : | sh002i | 4108 | wrap("", "", "This feedback message was automatically generated by the WeBWorK", |
| 251 : | sh002i | 4594 | "system at $systemURL, in response to a request from $remote_host:$remote_port." |
| 252 : | sh002i | 4108 | ), "\n\n"; |
| 253 : | sh002i | 668 | |
| 254 : | sh002i | 3648 | print $MAIL "Click this link to see the page from which the user sent feedback:\n", |
| 255 : | "$emailableURL\n\n"; | ||
| 256 : | |||
| 257 : | sh002i | 668 | if ($feedback) { |
| 258 : | print $MAIL | ||
| 259 : | "***** The feedback message: *****\n\n", | ||
| 260 : | wrap("", "", $feedback), "\n\n"; | ||
| 261 : | } | ||
| 262 : | sh002i | 740 | if ($problem and $verbosity >= 1) { |
| 263 : | sh002i | 668 | print $MAIL |
| 264 : | "***** Data about the problem processor: *****\n\n", | ||
| 265 : | |||
| 266 : | "Display Mode: $displayMode\n", | ||
| 267 : | sh002i | 3639 | "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 : | sh002i | 668 | } |
| 272 : | sh002i | 740 | if ($user and $verbosity >= 1) { |
| 273 : | sh002i | 668 | print $MAIL |
| 274 : | "***** Data about the user: *****\n\n", | ||
| 275 : | sh002i | 3639 | #$user->toString(), "\n\n"; |
| 276 : | $self->format_user($user), "\n"; | ||
| 277 : | sh002i | 668 | } |
| 278 : | sh002i | 740 | if ($problem and $verbosity >= 1) { |
| 279 : | sh002i | 668 | print $MAIL |
| 280 : | "***** Data about the problem: *****\n\n", | ||
| 281 : | sh002i | 3639 | #$problem->toString(), "\n\n"; |
| 282 : | $self->format_userproblem($problem), "\n"; | ||
| 283 : | sh002i | 668 | } |
| 284 : | sh002i | 740 | if ($set and $verbosity >= 1) { |
| 285 : | sh002i | 668 | print $MAIL |
| 286 : | sh002i | 3357 | "***** Data about the homework set: *****\n\n", |
| 287 : | sh002i | 3639 | #$set->toString(), "\n\n"; |
| 288 : | $self->format_userset($set), "\n"; | ||
| 289 : | sh002i | 668 | } |
| 290 : | sh002i | 740 | if ($ce and $verbosity >= 2) { |
| 291 : | sh002i | 668 | print $MAIL |
| 292 : | "***** Data about the environment: *****\n\n", | ||
| 293 : | Dumper($ce), "\n\n"; | ||
| 294 : | } | ||
| 295 : | |||
| 296 : | sh002i | 3639 | # 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 : | sh002i | 668 | |
| 300 : | sh002i | 3639 | 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 : | sh002i | 668 | } else { |
| 310 : | # just print the feedback form, with no message | ||
| 311 : | sh002i | 1876 | $self->feedbackForm($user, $returnURL, ""); |
| 312 : | sh002i | 668 | } |
| 313 : | |||
| 314 : | return ""; | ||
| 315 : | } | ||
| 316 : | |||
| 317 : | sh002i | 2849 | 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 : | sh002i | 3623 | 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 : | sh002i | 1876 | sub feedbackForm { |
| 332 : | my ($self, $user, $returnURL, $message) = @_; | ||
| 333 : | my $r = $self->r; | ||
| 334 : | sh002i | 668 | |
| 335 : | print CGI::start_form(-method=>"POST", -action=>$r->uri); | ||
| 336 : | print $self->hidden_authen_fields; | ||
| 337 : | sh002i | 1883 | print $self->hidden_fields(qw( |
| 338 : | module set problem displayMode showOldAnswers showCorrectAnswers | ||
| 339 : | showHints showSolutions | ||
| 340 : | )); | ||
| 341 : | sh002i | 668 | print CGI::p(CGI::b("From:"), " ", |
| 342 : | sh002i | 675 | ($user && $user->email_address |
| 343 : | sh002i | 668 | ? 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 : | gage | 1470 | CGI::textarea("feedback", "", 20, 80), |
| 355 : | sh002i | 668 | ); |
| 356 : | print CGI::submit("sendFeedback", "Send Feedback"); | ||
| 357 : | print CGI::end_form(); | ||
| 358 : | sh002i | 2849 | print CGI::p(CGI::a({-href=>$returnURL}, "Cancel Feedback")) if $returnURL; |
| 359 : | sh002i | 668 | } |
| 360 : | |||
| 361 : | sh002i | 3623 | 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 : | sh002i | 3627 | |
| 369 : | # send to all users with permission to receive_feedback and an email address | ||
| 370 : | sh002i | 4518 | # DBFIXME iterator? |
| 371 : | sh002i | 3627 | 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 : | sh002i | 3698 | push @recipients, $rcpt->rfc822_mailbox; |
| 376 : | sh002i | 3623 | } |
| 377 : | } | ||
| 378 : | } | ||
| 379 : | |||
| 380 : | sh002i | 3627 | if (defined $ce->{mail}->{feedbackRecipients}) { |
| 381 : | push @recipients, @{$ce->{mail}->{feedbackRecipients}}; | ||
| 382 : | } | ||
| 383 : | |||
| 384 : | sh002i | 3623 | return @recipients; |
| 385 : | } | ||
| 386 : | |||
| 387 : | sh002i | 3639 | sub format_user { |
| 388 : | my ($self, $User) = @_; | ||
| 389 : | my $ce = $self->r->ce; | ||
| 390 : | |||
| 391 : | my $result = "User ID: " . $User->user_id . "\n"; | ||
| 392 : | sh002i | 3698 | $result .= "Name: " . $User->full_name . "\n"; |
| 393 : | sh002i | 3639 | $result .= "Email: " . $User->email_address . "\n"; |
| 394 : | $result .= "Student ID: " . $User->student_id . "\n"; | ||
| 395 : | |||
| 396 : | sh002i | 3688 | 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 : | sh002i | 3639 | |
| 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 : | sh002i | 668 | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |