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