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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 353 Revision 1741
1################################################################################
2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.75 2004/01/17 16:29:52 gage 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
1package WeBWorK::ContentGenerator; 17package WeBWorK::ContentGenerator;
2 18
3use CGI qw(-compile :html :form); 19=head1 NAME
20
21WeBWorK::ContentGenerator - base class for modules that generate page content.
22
23=cut
24
25use strict;
26use warnings;
4use Apache::Constants qw(:common); 27use Apache::Constants qw(:common);
28use CGI qw();
29use URI::Escape;
30use WeBWorK::Authz;
31use WeBWorK::DB;
32use WeBWorK::Utils qw(readFile);
5 33
6# This is a superclass for Apache::WeBWorK's content generators. 34################################################################################
7# You are /definitely/ encouraged to read this file, since there are 35# This is a very unruly file, so I'm going to use very large comments to divide
8# "abstract" functions here which show aproximately what form you would 36# it into logical sections.
9# want over-ridden sub-classes to follow. go() is a particularly pertinent 37################################################################################
10# example.
11 38
12# new(Apache::Request, WeBWorK::CourseEnvironment) 39# new(Apache::Request, WeBWorK::CourseEnvironment, WeBWorK::DB) - create a new
40# instance of a content generator. Usually only called by the dispatcher, although
41# one might be able to use it for things like "sub-requests". Uh... uh... I have
42# to think about that one. The dispatcher uses this idiom:
43#
44# WeBWorK::ContentGenerator::WHATEVER->new($r, $ce, $db)->go(@whatever);
45#
46# and throws away the result ;)
47#
13sub new($$$) { 48sub new {
14 my $invocant = shift; 49 my ($invocant, $r, $ce, $db) = @_;
15 my $class = ref($invocant) || $invocant; 50 my $class = ref($invocant) || $invocant;
16 my $self = {}; 51 my $self = {
17 ($self->{r}, $self->{courseEnvironment}) = @_; 52 r => $r,
53 ce => $ce,
54 db => $db,
55 authz => WeBWorK::Authz->new($r, $ce, $db),
56 noContent => undef,
57 };
18 bless $self, $class; 58 bless $self, $class;
19 return $self; 59 return $self;
20} 60}
21 61
62################################################################################
63# Invocation and template processing
64################################################################################
22 65
23# This is a quick and dirty function to print out all (or almost all) of the 66# go(@otherArguments) - render a page, using methods from the particular
24# fields in a form in a specified format. As you can see from the print 67# subclass of ContentGenerator. @otherArguments is passed to each method, so
25# statement, it just prints out $begining$name$middle$value$end for every 68# that the dispatcher can pass CG-specific data. The order of calls looks like
26# field who's name doesn't match $qr_omit, a quoted regex. 69# this:
27# In it's current incarnation, it should be called from subclasses only, 70#
28# by saying $self->print_form_data. Of course, you could construct a 71# * &pre_header_initialize - give subclasses a chance to do initialization
29# hashref with ->{r} being an Apache::Request, I suppose. 72# necessary for generating the HTTP header.
73# * &header - this class provides a standard HTTP header with Content-Type
74# text/html. Subclasses are welcome to overload this for things like
75# an image-creation content generator or a PDF generator.
76# In addition, if &header returns a value, that will be the value
77# returned by the entire PerlHandler.
78# * &initialize - let subclasses do post-header initialization.
79# * any "template escapes" defined in the system template and supported by
80# the subclass.
81# (if &content exists on a content generator, it is called
82# and no template processing occurs.)
83#
84# If &pre_header_initialize or &header sets $self->{noContent} to a true value,
85# &initialize will not be run and the content or template processing code
86# will not be executed. This is probably only desirable if a redirect has been
87# issued.
88sub go {
89 my $self = shift;
90
91 my $r = $self->{r};
92 my $ce = $self->{ce};
93 my $returnValue = OK;
94
95 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize");
96 my $headerReturn = $self->header(@_);
97 $returnValue = $headerReturn if defined $headerReturn;
98 return $returnValue if $r->header_only or $self->{noContent};
99
100 # if the sendFile flag is set, send the file and exit;
101 if ($self->{sendFile}) {
102 return $self->sendFile;
103 }
104
105 $self->initialize(@_) if $self->can("initialize");
106
107 # A content generator will have a "content" method if it does not
108 # wish to be passed through template processing, but wishes to be
109 # completely responsible for it's own output.
110 if ($self->can("content")) {
111 $self->content(@_);
112 } else {
113 # if the content generator specifies a custom template name, use that
114 # field in the $ce->{templates} hash instead of "system" if it exists.
115 my $templateName;
116 if ($self->can("templateName")) {
117 $templateName = $self->templateName;
118 } else {
119 $templateName = "system";
120 }
121 $templateName = "system" unless exists $ce->{templates}->{$templateName};
122 $self->template($ce->{templates}->{$templateName}, @_);
123 }
124
125 return $returnValue;
126}
30 127
128sub sendFile {
129 my ($self) = @_;
130
131 my $file = $self->{sendFile}->{source};
132
133 return NOT_FOUND unless -e $file;
134 return FORBIDDEN unless -r $file;
135
136 open my $fh, "<", $file
137 or return SERVER_ERROR;
138 while (<$fh>) {
139 print $_;
140 }
141 close $fh;
142
143 return OK;
144}
145
146# template(STRING, @otherArguments) - parse a template, looking for escapes of
147# the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME
148# (if available) for each NAME. The escapes are called like:
149#
150# $self->NAME(@otherArguments, \%escapeArguments)
151#
152# where @otherArguments originates in the dispatcher and %escapeArguments is
153# parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR)
154#
155sub template {
156 my ($self, $templateFile) = (shift, shift);
157 my $r = $self->{r};
158 my $courseEnvironment = $self->{ce};
159 my @ifstack = (1); # Start off in printing mode
160 # say $ifstack[-1] to get the result of the last <#!--if-->
161
162 # so even though the variable $/ APPEARS to contain a newline,
163 # <TEMPLATE> is slurping the whole file into the first element of
164 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!!
165 #
166 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
167 #my @template = <TEMPLATE>;
168 #close TEMPLATE;
169 #
170 # Let's try something else instead:
171 my @template = split /\n/, readFile($templateFile);
172
173 foreach my $line (@template) {
174 # This is incremental regex processing.
175 # the /c is so that pos($line) doesn't die when the regex fails.
176 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) {
177 my ($before, $function, $raw_args) = ($1, $2, $3);
178 my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : ();
179
180 if ($ifstack[-1]) {
181 print $before;
182 }
183
184 if ($function eq "if") {
185 # a predicate can only be true if everything else on the ifstack is already true, for ANDing
186 push @ifstack, ($self->$function(@_, [@args]) && $ifstack[-1]);
187 } elsif ($function eq "else" and @ifstack > 1) {
188 $ifstack[-1] = not $ifstack[-1];
189 } elsif ($function eq "endif" and @ifstack > 1) {
190 pop @ifstack;
191 } elsif ($ifstack[-1]) {
192 if ($self->can($function)) {
193 my @result = $self->$function(@_, {@args});
194 if (@result) {
195 print @result;
196 } else {
197 warn "Template escape $function returned an empty list.";
198 }
199 }
200 }
201 }
202
203 if ($ifstack[-1]) {
204 print substr($line, (defined pos $line) ? pos $line : 0), "\n";
205 }
206 }
207}
208
209# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns
210# a list which pairs into key/values and fits nicely in {}s.
211#
212sub cook_args($) { # ... also used by bin/wwdb, so watch out
213 my ($raw_args) = @_;
214 my @args = ();
215
216 # Boy I love m//g in scalar context! Go read the camel book, heathen.
217 # First, get the whole token with the quotes on both ends...
218 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) {
219 my ($key, $value) = ($1, $2);
220 # ... then, rip out all the protecty backspaces
221 $value =~ s/\\(.)/$1/g;
222 push @args, $key => $value;
223 }
224
225 return @args;
226}
227
228# This is different. It probably shouldn't print anything (except in debugging cases)
229# and it should return a boolean, not a string. &if is called in a nonstandard way
230# by &template, with $args as an arrayref instead of a hashref. this is a hack! yay!
231
232# OK, this is a pluggin architecture. it iterates through attributes of the "if" tag,
233# and for each predicate $p, it calls &if_$p in an object-oriented way, continuing the
234# grand templating theme of an object-oriented pluggable architecture using ->can($).
235sub if {
236 my ($self, $args) = @_[0,-1];
237 # A single if "or"s it's components. Nesting produces "and".
238
239 my @args = @$args; # Hahahahaha, get it?!
240
241 if (@args % 2 != 0) {
242 # flip out and kill people, but do not commit seppuku
243 print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n';
244 }
245
246 while (@args > 1) {
247 my ($key, $value) = (shift @args, shift @args);
248
249 # a non-existent &if_$key is the same as a false result, but we're ORing, so it's OK
250 my $sub = "if_$key"; # perl doesn't like it when you try to construct a string right in a method invocation
251 if ($self->can("if_$key") and $self->$sub("$value")) {
252 return 1;
253 }
254 }
255
256 return 0;
257}
258
259################################################################################
260# Macros used by content generators to render common idioms
261################################################################################
262
263# pathMacro(HASHREF, LIST) - helper macro for <!--#path--> escape: the hash
264# reference contains the "style", "image", and "text" arguments to the escape.
265# The LIST consists of ordered key-value pairs of the form:
266#
267# "Page Name" => URL
268#
269# If the page should not have a link associated with it, the URL should be left
270# empty. Authentication data is added to the URL so you don't have to. A fully-
271# formed path line is returned, suitable for returning by a function
272# implementing the #path escape.
273#
274sub pathMacro {
275 my $self = shift;
276 my %args = %{ shift() };
277 my @path = @_;
278 my $sep;
279 if ($args{style} eq "image") {
280 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}});
281 } else {
282 $sep = $args{text};
283 }
284 my $auth = $self->url_authen_args;
285 my @result;
286 while (@path) {
287 my $name = shift @path;
288 my $url = shift @path;
289 push @result, $url
290 ? CGI::a({-href=>"$url?$auth"}, $name)
291 : $name;
292 }
293 return join($sep, @result) . "\n";
294}
295
296sub siblingsMacro {
297 my $self = shift;
298 my @siblings = @_;
299 my $sep = CGI::br();
300 my $auth = $self->url_authen_args;
301 my @result;
302 while (@siblings) {
303 my $name = shift @siblings;
304 my $url = shift @siblings;
305 push @result, $url
306 ? CGI::a({-href=>"$url?$auth"}, $name)
307 : $name;
308 }
309 return join($sep, @result), "\n";
310}
311
312sub navMacro {
313 my $self = shift;
314 my %args = %{ shift() };
315 my $tail = shift;
316 my @links = @_;
317 my $auth = $self->url_authen_args;
318 my $ce = $self->{ce};
319 my $prefix = $ce->{webworkURLs}->{htdocs}."/images";
320 my @result;
321 while (@links) {
322 my $name = shift @links;
323 my $url = shift @links;
324 my $img = shift @links;
325 my $html =
326 ($img && $args{style} eq "images")
327 ? CGI::img(
328 {src=>($prefix."/".$img.$args{imagesuffix}),
329 border=>"",
330 alt=>"$name"})
331 : $name;
332 unless($img && !$url) {
333 push @result, $url
334 ? CGI::a({-href=>"$url?$auth$tail"}, $html)
335 : $html;
336 }
337 }
338 return join($args{separator}, @result) . "\n";
339}
340
341# hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in
342# LIST (or all fields if list is empty), taking data from the current request.
343#
344sub hidden_fields($;@) {
345 my $self = shift;
346 my $r = $self->{r};
347 my @fields = @_;
348 @fields or @fields = $r->param;
349 my $courseEnvironment = $self->{ce};
350 my $html = "";
351
352 foreach my $param (@fields) {
353 my $value = $r->param($param);
354 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"});
355 }
356 return $html;
357}
358
359# hidden_authen_fields() - use hidden_fields to return hidden <INPUT> tags for
360# request fields used in authentication.
361#
362sub hidden_authen_fields($) {
363 my $self = shift;
364 return $self->hidden_fields("user","effectiveUser","key");
365}
366
367# url_args(LIST) - return a URL query string (without the leading `?')
368# containing values for each field mentioned in LIST, or all fields if list is
369# empty. Data is taken from the current request.
370#
371sub url_args($;@) {
372 my $self = shift;
373 my $r = $self->{r};
374 my @fields = @_;
375 @fields or @fields = $r->param; # If no fields are passed in, do them all.
376 my $courseEnvironment = $self->{ce};
377
378 my @pairs;
379 foreach my $param (@fields) {
380 my @values = $r->param($param);
381 foreach my $value (@values) {
382 push @pairs, uri_escape($param) . "=" . uri_escape($value);
383 }
384 }
385
386 return join("&", @pairs);
387}
388
389# url_authen_args() - use url_args to return a URL query string for request
390# fields used in authentication.
391#
392sub url_authen_args($) {
393 my $self = shift;
394 my $r = $self->{r};
395 return $self->url_args("user","effectiveUser","key");
396}
397
398# print_form_data(BEGIN, MIDDLE, END, OMIT) - return a string containing request
399# fields not matched by OMIT, placing BEGIN before each field name, MIDDLE
400# between each field and its value, and END after each value. Values are taken
401# from the current request. OMIT is a quoted reguar expression.
402#
31sub print_form_data { 403sub print_form_data {
32 my ($self, $begin, $middle, $end, $qr_omit) = @_; 404 my ($self, $begin, $middle, $end, $qr_omit) = @_;
33 my $return_string = ""; 405 my $return_string = "";
34
35 $r=$self->{r}; 406 my $r=$self->{r};
36 my @form_data = $r->param; 407 my @form_data = $r->param;
37 foreach my $name (@form_data) { 408 foreach my $name (@form_data) {
38 next if ($qr_omit and $name =~ /$qr_omit/); 409 next if ($qr_omit and $name =~ /$qr_omit/);
39 my @values = $r->param($name); 410 my @values = $r->param($name);
411 foreach my $variable (qw(begin name middle value end)) {
412 no strict 'refs';
413 ${$variable} = "" unless defined ${$variable};
414 }
40 foreach my $value (@values) { 415 foreach my $value (@values) {
41 $return_string .= "$begin$name$middle$value$end"; 416 $return_string .= "$begin$name$middle$value$end";
42 } 417 }
43 } 418 }
44
45 return $return_string; 419 return $return_string;
46} 420}
47 421
48sub hidden_authen_fields { 422sub errorOutput($$$) {
423 my ($self, $error, $details) = @_;
424 return
425 CGI::h3("Software Error"),
426 CGI::p(<<EOF),
427WeBWorK has encountered a software error while attempting to process this
428problem. It is likely that there is an error in the problem itself. If you are
429a student, contact your professor to have the error corrected. If you are a
430professor, please consut the error output below for more informaiton.
431EOF
432 CGI::h3("Error messages"), CGI::p(CGI::tt($error)),
433 CGI::h3("Error context"), CGI::p(CGI::tt($details));
434}
435
436sub warningOutput($$) {
437 my ($self, $warnings) = @_;
438
439 my @warnings = split m/\n+/, $warnings;
440
441 return
442 CGI::h3("Software Warnings"),
443 CGI::p(<<EOF),
444WeBWorK has encountered warnings while attempting to process this problem. It
445is likely that this indicates an error or ambiguity in the problem itself. If
446you are a student, contact your professor to have the problem corrected. If you
447are a professor, please consut the warning output below for more informaiton.
448EOF
449 CGI::h3("Warning messages"),
450 CGI::ul(CGI::li(\@warnings)),
451 ;
452}
453
454################################################################################
455# Generic versions of template escapes
456################################################################################
457
458# Reminder: here are the template functions currently defined:
459# FIXME: this list is out of date!!!!!!!!
460#
461# head
462# path
463# style = text|image
464# image = URL of image
465# text = text separator
466# loginstatus
467# links
468# siblings
469# nav
470# style = text|image
471# imageprefix = prefix to image URL
472# imagesuffix = suffix to image URL
473# separator = HTML to place in between links
474# title
475# body
476
477sub header {
49 my $self = shift; 478 my $self = shift;
50 my $r = $self->{r}; 479 my $r = $self->{r};
51 my $courseEnvironment = $self->{courseEnvironment};
52 my $html = "";
53 480
54 foreach $param ("user","key") { 481 if ($self->{sendFile}) {
55 my $value = $r->param($param); 482 my $contentType = $self->{sendFile}->{type};
56 $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 483 my $fileName = $self->{sendFile}->{name};
57 } 484 $r->content_type($contentType);
58 return $html; 485 $r->header_out("Content-Disposition" => "attachment; filename=\"$fileName\"");
59} 486 } else {
60
61sub pre_header_initialize {}
62
63sub header {
64 my $self = shift;
65 my $r=$self->{r};
66 $r->content_type('text/html'); 487 $r->content_type("text/html");
488
489 }
490
67 $r->send_http_header(); 491 $r->send_http_header();
492 return OK;
68} 493}
69 494
70sub initialize {} 495sub loginstatus {
71
72sub title {
73 return "Superclass";
74}
75
76sub body {
77 print "Generated content";
78 "";
79}
80
81sub logo {
82 my $self = shift;
83 return $self->{courseEnvironment}->{urls}->{logo};
84}
85
86sub htdocs_base {
87 my $self = shift;
88 return $self->{courseEnvironment}->{urls}->{base};
89}
90
91sub go {
92 my $self = shift; 496 my $self = shift;
93 my $r = $self->{r}; 497 my $r = $self->{r};
94 my $courseEnvironment = $self->{courseEnvironment}; 498 my $ce = $self->{ce};
95
96 $self->pre_header_initialize(@_);
97 $self->header(@_); return OK if $r->header_only;
98 $self->initialize(@_);
99 499
100 my $templateFile = $courseEnvironment->{templates}->{system}; 500 my $user = $r->param("user");
501 my $eUser = $r->param("effectiveUser");
502 my $key = $r->param("key");
101 503
102 open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 504 return "" unless $key;
103 my @template = <TEMPLATE>;
104 close TEMPLATE;
105 505
106 foreach my $line (@template) { 506 my $exitURL = $r->uri() . "?user=$user&key=$key";
107 # This is incremental regex processing. 507
108 # the /c is so that pos($line) doesn't die when the regex fails. 508 my $root = $ce->{webworkURLs}->{root};
109 while ($line =~ m/\G(.*?)<!--#(.*?)\s*-->/gc) { 509 my $courseID = $ce->{courseName};
110 print "$1"; 510 my $logout = "$root/$courseID/logout/?" . $self->url_authen_args();
111 print $self->$2(@_) if $self->can($2); 511
512 print CGI::small("User:", "$user");
513
514 if ($user ne $eUser) {
515 print CGI::br(), CGI::font({-color=>'red'},
516 CGI::small("Acting as:", "$eUser")
517 ),
518 CGI::br(), CGI::a({-href=>$exitURL},
519 CGI::small("Stop Acting")
520 );
112 } 521 }
113 # I thought I could use pos($line) here, but /noooooo/
114 print substr $line, pos($line);
115 }
116 522
523 print CGI::br(), CGI::a({-href=>$logout}, CGI::small("Log Out"));
524
117 return OK; 525 return "";
526}
527
528# FIXME: drunk code. rewrite.
529# also, this should be structured s.t. subclasses can add items to the links
530# area, i.e. "stacking"
531sub links {
532 my $self = shift;
533 my @components = @_;
534 my $ce = $self->{ce};
535 my $db = $self->{db};
536 my $userName = $self->{r}->param("user");
537 my $courseName = $ce->{courseName};
538 my $root = $ce->{webworkURLs}->{root};
539
540 #my $Key = $db->getKey($userName); # checked
541 #my $key = (defiend $key
542 # ? $Key->key()
543 # : "");
544 #
545 #return "" unless defined $key;
546 # This has been replaced by using "#if loggedin" in ur.template.
547
548 # URLs to parts of the system
549 my $probSets = "$root/$courseName/?" . $self->url_authen_args();
550 my $prefs = "$root/$courseName/options/?" . $self->url_authen_args();
551 my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args();
552 my $logout = "$root/$courseName/logout/?" . $self->url_authen_args();
553
554 my $PermissionLevel = $db->getPermissionLevel($userName); # checked
555 my $permLevel = (defined $PermissionLevel
556 ? $PermissionLevel->permission()
557 : 0);
558
559 return join("",
560 CGI::div( {style=>'font-size:larger'},CGI::a({-href=>$probSets}, "Problem&nbsp;Sets")
561 ),
562 CGI::a({-href=>$prefs}, "User&nbsp;Prefs"), CGI::br(),
563 CGI::a({-href=>$help,-target=>'_help_'}, "Help"), CGI::br(),
564 #CGI::a({-href=>$logout}, "Log Out"), CGI::br(),
565 ($permLevel > 0
566 ? $self->instructor_links(@components) : ""
567 ),
568 );
569}
570sub instructor_links {
571 my $self = shift;
572 my @components = @_;
573 my $args = pop(@components); # get hash of option arguments
574 my $courseName = $self->{ce}->{courseName};
575 my $root = $self->{ce}->{webworkURLs}->{root};
576 my $userName = $self->{r}->param("effectiveUser");
577 $userName = $self->{r}->param("user") unless defined $userName;
578 my ($set, $prob) = @components;
579 my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args();
580 my $sets = "$root/$courseName/instructor/sets/?" . $self->url_authen_args();
581 my $users = "$root/$courseName/instructor/users/?" . $self->url_authen_args();
582 my $email = "$root/$courseName/instructor/send_mail/?" . $self->url_authen_args();
583 my $scoring = "$root/$courseName/instructor/scoring/?" . $self->url_authen_args();
584 my $statsRoot = "$root/$courseName/instructor/stats";
585 my $stats = $statsRoot. '/?'.$self->url_authen_args();
586 my $fileXfer = "$root/$courseName/instructor/files/?" . $self->url_authen_args();
587
588
589 # Add direct links to sets e.g. 3:4 for set3 problem 4
590 my $setURL = (defined $set)
591 ? "$root/$courseName/instructor/sets/$set/?" . $self->url_authen_args()
592 : '';
593 my $probURL = (defined $set && defined $prob)
594 ? "$root/$courseName/instructor/pgProblemEditor/$set/$prob?" . $self->url_authen_args()
595 : '';
596
597 my ($setLink, $problemLink) = ("", "");
598 if ($setURL) {
599 $setLink = "&nbsp;&nbsp;&nbsp;&nbsp;"
600 . CGI::a({-href=>$setURL}, "Set&nbsp;$set")
601 . CGI::br();
602 if ($probURL) {
603 $problemLink = "&nbsp;&nbsp;&nbsp;&nbsp;"
604 . CGI::a({-href=>$probURL}, "Problem&nbsp;$prob")
605 . CGI::br();
606 }
607 }
608
609 #my $setProb = ($setURL)
610 # ? CGI::a({-href=>$setURL}, $set)
611 # : '';
612 #$setProb .= ':' . CGI::a({-href=>$probURL},$prob) if $setProb && $probURL;
613
614 return join("",
615 CGI::hr(),
616 CGI::div( {style=>'font-size:larger'},
617 CGI::a({-href=>$instructor}, "Instructor&nbsp;Tools")
618 ),
619 '&nbsp;&nbsp;&nbsp;',CGI::a({-href=>$users}, "User&nbsp;List"), CGI::br(),
620 '&nbsp;&nbsp;&nbsp;',CGI::a({-href=>$sets}, "Set&nbsp;List"), CGI::br(),
621 $setLink,
622 $problemLink,
623 '&nbsp;&nbsp;&nbsp;',CGI::a({-href=>$email}, "Mail&nbsp;Merge"), CGI::br(),
624 '&nbsp;&nbsp;&nbsp;',CGI::a({-href=>$scoring}, "Scoring"), CGI::br(),
625 '&nbsp;&nbsp;&nbsp;',CGI::a({-href=>$stats}, "Statistics"), CGI::br(),
626 (defined($set))
627 ? '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.CGI::a({-href=>"$statsRoot/set/$set/?".$self->url_authen_args}, "$set").CGI::br()
628 : '',
629 (defined($userName))
630 ? '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.CGI::a({-href=>"$statsRoot/student/$userName/?".$self->url_authen_args}, "$userName").CGI::br()
631 : '',
632 '&nbsp;&nbsp;&nbsp;',CGI::a({-href=>$fileXfer}, "File&nbsp;Transfer"), CGI::br(),
633 );
634}
635
636# &if_can will return 1 if the current object->can("do $_[1]")
637sub if_can ($$) {
638 my ($self, $arg) = (@_);
639
640 if ($self->can("$arg")) {
641 return 1;
642 } else {
643 return 0;
644 }
645}
646
647# Every content generator is logged in unless it says otherwise.
648sub if_loggedin($$) {
649 my ($self, $arg) = (@_);
650
651 return $arg;
652}
653
654# Handling of errors in submissions
655
656sub if_submiterror($$) {
657 my ($self, $arg) = @_;
658 if (exists $self->{submitError}) {
659 return $arg;
660 } else {
661 return !$arg;
662 }
663}
664
665sub submiterror {
666 my ($self) = @_;
667 if (exists $self->{submitError}) {
668 return $self->{submitError};
669 } else {
670 return "";
671 }
672}
673
674# General warning handling
675
676sub if_warnings($$) {
677 my ($self, $arg) = @_;
678 return $self->{r}->notes("warnings") ? $arg : !$arg;
679}
680
681sub warnings {
682 my ($self) = @_;
683 my $r = $self->{r};
684 if ($r->notes("warnings")) {
685 return $self->warningOutput($r->notes("warnings"));
686 } else {
687 return "";
688 }
118} 689}
119 690
1201; 6911;
692
693__END__
694
695=head1 AUTHOR
696
697Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu
698and Sam Hathaway, sh002i (at) math.rochester.edu.
699
700=cut
Legend:
Removed from v.353  
changed lines
  Added in v.1741
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9