[system] / branches / rel-2-1-patches / webwork-modperl / lib / WeBWorK / ContentGenerator.pm Repository:
ViewVC logotype

Annotation of /branches/rel-2-1-patches/webwork-modperl/lib/WeBWorK/ContentGenerator.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2222 - (view) (download) (as text)
Original Path: trunk/webwork-modperl/lib/WeBWorK/ContentGenerator.pm

1 : sh002i 455 ################################################################################
2 : sh002i 1663 # WeBWorK Online Homework Delivery System
3 :     # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4 : jj 2222 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.101 2004/05/22 21:24:42 apizer 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 455 ################################################################################
16 :    
17 : malsyned 313 package WeBWorK::ContentGenerator;
18 : malsyned 305
19 : sh002i 455 =head1 NAME
20 :    
21 :     WeBWorK::ContentGenerator - base class for modules that generate page content.
22 :    
23 : sh002i 1861 =head1 SYNOPSIS
24 :    
25 :     # start with a WeBWorK::Request object: $r
26 :    
27 :     use WeBWorK::ContentGenerator::SomeSubclass;
28 :    
29 :     my $cg = WeBWorK::ContentGenerator::SomeSubclass->new($r);
30 :     my $result = $cg->go();
31 :    
32 :     =head1 DESCRIPTION
33 :    
34 : sh002i 1873 WeBWorK::ContentGenerator provides the framework for generating page content.
35 :     "Content generators" are subclasses of this class which provide content for
36 :     particular parts of the system.
37 : sh002i 1861
38 : sh002i 1873 Default versions of methods used by the templating system are provided. Several
39 :     useful methods are provided for rendering common output idioms and some
40 :     miscellaneous utilities are provided.
41 :    
42 : sh002i 455 =cut
43 :    
44 : malsyned 441 use strict;
45 :     use warnings;
46 : sh002i 1911 use Apache::Constants qw(:response);
47 : sh002i 1882 use Carp;
48 : sh002i 1880 use CGI::Pretty qw(*ul *li);
49 : sh002i 469 use URI::Escape;
50 : sh002i 1869 use WeBWorK::Template qw(template);
51 : malsyned 390
52 : sh002i 1873 ################################################################################
53 : malsyned 390
54 : sh002i 1861 =head1 CONSTRUCTOR
55 : sh002i 1838
56 : sh002i 1861 =over
57 :    
58 :     =item new($r)
59 :    
60 : sh002i 1873 Creates a new instance of a content generator. Supply a WeBWorK::Request object
61 : sh002i 1861 $r.
62 :    
63 :     =cut
64 :    
65 : sh002i 1613 sub new {
66 : sh002i 1838 my ($invocant, $r) = @_;
67 : malsyned 323 my $class = ref($invocant) || $invocant;
68 : sh002i 809 my $self = {
69 : sh002i 1838 r => $r, # this is now a WeBWorK::Request
70 :     ce => $r->ce(), # these three are here for
71 :     db => $r->db(), # backward-compatability
72 :     authz => $r->authz(), # with unconverted CGs
73 : sh002i 1869 noContent => undef, # this should get clobbered at some point
74 : sh002i 809 };
75 : malsyned 305 bless $self, $class;
76 :     return $self;
77 :     }
78 :    
79 : sh002i 1861 =back
80 :    
81 :     =cut
82 :    
83 : sh002i 469 ################################################################################
84 : malsyned 323
85 : sh002i 1861 =head1 INVOCATION
86 :    
87 :     =over
88 :    
89 :     =item go()
90 :    
91 : sh002i 1873 Generates a page, using methods from the particular subclass of ContentGenerator
92 :     that is instantiated. Generatoion is broken up into several steps, to give
93 :     subclasses ample control over the process.
94 : sh002i 1861
95 :     =over
96 :    
97 : sh002i 1873 =item 1
98 : sh002i 1861
99 : sh002i 1873 go() will attempt to call the method pre_header_initialize(). This method may be
100 :     implemented in subclasses which must do processing before the HTTP header is
101 :     emitted.
102 : sh002i 1861
103 : sh002i 1873 =item 2
104 : sh002i 1861
105 : sh002i 1873 go() will attempt to call the method header(). This method emits the HTTP
106 :     header. It is defined in this class (see below), but may be overridden in
107 :     subclasses which need to send different header information. For some reason, the
108 :     return value of header() will be used as the result of this function, if it is
109 :     defined.
110 : sh002i 1861
111 : sh002i 1911 FIXME: figure out what the deal is with the return value of header(). If we sent
112 :     a header, it's too late to set the status by returning. If we didn't, header()
113 :     didn't perform its function!
114 :    
115 : sh002i 1873 =item 3
116 : sh002i 1861
117 : sh002i 1873 At this point, go() will terminate if the request is a HEAD request or if the
118 :     field $self->{noContent} contains a true value.
119 : sh002i 1861
120 : sh002i 1911 FIXME: I don't think we'll need noContent after reply_with_redirect() is
121 :     adopted by all modules.
122 :    
123 : sh002i 1873 =item 4
124 : sh002i 1861
125 : sh002i 1873 go() then attempts to call the method initialize(). This method may be
126 :     implemented in subclasses which must do processing after the HTTP header is sent
127 :     but before any content is sent.
128 : sh002i 1861
129 : sh002i 1873 =item 6
130 :    
131 :     The method content() is called to send the page content to client.
132 :    
133 : sh002i 1861 =back
134 :    
135 :     =cut
136 :    
137 : sh002i 469 sub go {
138 : sh002i 1873 my ($self) = @_;
139 :     my $r = $self->r;
140 : sh002i 1869 my $ce = $r->ce;
141 :    
142 : malsyned 1408 my $returnValue = OK;
143 : sh002i 1131
144 : sh002i 469 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize");
145 : sh002i 1873
146 : sh002i 1911 # send a file instead of a normal reply (reply_with_file() sets this field)
147 :     defined $self->{reply_with_file} and do {
148 :     return $self->do_reply_with_file($self->{reply_with_file});
149 :     };
150 :    
151 :     # send a Location: header instead of a normal reply (reply_with_redirect() sets this field)
152 :     defined $self->{reply_with_redirect} and do {
153 :     return $self->do_reply_with_redirect($self->{reply_with_redirect});
154 :     };
155 :    
156 : malsyned 1408 my $headerReturn = $self->header(@_);
157 :     $returnValue = $headerReturn if defined $headerReturn;
158 : sh002i 1911 # FIXME: we won't need noContent after reply_with_redirect() is adopted
159 : malsyned 1408 return $returnValue if $r->header_only or $self->{noContent};
160 : malsyned 313
161 : sh002i 1873 $self->initialize() if $self->can("initialize");
162 : sh002i 1225
163 : sh002i 1873 $self->content();
164 : malsyned 1408
165 :     return $returnValue;
166 : sh002i 469 }
167 :    
168 : sh002i 1873 =item r()
169 : sh002i 1861
170 : sh002i 1873 Returns a reference to the WeBWorK::Request object associated with this
171 :     instance.
172 : sh002i 1861
173 :     =cut
174 :    
175 : sh002i 1873 sub r {
176 :     my ($self) = @_;
177 : sh002i 1869
178 : sh002i 1873 return $self->{r};
179 : sh002i 469 }
180 :    
181 : sh002i 1911 =item do_reply_with_file($fileHash)
182 :    
183 :     Handler for reply_with_file(), used by go(). DO NOT CALL THIS METHOD DIRECTLY.
184 :    
185 :     =cut
186 :    
187 :     sub do_reply_with_file {
188 :     my ($self, $fileHash) = @_;
189 :     my $r = $self->r;
190 :    
191 : sh002i 1984 my $type = $fileHash->{type};
192 : sh002i 1911 my $source = $fileHash->{source};
193 : sh002i 1984 my $name = $fileHash->{name};
194 :     my $delete_after = $fileHash->{delete_after};
195 : sh002i 1911
196 :     # if there was a problem, we return here and let go() worry about sending the reply
197 :     return NOT_FOUND unless -e $source;
198 :     return FORBIDDEN unless -r $source;
199 :    
200 :     # open the file now, so we can send the proper error status is we fail
201 :     open my $fh, "<", $source or return SERVER_ERROR;
202 :    
203 :     # send our custom HTTP header
204 :     $r->status(OK);
205 :     $r->content_type($type);
206 :     $r->header_out("Content-Disposition" => "attachment; filename=\"$name\"");
207 :     $r->send_http_header;
208 :    
209 :     # send the file
210 :     $r->send_fd($fh);
211 :    
212 :     # close the file and go home
213 :     close $fh;
214 : sh002i 1984
215 :     if ($delete_after) {
216 :     unlink $source or warn "failed to unlink $source after sending: $!";
217 :     }
218 : sh002i 1911 }
219 :    
220 : sh002i 2030 =item do_reply_with_redirect($url)
221 :    
222 :     Handler for reply_with_redirect(), used by go(). DO NOT CALL THIS METHOD DIRECTLY.
223 :    
224 :     =cut
225 :    
226 :     sub do_reply_with_redirect {
227 :     my ($self, $url) = @_;
228 :     my $r = $self->r;
229 :    
230 :     $r->status(REDIRECT);
231 :     $r->header_out(Location => $url);
232 :     $r->send_http_header();
233 :     }
234 :    
235 :     =back
236 :    
237 :     =cut
238 :    
239 :     ################################################################################
240 :    
241 :     =head1 DATA MODIFIERS
242 :    
243 :     Modifiers allow the caller to register a piece of data for later retrieval in a
244 :     standard way.
245 :    
246 :     =over
247 :    
248 :     =item reply_with_file($type, $source, $name, $delete_after)
249 :    
250 :     Enables file sending mode, causing go() to send the file specified by $source to
251 :     the client after calling pre_header_initialize(). The content type sent is
252 :     $type, and the suggested client-side file name is $name. If $delete_after is
253 :     true, $source is deleted after it is sent.
254 :    
255 :     Must be called before the HTTP header is sent. Usually called from
256 :     pre_header_initialize().
257 :    
258 :     =cut
259 :    
260 :     sub reply_with_file {
261 :     my ($self, $type, $source, $name, $delete_after) = @_;
262 :     $delete_after ||= "";
263 :    
264 :     $self->{reply_with_file} = {
265 :     type => $type,
266 :     source => $source,
267 :     name => $name,
268 :     delete_after => $delete_after,
269 :     };
270 :     }
271 :    
272 : sh002i 1911 =item reply_with_redirect($url)
273 :    
274 :     Enables redirect mode, causing go() to redirect to the given URL after calling
275 :     pre_header_initialize().
276 :    
277 : sh002i 2030 Must be called before the HTTP header is sent. Usually called from
278 :     pre_header_initialize().
279 :    
280 : sh002i 1911 =cut
281 :    
282 :     sub reply_with_redirect {
283 :     my ($self, $url) = @_;
284 :    
285 :     $self->{reply_with_redirect} = $url;
286 :     }
287 :    
288 : sh002i 2030 =item addmessage($message)
289 : sh002i 1911
290 : sh002i 2030 Adds a message to the list of messages to be printed by the message() template
291 :     escape handler.
292 : sh002i 1911
293 : sh002i 2030 Must be called before the message() template escape is invoked.
294 :    
295 : sh002i 1911 =cut
296 :    
297 : sh002i 2030 # FIXME: we should probably
298 :    
299 :     sub addmessage {
300 :     my ($self, $message) = @_;
301 : sh002i 2034 $self->{status_message} .= $message;
302 : sh002i 1911 }
303 :    
304 : jj 2140 =item addgoodmessage($message)
305 :    
306 :     Adds a success message to the list of messages to be printed by the
307 :     message() template escape handler.
308 :    
309 :     =cut
310 :    
311 :    
312 :     sub addgoodmessage {
313 :     my ($self, $message) = @_;
314 :     $self->addmessage(CGI::div({class=>"ResultsWithoutError"}, $message));
315 :     }
316 :    
317 : jj 2152 =item addbadmessage($message)
318 :    
319 :     Adds a failure message to the list of messages to be printed by the
320 :     message() template escape handler.
321 :    
322 :     =cut
323 :    
324 :    
325 :     sub addbadmessage {
326 :     my ($self, $message) = @_;
327 :     $self->addmessage(CGI::div({class=>"ResultsWithError"}, $message));
328 :     }
329 :    
330 : sh002i 1873 =back
331 : sh002i 1861
332 :     =cut
333 :    
334 : sh002i 1873 ################################################################################
335 : sh002i 469
336 : sh002i 1873 =head1 STANDARD METHODS
337 : sh002i 1861
338 : sh002i 1873 The following are the standard content generator methods. Some are defined here,
339 :     but may be overridden in a subclass. Others are not defined unless they are
340 :     defined in a subclass.
341 : sh002i 1861
342 : sh002i 1873 =over
343 : sh002i 469
344 : sh002i 1873 =item pre_header_initialize()
345 : sh002i 1861
346 : sh002i 1873 Not defined in this package.
347 : sh002i 1861
348 : sh002i 1873 May be defined by a subclass to perform any processing that must occur before
349 :     the HTTP header is sent.
350 :    
351 : sh002i 1861 =cut
352 :    
353 : sh002i 1873 #sub pre_header_initialize { }
354 : malsyned 323
355 : sh002i 1873 =item header()
356 : sh002i 1861
357 : sh002i 1873 Defined in this package.
358 : sh002i 1861
359 : sh002i 2030 Generates and sends a default HTTP header, specifying the "text/html" content
360 :     type.
361 : sh002i 1861
362 :     =cut
363 :    
364 : sh002i 1873 sub header {
365 : sh002i 425 my $self = shift;
366 : sh002i 1873 my $r = $self->r;
367 : sh002i 425
368 : sh002i 2030 $r->content_type("text/html");
369 : sh002i 1873 $r->send_http_header();
370 :     return OK;
371 : sh002i 425 }
372 :    
373 : sh002i 1873 =item initialize()
374 : sh002i 1861
375 : sh002i 1873 Not defined in this package.
376 : sh002i 1861
377 : sh002i 1873 May be defined by a subclass to perform any processing that must occur after the
378 :     HTTP header is sent but before any content is sent.
379 : sh002i 1861
380 :     =cut
381 :    
382 : sh002i 1873 #sub initialize { }
383 : sh002i 1861
384 : sh002i 1873 =item content()
385 : sh002i 1861
386 : sh002i 1873 Defined in this package.
387 : sh002i 1861
388 : sh002i 1873 Print the content of the generated page.
389 : sh002i 1861
390 : sh002i 1873 The implementation in this package uses WeBWorK::Template to define the content
391 :     of the page. See WeBWorK::Template for details.
392 : malsyned 390
393 : sh002i 1873 If a method named templateName() exists, it it called to determine the name of
394 :     the template to use. If not, the default template, "system", is used. The
395 :     location of the template is looked up in the course environment.
396 : sh002i 1861
397 :     =cut
398 :    
399 : sh002i 1873 sub content {
400 :     my ($self) = @_;
401 :     my $ce = $self->r->ce;
402 : sh002i 737
403 : sh002i 1873 # if the content generator specifies a custom template name, use that
404 :     # field in the $ce->{templates} hash instead of "system" if it exists.
405 :     my $templateName;
406 :     if ($self->can("templateName")) {
407 :     $templateName = $self->templateName;
408 :     } else {
409 :     $templateName = "system";
410 :     }
411 :     $templateName = "system" unless exists $ce->{templates}->{$templateName};
412 :     template($ce->{templates}->{$templateName}, $self);
413 : sh002i 737 }
414 :    
415 : sh002i 1861 =back
416 :    
417 :     =cut
418 :    
419 : sh002i 1873 # ------------------------------------------------------------------------------
420 : sh002i 1866
421 : sh002i 1873 =head2 Template escape handlers
422 : sh002i 1866
423 : sh002i 1873 Template escape handlers are invoked when the template processor encounters a
424 :     matching escape sequence in the template. The escapse sequence's arguments are
425 :     passed to the methods as a reference to a hash.
426 : sh002i 1866
427 : sh002i 1873 For more information, refer to WeBWorK::Template.
428 : malsyned 390
429 : sh002i 1873 The following template escapes handlers are defined here or may be defined in
430 :     subclasses. For methods that are not defined in this package, the documentation
431 :     defines the interface and behavior that any subclass implementation must follow.
432 : malsyned 313
433 : sh002i 1861 =over
434 :    
435 : sh002i 1873 =item head()
436 : sh002i 1861
437 : sh002i 1873 Not defined in this package.
438 : sh002i 1861
439 : sh002i 1873 Any tags that should appear in the HEAD of the document.
440 : sh002i 1861
441 :     =cut
442 :    
443 : sh002i 1873 #sub head { }
444 : malsyned 349
445 : sh002i 1873 =item info()
446 : sh002i 682
447 : sh002i 1873 Not defined in this package.
448 : sh002i 1861
449 : sh002i 1873 Auxiliary information related to the content displayed in the C<body>.
450 : sh002i 1861
451 : sh002i 1873 =cut
452 : sh002i 1861
453 : sh002i 1873 #sub info { }
454 : sh002i 1861
455 : sh002i 1873 =item links()
456 : sh002i 1861
457 : sh002i 1873 Defined in this package.
458 : sh002i 1861
459 : sh002i 1873 Links that should appear on every page.
460 : sh002i 1861
461 :     =cut
462 :    
463 : sh002i 1866 sub links {
464 :     my ($self) = @_;
465 : sh002i 1873 my $r = $self->r;
466 : sh002i 1866 my $db = $r->db;
467 :     my $urlpath = $r->urlpath;
468 :    
469 :     # we're linking to other places in the same course, so grab the courseID from the current path
470 :     my $courseID = $urlpath->arg("courseID");
471 :    
472 :     # to make things more concise
473 :     my %args = ( courseID => $courseID );
474 :     my $pfx = "WeBWorK::ContentGenerator::";
475 :    
476 : sh002i 1880 my $sets = $urlpath->newFromModule("${pfx}ProblemSets", %args);
477 :     my $options = $urlpath->newFromModule("${pfx}Options", %args);
478 :     my $grades = $urlpath->newFromModule("${pfx}Grades", %args);
479 :     my $logout = $urlpath->newFromModule("${pfx}Logout", %args);
480 :    
481 :     print "\n<!-- BEGIN " . __PACKAGE__ . "::links -->\n";
482 :     print CGI::start_ul({class=>"LinksMenu"});
483 :     print CGI::li(CGI::span({style=>"font-size:larger"},
484 : jj 2222 CGI::a({href=>$self->systemLink($sets)}, 'Problem&nbsp;Sets')));
485 :     print CGI::li(CGI::a({href=>$self->systemLink($options)}, space2nbsp($options->name)));
486 :     print CGI::li(CGI::a({href=>$self->systemLink($grades)}, space2nbsp($grades->name)));
487 :     print CGI::li(CGI::a({href=>$self->systemLink($logout)}, space2nbsp($logout->name)));
488 : sh002i 1880
489 : sh002i 1866 my $PermissionLevel = $db->getPermissionLevel($r->param("user")); # checked
490 :     my $permLevel = $PermissionLevel ? $PermissionLevel->permission : 0;
491 :    
492 :     if ($permLevel > 0) {
493 :     my $ipfx = "${pfx}Instructor::";
494 :    
495 :     my $userID = $r->param("effectiveUser");
496 :     my $setID = $urlpath->arg("setID");
497 : toenail 2014 $setID = "" if (defined $setID && !(grep /$setID/, $db->listUserSets($userID)));
498 : sh002i 1866 my $problemID = $urlpath->arg("problemID");
499 : toenail 2014 $problemID = "" if (defined $problemID && !(grep /$problemID/, $db->listUserProblems($userID, $setID)));
500 : sh002i 1866
501 :     my $instr = $urlpath->newFromModule("${ipfx}Index", %args);
502 : sh002i 1918 my $addUsers = $urlpath->newFromModule("${ipfx}AddUsers", %args);
503 : sh002i 1866 my $userList = $urlpath->newFromModule("${ipfx}UserList", %args);
504 :    
505 :     # set list links
506 :     my $setList = $urlpath->newFromModule("${ipfx}ProblemSetList", %args);
507 :     my $setDetail = $urlpath->newFromModule("${ipfx}ProblemSetEditor", %args, setID => $setID);
508 :     my $problemEditor = $urlpath->newFromModule("${ipfx}PGProblemEditor", %args, setID => $setID, problemID => $problemID);
509 :    
510 : jj 1998 my $maker = $urlpath->newFromModule("${ipfx}SetMaker", %args);
511 : sh002i 1918 my $assigner = $urlpath->newFromModule("${ipfx}Assigner", %args);
512 : sh002i 1866 my $mail = $urlpath->newFromModule("${ipfx}SendMail", %args);
513 :     my $scoring = $urlpath->newFromModule("${ipfx}Scoring", %args);
514 :    
515 :     # statistics links
516 :     my $stats = $urlpath->newFromModule("${ipfx}Stats", %args);
517 :     my $userStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "student", userID => $userID);
518 :     my $setStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "set", setID => $setID);
519 : apizer 2161
520 :     # progress links
521 :     my $progress = $urlpath->newFromModule("${ipfx}StudentProgress", %args);
522 :     my $userProgress = $urlpath->newFromModule("${ipfx}StudentProgress", %args, statType => "student", userID => $userID);
523 :     my $setProgress = $urlpath->newFromModule("${ipfx}StudentProgress", %args, statType => "set", setID => $setID);
524 : sh002i 1866
525 : apizer 2161
526 : sh002i 1866 my $files = $urlpath->newFromModule("${ipfx}FileXfer", %args);
527 :    
528 : jj 1998 print CGI::hr();
529 : sh002i 1880 print CGI::start_li();
530 : jj 2222 print CGI::span({style=>"font-size:larger"}, CGI::a({href=>$self->systemLink($instr)}, space2nbsp($instr->name)));
531 : sh002i 1880 print CGI::start_ul();
532 : jj 2222 print CGI::li(CGI::a({href=>$self->systemLink($addUsers)}, space2nbsp($addUsers->name)));
533 :     print CGI::li(CGI::a({href=>$self->systemLink($userList)}, space2nbsp($userList->name)));
534 : sh002i 1880 print CGI::start_li();
535 : jj 2222 print CGI::a({href=>$self->systemLink($setList)}, space2nbsp($setList->name));
536 : sh002i 1869 if (defined $setID and $setID ne "") {
537 : sh002i 1880 print CGI::start_ul();
538 :     print CGI::start_li();
539 :     print CGI::a({href=>$self->systemLink($setDetail)}, $setID);
540 : sh002i 1869 if (defined $problemID and $problemID ne "") {
541 : sh002i 1880 print CGI::ul(
542 : sh002i 1866 CGI::li(CGI::a({href=>$self->systemLink($problemEditor)}, $problemID))
543 :     );
544 :     }
545 : sh002i 1880 print CGI::end_li();
546 :     print CGI::end_ul();
547 : sh002i 1866 }
548 : sh002i 1880 print CGI::end_li();
549 : jj 2222 print CGI::li(CGI::a({href=>$self->systemLink($maker)}, space2nbsp($maker->name)));
550 :     print CGI::li(CGI::a({href=>$self->systemLink($assigner)}, space2nbsp($assigner->name)));
551 :     print CGI::li(CGI::a({href=>$self->systemLink($mail)}, space2nbsp($mail->name)));
552 :     print CGI::li(CGI::a({href=>$self->systemLink($scoring)}, space2nbsp($scoring->name)));
553 : sh002i 1880 print CGI::start_li();
554 : jj 2222 print CGI::a({href=>$self->systemLink($stats)}, space2nbsp($stats->name));
555 : sh002i 1869 if (defined $userID and $userID ne "") {
556 : sh002i 1880 print CGI::ul(
557 : sh002i 1866 CGI::li(CGI::a({href=>$self->systemLink($userStats)}, $userID))
558 :     );
559 :     }
560 : sh002i 1869 if (defined $setID and $setID ne "") {
561 : sh002i 1880 print CGI::ul(
562 : jj 2222 CGI::li(CGI::a({href=>$self->systemLink($setStats)}, space2nbsp($setID)))
563 : sh002i 1866 );
564 :     }
565 : sh002i 1880 print CGI::end_li();
566 : apizer 2161
567 :     ## Added Link for Student Progress
568 :     print CGI::start_li();
569 : jj 2222 print CGI::a({href=>$self->systemLink($progress)}, space2nbsp($progress->name));
570 : apizer 2161 if (defined $userID and $userID ne "") {
571 :     print CGI::ul(
572 :     CGI::li(CGI::a({href=>$self->systemLink($userProgress)}, $userID))
573 :     );
574 :     }
575 :     if (defined $setID and $setID ne "") {
576 :     print CGI::ul(
577 : jj 2222 CGI::li(CGI::a({href=>$self->systemLink($setProgress)}, space2nbsp($setID)))
578 : apizer 2161 );
579 :     }
580 :     print CGI::end_li();
581 :    
582 : jj 2222 print CGI::li(CGI::a({href=>$self->systemLink($files)}, space2nbsp($files->name)));
583 : sh002i 1880 print CGI::end_ul();
584 :     print CGI::end_li();
585 : sh002i 1866 }
586 :    
587 : sh002i 1880 print CGI::end_ul();
588 :     print "<!-- end " . __PACKAGE__ . "::links -->\n";
589 : sh002i 1866
590 : sh002i 1880 return "";
591 : sh002i 1866 }
592 :    
593 : sh002i 1873 =item loginstatus()
594 : sh002i 1861
595 : sh002i 1873 Defined in this package.
596 : sh002i 1861
597 : sh002i 1873 Print a notification message announcing the current real user and effective
598 :     user, a link to stop acting as the effective user, and a link to logout.
599 : sh002i 1861
600 :     =cut
601 :    
602 :     sub loginstatus {
603 : sh002i 1869 my ($self) = @_;
604 : sh002i 1873 my $r = $self->r;
605 : sh002i 1869 my $urlpath = $r->urlpath;
606 : sh002i 1861
607 :     my $key = $r->param("key");
608 :    
609 : sh002i 1869 if ($key) {
610 :     my $courseID = $urlpath->arg("courseID");
611 :     my $userID = $r->param("user");
612 :     my $eUserID = $r->param("effectiveUser");
613 :    
614 : sh002i 1882 my $stopActingURL = $self->systemLink($urlpath, # current path
615 : sh002i 1911 params => { effectiveUser => $userID },
616 : sh002i 1882 );
617 : sh002i 1869 my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", courseID => $courseID));
618 :    
619 : sh002i 1880 print "\n<!-- BEGIN " . __PACKAGE__ . "::loginstatus -->\n";
620 :    
621 : sh002i 1869 print "Logged in as $userID. ";
622 :     print CGI::a({href=>$logoutURL}, "Log Out");
623 :    
624 :     if ($eUserID ne $userID) {
625 :     print " | Acting as $eUserID. ";
626 :     print CGI::a({href=>$stopActingURL}, "Stop Acting");
627 :     }
628 : sh002i 1880
629 :     print "<!-- END " . __PACKAGE__ . "::loginstatus -->\n";
630 : sh002i 1861 }
631 :    
632 :     return "";
633 :     }
634 :    
635 : sh002i 1873 =item nav($args)
636 : sh002i 1869
637 : sh002i 1873 Not defined in this package.
638 : sh002i 1861
639 : sh002i 1873 Links to the previous, next, and parent objects.
640 : sh002i 1861
641 : sh002i 1873 $args is a reference to a hash containing the following fields:
642 :    
643 : sh002i 1861 style => text|image
644 :     imageprefix => prefix to prepend to base image URL
645 :     imagesuffix => suffix to append to base image URL
646 :     separator => HTML to place in between links
647 :    
648 : sh002i 1873 If C<style> is "image", image URLs are constructed by prepending C<imageprefix>
649 :     and postpending C<imagesuffix> to the image base names defined by the
650 :     implementor. (Examples of base names include "Prev", "Next", "ProbSet", and
651 :     "Up"). Each concatenated string should form an absolute URL to an image file.
652 :     For example:
653 : sh002i 1861
654 : sh002i 1873 <!--#nav style="images" imageprefix="/webwork2_files/images/nav"
655 :     imagesuffix=".gif" separator=" "-->
656 : sh002i 1861
657 : sh002i 1873 =cut
658 : sh002i 1861
659 : sh002i 1873 #sub nav { }
660 : sh002i 1861
661 : sh002i 1873 =item options()
662 :    
663 :     Not defined in this package.
664 :    
665 :     Print an auxiliary options form, related to the content displayed in the
666 :     C<body>.
667 :    
668 :     =item path($args)
669 :    
670 :     Defined in this package.
671 :    
672 :     Print "breadcrubs" from the root of the virtual hierarchy to the current page.
673 :     $args is a reference to a hash containing the following fields:
674 :    
675 : sh002i 1861 style => type of separator: text|image
676 : sh002i 1873 image => if style=image, URL of image to use as path separator
677 :     text => if style=text, text to use as path separator
678 :     if style=image, the ALT text of each separator image
679 :     textonly => suppress all HTML, return only plain text
680 : sh002i 1861
681 : sh002i 1873 The implementation in this package takes information from the WeBWorK::URLPath
682 :     associated with the current request.
683 :    
684 : sh002i 1861 =cut
685 :    
686 :     sub path {
687 :     my ($self, $args) = @_;
688 : sh002i 1873 my $r = $self->r;
689 : sh002i 1861
690 :     my @path;
691 :    
692 :     my $urlpath = $r->urlpath;
693 :     do {
694 :     unshift @path, $urlpath->name, $r->location . $urlpath->path;
695 :     } while ($urlpath = $urlpath->parent);
696 :    
697 :     $path[$#path] = ""; # we don't want the last path element to be a link
698 :    
699 : sh002i 1882 #print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n";
700 : sh002i 1880 print $self->pathMacro($args, @path);
701 : sh002i 1882 #print "<!-- END " . __PACKAGE__ . "::path -->\n";
702 : sh002i 1880
703 :     return "";
704 : sh002i 1861 }
705 :    
706 : sh002i 1873 =item siblings()
707 : sh002i 1861
708 : sh002i 1873 Not defined in this package.
709 : sh002i 1861
710 : sh002i 1873 Print links to siblings of the current object.
711 : sh002i 1861
712 : sh002i 1873 =cut
713 : sh002i 1861
714 : sh002i 1873 #sub siblings { }
715 :    
716 : jj 1942 =item timestamp()
717 :    
718 :     Defined in this package.
719 :    
720 :     Display the current time and date using default format "3:37pm on Jan 7, 2004".
721 :     The display format can be adjusted by giving a style in the template.
722 :     For example,
723 :    
724 :     <!--#timestamp style="%m/%d/%y at %I:%M%P"-->
725 :    
726 :     will give standard WeBWorK time format. Wording and other formatting
727 :     can be done in the template itself.
728 :     =cut
729 :    
730 :     sub timestamp {
731 :     my ($self, $args) = @_;
732 :     my $formatstring = "%l:%M%P on %b %e, %Y";
733 :     $formatstring = $args->{style} if(defined($args->{style}));
734 :     return(Date::Format::time2str($formatstring, time()));
735 :     }
736 :    
737 : sh002i 1873 =item submiterror()
738 :    
739 :     Defined in this package.
740 :    
741 :     Print any error messages resulting from the last form submission.
742 :    
743 : toenail 2013 This method is deprecated -- use message() instead
744 :    
745 : sh002i 1873 The implementation in this package prints the value of the field
746 :     $self->{submitError}, if it is present.
747 :    
748 : sh002i 1861 =cut
749 :    
750 :     sub submiterror {
751 :     my ($self) = @_;
752 : sh002i 1880
753 :     print "\n<!-- BEGIN " . __PACKAGE__ . "::submiterror -->\n";
754 :     print $self->{submitError} if exists $self->{submitError};
755 :     print "<!-- END " . __PACKAGE__ . "::submiterror -->\n";
756 :    
757 :     return "";
758 : sh002i 1861 }
759 :    
760 : toenail 2013 =item message()
761 :    
762 :     Defined in this package.
763 :    
764 :     Print any messages (error or non-error) resulting from the last form submission.
765 :     This could be used to give Sucess and Failure messages after an action is performed by a module.
766 :    
767 :     The implementation in this package prints the value of the field
768 : sh002i 2034 $self->{status_message}, if it is present.
769 : toenail 2013
770 :     =cut
771 :    
772 :     sub message {
773 :     my ($self) = @_;
774 :    
775 :     print "\n<!-- BEGIN " . __PACKAGE__ . "::message -->\n";
776 : sh002i 2034 print $self->{status_message} if exists $self->{status_message};
777 : toenail 2013 print "<!-- END " . __PACKAGE__ . "::message -->\n";
778 :    
779 :     return "";
780 :     }
781 :    
782 : sh002i 1873 =item title()
783 : sh002i 1861
784 : sh002i 1873 Defined in this package.
785 : sh002i 1861
786 : sh002i 1873 Print the title of the current page.
787 :    
788 :     The implementation in this package takes information from the WeBWorK::URLPath
789 :     associated with the current request.
790 :    
791 : sh002i 1861 =cut
792 :    
793 :     sub title {
794 :     my ($self, $args) = @_;
795 : sh002i 1873 my $r = $self->r;
796 : sh002i 1861
797 : sh002i 1880
798 : sh002i 1882 #print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n";
799 : sh002i 1880 print $r->urlpath->name;
800 : sh002i 1882 #print "<!-- END " . __PACKAGE__ . "::title -->\n";
801 : sh002i 1880
802 :     return "";
803 : sh002i 1861 }
804 :    
805 : sh002i 1873 =item warnings()
806 : sh002i 1861
807 : sh002i 1873 Defined in this package.
808 : sh002i 1861
809 : sh002i 1873 Print accumulated warnings.
810 :    
811 :     The implementation in this package checks for a note in the request named
812 :     "warnings". If present, its contents are formatted and returned.
813 :    
814 : sh002i 1861 =cut
815 :    
816 :     sub warnings {
817 :     my ($self) = @_;
818 : sh002i 1873 my $r = $self->r;
819 : sh002i 1880
820 :     print "\n<!-- BEGIN " . __PACKAGE__ . "::warnings -->\n";
821 :     print $self->warningOutput($r->notes("warnings")) if $r->notes("warnings");
822 :     print "<!-- END " . __PACKAGE__ . "::warnings -->\n";
823 :    
824 :     return "";
825 : sh002i 1861 }
826 :    
827 :     =back
828 :    
829 : sh002i 1873 =cut
830 : sh002i 1861
831 : sh002i 1873 # ------------------------------------------------------------------------------
832 : sh002i 1861
833 : sh002i 1873 =head2 Conditional predicates
834 :    
835 :     Conditional predicate methods are invoked when the C<#if> escape sequence is
836 :     encountered in the template. If a method named C<if_predicate> is defined in
837 :     here or in the instantiated subclass, it is invoked.
838 :    
839 : sh002i 1861 The following predicates are currently defined:
840 :    
841 :     =over
842 :    
843 : sh002i 1873 =item if_can($function)
844 : sh002i 1861
845 : sh002i 1873 If a function named $function is present in the current content generator (or
846 :     any superclass), a true value is returned. Otherwise, a false value is returned.
847 : sh002i 1861
848 : sh002i 1873 The implementation in this package uses the method UNIVERSAL->can(function) to
849 :     arrive at the result.
850 :    
851 :     A subclass could redefine this method to, for example, "hide" a method from the
852 :     template:
853 :    
854 :     sub if_can {
855 :     my ($self, $arg) = @_;
856 :    
857 :     if ($arg eq "floobar") {
858 :     return 0;
859 :     } else {
860 :     return $self->SUPER::if_can($arg);
861 :     }
862 :     }
863 :    
864 : sh002i 1861 =cut
865 :    
866 : sh002i 1873 sub if_can {
867 :     my ($self, $arg) = @_;
868 : malsyned 525
869 : sh002i 1873 return $self->can($arg) ? 1 : 0;
870 : malsyned 525 }
871 :    
872 : sh002i 1873 =item if_loggedin($arg)
873 : sh002i 1861
874 : sh002i 1873 If the user is currently logged in, $arg is returned. Otherwise, the inverse of
875 :     $arg is returned.
876 : sh002i 1861
877 : sh002i 1873 The implementation in this package always returns $arg, since most content
878 :     generators are only reachable when the user is authenticated. It is up to
879 :     classes that can be reached without logging in to override this method and
880 :     provide the correct behavior.
881 :    
882 :     This is suboptimal, and may change in the future.
883 :    
884 : sh002i 1861 =cut
885 :    
886 : sh002i 1873 sub if_loggedin {
887 :     my ($self, $arg) = @_;
888 : malsyned 748
889 :     return $arg;
890 :     }
891 :    
892 : sh002i 1873 =item if_submiterror($arg)
893 : sh002i 1131
894 : sh002i 1873 If the last form submission generated an error, $arg is returned. Otherwise, the
895 :     inverse of $arg is returned.
896 :    
897 :     The implementation in this package checks for the field $self->{submitError} to
898 :     determine if an error condition is present.
899 :    
900 :     If a subclass uses some other method to classify submission results, this method could be
901 :     redefined to handle that variance:
902 :    
903 :     sub if_submiterror {
904 :     my ($self, $arg) = @_;
905 :    
906 :     my $status = $self->{processReturnValue};
907 :     if ($status != 0) {
908 :     return $arg;
909 :     } else {
910 :     return !$arg;
911 :     }
912 :     }
913 :    
914 : sh002i 1861 =cut
915 :    
916 : sh002i 1873 sub if_submiterror {
917 : malsyned 1017 my ($self, $arg) = @_;
918 : sh002i 1873
919 : malsyned 1017 if (exists $self->{submitError}) {
920 :     return $arg;
921 :     } else {
922 :     return !$arg;
923 :     }
924 :     }
925 :    
926 : toenail 2013 =item if_message($arg)
927 :    
928 :     If the last form submission generated a message, $arg is returned. Otherwise, the
929 :     inverse of $arg is returned.
930 :    
931 : sh002i 2034 The implementation in this package checks for the field $self->{status_message} to
932 : toenail 2013 determine if a message is present.
933 :    
934 :     If a subclass uses some other method to classify submission results, this method could be
935 :     redefined to handle that variance:
936 :    
937 :     sub if_message {
938 :     my ($self, $arg) = @_;
939 :    
940 :     my $status = $self->{processReturnValue};
941 :     if ($status != 0) {
942 :     return $arg;
943 :     } else {
944 :     return !$arg;
945 :     }
946 :     }
947 :    
948 :     =cut
949 :    
950 :     sub if_message {
951 :     my ($self, $arg) = @_;
952 :    
953 : sh002i 2034 if (exists $self->{status_message}) {
954 : toenail 2013 return $arg;
955 :     } else {
956 :     return !$arg;
957 :     }
958 :     }
959 :    
960 : sh002i 1861 =item if_warnings
961 : sh002i 1131
962 : sh002i 1873 If warnings have been emitted while handling this request, $arg is returned.
963 :     Otherwise, the inverse of $arg is returned.
964 :    
965 :     The implementation in this package checks for a note in the request named
966 :     "warnings". This is set by the WARN handler in Apache::WeBWorK when a warning is
967 :     handled.
968 :    
969 : sh002i 1869 =cut
970 :    
971 : sh002i 1873 sub if_warnings {
972 : sh002i 1131 my ($self, $arg) = @_;
973 : sh002i 1873 my $r = $self->r;
974 :    
975 :     if ($r->notes("warnings")) {
976 :     return $arg;
977 :     } else {
978 :     !$arg;
979 :     }
980 : sh002i 1131 }
981 :    
982 : sh002i 1861 =back
983 : sh002i 1131
984 : sh002i 1861 =cut
985 :    
986 : sh002i 1873 ################################################################################
987 : malsyned 508
988 : sh002i 1873 =head1 HTML MACROS
989 : malsyned 508
990 : sh002i 1873 Various routines are defined in this package for rendering common WeBWorK
991 :     idioms.
992 :    
993 :     FIXME: some of these should be moved to WeBWorK::HTML:: modules!
994 :    
995 :     # ------------------------------------------------------------------------------
996 :    
997 :     =head2 Template escape handler macros
998 :    
999 :     These methods are used by implementations of the escape sequence handlers to
1000 :     maintain a consistent style.
1001 :    
1002 :     =over
1003 :    
1004 :     =item pathMacro($args, @path)
1005 :    
1006 :     Helper macro for the C<#path> escape sequence: $args is a hash reference
1007 :     containing the "style", "image", "text", and "textonly" arguments to the escape.
1008 :     @path consists of ordered key-value pairs of the form:
1009 :    
1010 :     "Page Name" => URL
1011 :    
1012 :     If the page should not have a link associated with it, the URL should be left
1013 :     empty. Authentication data is added to each URL so you don't have to. A fully-
1014 :     formed path line is returned, suitable for returning by a function implementing
1015 :     the C<#path> escape.
1016 :    
1017 :     FIXME: authentication data probably shouldn't be added here any more, now that
1018 :     we have systemLink().
1019 :    
1020 :     =cut
1021 :    
1022 :     sub pathMacro {
1023 :     my ($self, $args, @path) = @_;
1024 :     my %args = %$args;
1025 :     $args{style} = "text" if $args{textonly};
1026 :    
1027 :     my $auth = $self->url_authen_args;
1028 :     my $sep;
1029 :     if ($args{style} eq "image") {
1030 :     $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}});
1031 :     } else {
1032 :     $sep = $args{text};
1033 :     }
1034 :    
1035 :     my @result;
1036 :     while (@path) {
1037 :     my $name = shift @path;
1038 :     my $url = shift @path;
1039 :     if ($url and not $args{textonly}) {
1040 :     push @result, CGI::a({-href=>"$url?$auth"}, $name);
1041 :     } else {
1042 :     push @result, $name;
1043 :     }
1044 :     }
1045 :    
1046 :     return join($sep, @result), "\n";
1047 :     }
1048 :    
1049 :     =item siblingsMacro(@siblings)
1050 :    
1051 :     Helper macro for the C<#siblings> escape sequence. @siblings consists of ordered
1052 :     key-value pairs of the form:
1053 :    
1054 :     "Sibling Name" => URL
1055 :    
1056 :     If the sibling should not have a link associated with it, the URL should be left
1057 :     empty. Authentication data is added to each URL so you don't have to. A fully-
1058 :     formed siblings block is returned, suitable for returning by a function
1059 :     implementing the C<#siblings> escape.
1060 :    
1061 :     FIXME: authentication data probably shouldn't be added here any more, now that
1062 :     we have systemLink().
1063 :    
1064 :     =cut
1065 :    
1066 :     sub siblingsMacro {
1067 :     my ($self, @siblings) = @_;
1068 :    
1069 :     my $auth = $self->url_authen_args;
1070 :     my $sep = CGI::br();
1071 :    
1072 :     my @result;
1073 :     while (@siblings) {
1074 :     my $name = shift @siblings;
1075 :     my $url = shift @siblings;
1076 :     push @result, $url
1077 :     ? CGI::a({-href=>"$url?$auth"}, $name)
1078 :     : $name;
1079 :     }
1080 :    
1081 :     return join($sep, @result) . "\n";
1082 :     }
1083 :    
1084 :     =item navMacro($args, $tail, @links)
1085 :    
1086 :     Helper macro for the C<#nav> escape sequence: $args is a hash reference
1087 :     containing the "style", "imageprefix", "imagesuffix", and "separator" arguments
1088 :     to the escape. @siblings consists of ordered tuples of the form:
1089 :    
1090 :     "Link Name", URL, ImageBaseName
1091 :    
1092 :     If the sibling should not have a link associated with it, the URL should be left
1093 :     empty. ImageBaseName is placed between the C<imageprefix> and C<imagesuffix>.
1094 :     Authentication data is added to each URL so you don't have to. $tail is appended
1095 :     to each URL, after the authentication information. A fully-formed nav line is
1096 :     returned, suitable for returning by a function implementing the C<#nav> escape.
1097 :    
1098 :     =cut
1099 :    
1100 :     sub navMacro {
1101 :     my ($self, $args, $tail, @links) = @_;
1102 :     my $r = $self->r;
1103 :     my $ce = $r->ce;
1104 :     my %args = %$args;
1105 :    
1106 :     my $auth = $self->url_authen_args;
1107 :     my $prefix = $ce->{webworkURLs}->{htdocs}."/images";
1108 :    
1109 :     my @result;
1110 :     while (@links) {
1111 :     my $name = shift @links;
1112 :     my $url = shift @links;
1113 :     my $img = shift @links;
1114 :     my $html =
1115 :     ($img && $args{style} eq "images")
1116 :     ? CGI::img(
1117 :     {src=>($prefix."/".$img.$args{imagesuffix}),
1118 :     border=>"",
1119 :     alt=>"$name"})
1120 :     : $name;
1121 :     unless($img && !$url) {
1122 :     push @result, $url
1123 :     ? CGI::a({-href=>"$url?$auth$tail"}, $html)
1124 :     : $html;
1125 :     }
1126 :     }
1127 :    
1128 :     return join($args{separator}, @result) . "\n";
1129 :     }
1130 :    
1131 :     =back
1132 :    
1133 :     =cut
1134 :    
1135 :     # ------------------------------------------------------------------------------
1136 :    
1137 :     =head2 Parameter management
1138 :    
1139 :     Methods for formatting request parameters as hidden form fields or query string
1140 :     fragments.
1141 :    
1142 :     =over
1143 :    
1144 :     =item hidden_fields(@fields)
1145 :    
1146 :     Return hidden <INPUT> tags for each field mentioned in @fields (or all fields if
1147 :     list is empty), taking data from the current request.
1148 :    
1149 :     =cut
1150 :    
1151 :     sub hidden_fields {
1152 :     my ($self, @fields) = @_;
1153 :     my $r = $self->r;
1154 :    
1155 :     @fields = $r->param unless @fields;
1156 :    
1157 :     my $html = "";
1158 :     foreach my $param (@fields) {
1159 :     my @values = $r->param($param);
1160 :     $html .= CGI::hidden($param, @values);
1161 :     }
1162 :     return $html;
1163 :     }
1164 :    
1165 :     =item hidden_authen_fields()
1166 :    
1167 :     Use hidden_fields to return hidden <INPUT> tags for request fields used in
1168 :     authentication.
1169 :    
1170 :     =cut
1171 :    
1172 :     sub hidden_authen_fields {
1173 :     my ($self) = @_;
1174 :    
1175 :     return $self->hidden_fields("user", "effectiveUser", "key");
1176 :     }
1177 :    
1178 :     =item url_args(@fields)
1179 :    
1180 :     Return a URL query string (without the leading `?') containing values for each
1181 :     field mentioned in @fields, or all fields if list is empty. Data is taken from
1182 :     the current request.
1183 :    
1184 :     =cut
1185 :    
1186 :     sub url_args {
1187 :     my ($self, @fields) = @_;
1188 :     my $r = $self->r;
1189 :    
1190 :     @fields = $r->param unless @fields;
1191 :    
1192 :     my @pairs;
1193 :     foreach my $param (@fields) {
1194 :     my @values = $r->param($param);
1195 :     foreach my $value (@values) {
1196 :     push @pairs, uri_escape($param) . "=" . uri_escape($value);
1197 :     }
1198 :     }
1199 :    
1200 :     return join("&", @pairs);
1201 :     }
1202 :    
1203 :     =item url_authen_args()
1204 :    
1205 :     Use url_args to return a URL query string for request fields used in
1206 :     authentication.
1207 :    
1208 :     =cut
1209 :    
1210 :     sub url_authen_args {
1211 :     my ($self) = @_;
1212 :    
1213 :     return $self->url_args("user", "effectiveUser", "key");
1214 :     }
1215 :    
1216 :     =item print_form_data($begin, $middle, $end, $omit)
1217 :    
1218 :     Return a string containing every request field not matched by the quoted reguar
1219 :     expression $omit, placing $begin before each field name, $middle between each
1220 :     field name and its value, and $end after each value. Values are taken from the
1221 :     current request.
1222 :    
1223 :     =cut
1224 :    
1225 :     sub print_form_data {
1226 :     my ($self, $begin, $middle, $end, $qr_omit) = @_;
1227 :     my $r=$self->r;
1228 :     my @form_data = $r->param;
1229 :    
1230 :     my $return_string = "";
1231 :     foreach my $name (@form_data) {
1232 :     next if ($qr_omit and $name =~ /$qr_omit/);
1233 :     my @values = $r->param($name);
1234 :     foreach my $variable (qw(begin name middle value end)) {
1235 :     # FIXME: can this loop be moved out of the enclosing loop?
1236 :     no strict 'refs';
1237 :     ${$variable} = "" unless defined ${$variable};
1238 :     }
1239 :     foreach my $value (@values) {
1240 :     $return_string .= "$begin$name$middle$value$end";
1241 :     }
1242 :     }
1243 :    
1244 :     return $return_string;
1245 :     }
1246 :    
1247 :     =back
1248 :    
1249 :     =cut
1250 :    
1251 :     # ------------------------------------------------------------------------------
1252 :    
1253 :     =head2 Utilities
1254 :    
1255 :     =over
1256 :    
1257 :     =item systemLink($urlpath, %options)
1258 :    
1259 :     Generate a link to another part of the system. $urlpath is WeBWorK::URLPath
1260 :     object from which the base path will be taken. %options can consist of:
1261 :    
1262 :     =over
1263 :    
1264 : sh002i 1882 =item params
1265 : sh002i 1873
1266 : sh002i 1911 Can be either a reference to an array or a reference to a hash.
1267 : sh002i 1873
1268 : sh002i 1911 If it is a reference to a hash, it maps parmaeter names to values. These
1269 :     parameters will be included in the generated link. If a value is an arrayref,
1270 :     the values of the array referenced will be used. If a value is undefined, the
1271 :     value from the current request will be used.
1272 : sh002i 1873
1273 : sh002i 1911 If C<params> is an arrayref, it is interpreted as a list of parameter names.
1274 :     These parameters will be included in the generated link, using the values from
1275 :     the current request.
1276 : sh002i 1873
1277 : sh002i 1911 Unless C<authen> is false (see below), the authentication parameters (C<user>,
1278 :     C<effectiveUser>, and C<key>) are included with their default values.
1279 : sh002i 1898
1280 : sh002i 1882 =item authen
1281 : sh002i 1873
1282 : sh002i 1911 If set to a false value, the authentication parameters (C<user>,
1283 :     C<effectiveUser>, and C<key>) are included in the the generated link unless
1284 :     explicitly listed in C<params>.
1285 : sh002i 1873
1286 :     =back
1287 :    
1288 :     =cut
1289 :    
1290 : sh002i 1882 # FIXME: there should probably be an option for prepending "http://hostname:port"
1291 : sh002i 1873 sub systemLink {
1292 :     my ($self, $urlpath, %options) = @_;
1293 :     my $r = $self->r;
1294 :    
1295 : sh002i 1911 my %params = ();
1296 : sh002i 1882 if (exists $options{params}) {
1297 : sh002i 1911 if (ref $options{params} eq "HASH") {
1298 :     %params = %{ $options{params} };
1299 :     } elsif (ref $options{params} eq "ARRAY") {
1300 :     my @names = @{ $options{params} };
1301 :     @params{@names} = ();
1302 :     } else {
1303 :     croak "option 'params' is not a hashref or an arrayref";
1304 :     }
1305 : sh002i 1882 }
1306 : sh002i 1873
1307 : sh002i 1893 my $authen = exists $options{authen} ? $options{authen} : 1;
1308 : sh002i 1911 if ($authen) {
1309 :     $params{user} = undef unless exists $params{user};
1310 :     $params{effectiveUser} = undef unless exists $params{effectiveUser};
1311 :     $params{key} = undef unless exists $params{key};
1312 : sh002i 1882 }
1313 :    
1314 : sh002i 1873 my $url = $r->location . $urlpath->path;
1315 : sh002i 1911 my $first = 1;
1316 : sh002i 1873
1317 : sh002i 1911 foreach my $name (keys %params) {
1318 :     my $value = $params{$name};
1319 :    
1320 :     my @values;
1321 :     if (defined $value) {
1322 :     if (ref $value eq "ARRAY") {
1323 :     @values = @$value;
1324 :     } else {
1325 :     @values = $value;
1326 :     }
1327 :     } elsif (defined $r->param($name)) {
1328 :     @values = $r->param($name);
1329 :     }
1330 :    
1331 :     if (@values) {
1332 :     if ($first) {
1333 :     $url .= "?";
1334 :     $first = 0;
1335 :     } else {
1336 :     $url .= "&";
1337 :     }
1338 :     $url .= join "&", map { "$name=$_" } @values;
1339 :     }
1340 : sh002i 1873 }
1341 :    
1342 :     return $url;
1343 :     }
1344 :    
1345 :     =item nbsp($string)
1346 :    
1347 :     If string consists of only whitespace, the HTML entity C<&nbsp;> is returned.
1348 :     Otherwise $string is returned.
1349 :    
1350 :     =cut
1351 :    
1352 :     sub nbsp {
1353 :     my $self = shift;
1354 :     my $str = shift;
1355 : sh002i 1974 (defined $str && $str =~/\S/) ? $str : '&nbsp;';
1356 : sh002i 1873 }
1357 :    
1358 : jj 2222 =item space2nbsp($string)
1359 :    
1360 :     Replace spaces in the string with html non-breaking spaces.
1361 :    
1362 :     =cut
1363 :    
1364 :     sub space2nbsp {
1365 :     my $str = shift;
1366 :     $str =~ s/\s/&nbsp;/g;
1367 :     return($str);
1368 :     }
1369 :    
1370 : sh002i 1873 =item errorOutput($error, $details)
1371 :    
1372 :     =cut
1373 :    
1374 :     sub errorOutput($$$) {
1375 :     my ($self, $error, $details) = @_;
1376 :     return
1377 :     CGI::h3("Software Error"),
1378 :     CGI::p(<<EOF),
1379 :     WeBWorK has encountered a software error while attempting to process this
1380 :     problem. It is likely that there is an error in the problem itself. If you are
1381 :     a student, contact your professor to have the error corrected. If you are a
1382 :     professor, please consut the error output below for more informaiton.
1383 :     EOF
1384 :     # FIXME: this message shouldn't refer the the "problem" since it is for general error reporting
1385 :     CGI::h3("Error messages"), CGI::p(CGI::tt($error)),
1386 :     CGI::h3("Error context"), CGI::p(CGI::tt($details));
1387 :     }
1388 :    
1389 :     =item warningOutput($warnings)
1390 :    
1391 :     =cut
1392 :    
1393 :     sub warningOutput($$) {
1394 :     my ($self, $warnings) = @_;
1395 :    
1396 :     my @warnings = split m/\n+/, $warnings;
1397 :    
1398 :     return
1399 :     CGI::h3("Software Warnings"),
1400 :     CGI::p(<<EOF),
1401 :     WeBWorK has encountered warnings while attempting to process this problem. It
1402 :     is likely that this indicates an error or ambiguity in the problem itself. If
1403 :     you are a student, contact your professor to have the problem corrected. If you
1404 :     are a professor, please consut the warning output below for more informaiton.
1405 :     EOF
1406 :     # FIXME: this message shouldn't refer the the "problem" since it is for general warning reporting
1407 :     CGI::h3("Warning messages"),
1408 :     CGI::ul(CGI::li(\@warnings));
1409 :     }
1410 :    
1411 :     =back
1412 :    
1413 : malsyned 508 =head1 AUTHOR
1414 :    
1415 : sh002i 1873 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu and Sam Hathaway,
1416 :     sh002i (at) math.rochester.edu.
1417 : malsyned 508
1418 :     =cut
1419 : sh002i 1873
1420 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9