Parent Directory
| 
Revision Log
Removed the Professor content generator and link. Made a little progress on ProblemSetList. -Dennis
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::ContentGenerator; 7 8 =head1 NAME 9 10 WeBWorK::ContentGenerator - base class for modules that generate page content. 11 12 =cut 13 14 use strict; 15 use warnings; 16 use Apache::Constants qw(:common); 17 use CGI qw(); 18 use URI::Escape; 19 use WeBWorK::DB; 20 use WeBWorK::Utils qw(readFile); 21 22 ################################################################################ 23 # This is a very unruly file, so I'm going to use very large comments to divide 24 # it into logical sections. 25 ################################################################################ 26 27 # new(Apache::Request, WeBWorK::CourseEnvironment) - create a new instance of a 28 # content generator. Usually only called by the dispatcher, although one might 29 # be able to use it for things like "sub-requests". Uh... uh... I have to think 30 # about that one. The dispatcher uses this idiom: 31 # 32 # WeBWorK::ContentGenerator::WHATEVER->new($r, $ce)->go(@whatever); 33 # 34 # and throws away the result ;) 35 # 36 sub new($$$$) { 37 my ($invocant, $r, $ce, $db) = @_; 38 my $class = ref($invocant) || $invocant; 39 my $self = { 40 r => $r, 41 ce => $ce, 42 db => $db, 43 }; 44 bless $self, $class; 45 return $self; 46 } 47 48 ################################################################################ 49 # Invocation and template processing 50 ################################################################################ 51 52 # go(@otherArguments) - render a page, using methods from the particular 53 # subclass of ContentGenerator. @otherArguments is passed to each method, so 54 # that the dispatcher can pass CG-specific data. The order of calls looks like 55 # this: 56 # 57 # * &pre_header_initialize - give subclasses a chance to do initialization 58 # necessary for generating the HTTP header. 59 # * &header - this class provides a standard HTTP header with Content-Type 60 # text/html. Subclasses are welcome to overload this for things like 61 # an image-creation content generator or a PDF generator. 62 # * &initialize - let subclasses do post-header initialization. 63 # * any "template escapes" defined in the system template and supported by 64 # the subclass. Generic implementations of &title and &body are provided. 65 # 66 sub go { 67 my $self = shift; 68 my $r = $self->{r}; 69 my $courseEnvironment = $self->{ce}; 70 71 $self->pre_header_initialize(@_) if $self->can("pre_header_initialize"); 72 $self->header(@_); 73 return OK if $r->header_only; 74 75 $self->initialize(@_) if $self->can("initialize"); 76 $self->template($courseEnvironment->{templates}->{system}, @_); 77 78 return OK; 79 } 80 81 # template(STRING, @otherArguments) - parse a template, looking for escapes of 82 # the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME 83 # (if available) for each NAME. The escapes are called like: 84 # 85 # $self->NAME(@otherArguments, \%escapeArguments) 86 # 87 # where @otherArguments originates in the dispatcher and %escapeArguments is 88 # parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR) 89 # 90 sub template { 91 my ($self, $templateFile) = (shift, shift); 92 my $r = $self->{r}; 93 my $courseEnvironment = $self->{ce}; 94 my @ifstack = (1); # Start off in printing mode 95 # say $ifstack[-1] to get the result of the last <#!--if--> 96 97 # so even though the variable $/ APPEARS to contain a newline, 98 # <TEMPLATE> is slurping the whole file into the first element of 99 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!! 100 # 101 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 102 #my @template = <TEMPLATE>; 103 #close TEMPLATE; 104 # 105 # Let's try something else instead: 106 my @template = split /\n/, readFile($templateFile); 107 108 foreach my $line (@template) { 109 # This is incremental regex processing. 110 # the /c is so that pos($line) doesn't die when the regex fails. 111 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 112 my ($before, $function, $raw_args) = ($1, $2, $3); 113 my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : (); 114 115 if ($ifstack[-1]) { 116 print $before; 117 } 118 119 if ($function eq "if") { 120 # a predicate can only be true if everything else on the ifstack is already true, for ANDing 121 push @ifstack, ($self->$function(@_, [@args]) && $ifstack[-1]); 122 } elsif ($function eq "else" and @ifstack > 1) { 123 $ifstack[-1] = not $ifstack[-1]; 124 } elsif ($function eq "endif" and @ifstack > 1) { 125 pop @ifstack; 126 } elsif ($ifstack[-1]) { 127 if ($self->can($function)) { 128 print $self->$function(@_, {@args}); 129 } 130 } 131 } 132 133 if ($ifstack[-1]) { 134 print substr($line, (defined pos $line) ? pos $line : 0), "\n"; 135 } 136 } 137 } 138 139 # cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns 140 # a list which pairs into key/values and fits nicely in {}s. 141 # 142 sub cook_args($) { # ... also used by bin/wwdb, so watch out 143 my ($raw_args) = @_; 144 my @args = (); 145 146 # Boy I love m//g in scalar context! Go read the camel book, heathen. 147 # First, get the whole token with the quotes on both ends... 148 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) { 149 my ($key, $value) = ($1, $2); 150 # ... then, rip out all the protecty backspaces 151 $value =~ s/\\(.)/$1/g; 152 push @args, $key => $value; 153 } 154 155 return @args; 156 } 157 158 # This is different. It probably shouldn't print anything (except in debugging cases) 159 # and it should return a boolean, not a string. &if is called in a nonstandard way 160 # by &template, with $args as an arrayref instead of a hashref. this is a hack! yay! 161 162 # OK, this is a pluggin architecture. it iterates through attributes of the "if" tag, 163 # and for each predicate $p, it calls &if_$p in an object-oriented way, continuing the 164 # grand templating theme of an object-oriented pluggable architecture using ->can($). 165 sub if { 166 my ($self, $args) = @_[0,-1]; 167 # A single if "or"s it's components. Nesting produces "and". 168 169 my @args = @$args; # Hahahahaha, get it?! 170 171 if (@args % 2 != 0) { 172 # flip out and kill people, but do not commit seppuku 173 print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n'; 174 } 175 176 while (@args > 1) { 177 my ($key, $value) = (shift @args, shift @args); 178 179 # a non-existent &if_$key is the same as a false result, but we're ORing, so it's OK 180 my $sub = "if_$key"; # perl doesn't like it when you try to construct a string right in a method invocation 181 if ($self->can("if_$key") and $self->$sub("$value")) { 182 return 1; 183 } 184 } 185 186 return 0; 187 } 188 189 ################################################################################ 190 # Macros used by content generators to render common idioms 191 ################################################################################ 192 193 # pathMacro(HASHREF, LIST) - helper macro for <!--#path--> escape: the hash 194 # reference contains the "style", "image", and "text" arguments to the escape. 195 # The LIST consists of ordered key-value pairs of the form: 196 # 197 # "Page Name" => URL 198 # 199 # If the page should not have a link associated with it, the URL should be left 200 # empty. Authentication data is added to the URL so you don't have to. A fully- 201 # formed path line is returned, suitable for returning by a function 202 # implementing the #path escape. 203 # 204 sub pathMacro { 205 my $self = shift; 206 my %args = %{ shift() }; 207 my @path = @_; 208 my $sep; 209 if ($args{style} eq "image") { 210 $sep = CGI::img({-src=>$args{image}, -alt=>$args{text}}); 211 } else { 212 $sep = $args{text}; 213 } 214 my $auth = $self->url_authen_args; 215 my @result; 216 while (@path) { 217 my $name = shift @path; 218 my $url = shift @path; 219 push @result, $url 220 ? CGI::a({-href=>"$url?$auth"}, $name) 221 : $name; 222 } 223 return join($sep, @result), "\n"; 224 } 225 226 sub siblingsMacro { 227 my $self = shift; 228 my @siblings = @_; 229 my $sep = CGI::br(); 230 my $auth = $self->url_authen_args; 231 my @result; 232 while (@siblings) { 233 my $name = shift @siblings; 234 my $url = shift @siblings; 235 push @result, $url 236 ? CGI::a({-href=>"$url?$auth"}, $name) 237 : $name; 238 } 239 return join($sep, @result), "\n"; 240 } 241 242 sub navMacro { 243 my $self = shift; 244 my %args = %{ shift() }; 245 my $tail = shift; 246 my @links = @_; 247 my $auth = $self->url_authen_args; 248 my $ce = $self->{ce}; 249 my $prefix = $ce->{webworkURLs}->{htdocs}."/images"; 250 my @result; 251 while (@links) { 252 my $name = shift @links; 253 my $url = shift @links; 254 my $img = shift @links; 255 my $html = 256 ($img && $args{style} eq "images") 257 ? CGI::img( 258 {src=>($prefix."/".$img.$args{imagesuffix}), 259 border=>"", 260 alt=>"$name"}) 261 : $name; 262 unless($img && !$url) { 263 push @result, $url 264 ? CGI::a({-href=>"$url?$auth$tail"}, $html) 265 : $html; 266 } 267 } 268 return join($args{separator}, @result), "\n"; 269 } 270 271 # hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in 272 # LIST (or all fields if list is empty), taking data from the current request. 273 # 274 sub hidden_fields($;@) { 275 my $self = shift; 276 my $r = $self->{r}; 277 my @fields = @_; 278 @fields or @fields = $r->param; 279 my $courseEnvironment = $self->{ce}; 280 my $html = ""; 281 282 foreach my $param (@fields) { 283 my $value = $r->param($param); 284 $html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 285 } 286 return $html; 287 } 288 289 # hidden_authen_fields() - use hidden_fields to return hidden <INPUT> tags for 290 # request fields used in authentication. 291 # 292 sub hidden_authen_fields($) { 293 my $self = shift; 294 return $self->hidden_fields("user","effectiveUser","key"); 295 } 296 297 # url_args(LIST) - return a URL query string (without the leading `?') 298 # containing values for each field mentioned in LIST, or all fields if list is 299 # empty. Data is taken from the current request. 300 # 301 sub url_args($;@) { 302 my $self = shift; 303 my $r = $self->{r}; 304 my @fields = @_; 305 @fields or @fields = $r->param; 306 my $courseEnvironment = $self->{ce}; 307 308 my @pairs; 309 foreach my $param (@fields) { 310 my $value = $r->param($param) || ""; 311 push @pairs, uri_escape($param) . "=" . uri_escape($value); 312 } 313 314 return join("&", @pairs); 315 } 316 317 # url_authen_args() - use url_args to return a URL query string for request 318 # fields used in authentication. 319 # 320 sub url_authen_args($) { 321 my $self = shift; 322 my $r = $self->{r}; 323 return $self->url_args("user","effectiveUser","key"); 324 } 325 326 # print_form_data(BEGIN, MIDDLE, END, OMIT) - return a string containing request 327 # fields not matched by OMIT, placing BEGIN before each field name, MIDDLE 328 # between each field and its value, and END after each value. Values are taken 329 # from the current request. OMIT is a quoted reguar expression. 330 # 331 sub print_form_data { 332 my ($self, $begin, $middle, $end, $qr_omit) = @_; 333 my $return_string = ""; 334 my $r=$self->{r}; 335 my @form_data = $r->param; 336 foreach my $name (@form_data) { 337 next if ($qr_omit and $name =~ /$qr_omit/); 338 my @values = $r->param($name); 339 foreach my $variable (qw(begin name middle value end)) { 340 no strict 'refs'; 341 ${$variable} = "" unless defined ${$variable}; 342 } 343 foreach my $value (@values) { 344 $return_string .= "$begin$name$middle$value$end"; 345 } 346 } 347 return $return_string; 348 } 349 350 sub errorOutput($$$) { 351 my ($self, $error, $details) = @_; 352 return 353 CGI::h2("Software Error"), 354 CGI::p(<<EOF), 355 WeBWorK has encountered a software error while attempting to process this problem. 356 It is likely that there is an error in the problem itself. 357 If you are a student, contact your professor to have the error corrected. 358 If you are a professor, please consut the error output below for more informaiton. 359 EOF 360 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)), 361 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details)); 362 } 363 364 sub warningOutput($$) { 365 my ($self, $warnings) = @_; 366 367 return 368 CGI::h2("Software Warnings"), 369 CGI::p(<<EOF), 370 WeBWorK has encountered warnings while attempting to process this problem. 371 It is likely that this indicates an error or ambiguity in the problem itself. 372 If you are a student, contact your professor to have the problem corrected. 373 If you are a professor, please consut the error output below for more informaiton. 374 EOF 375 CGI::h3("Warning messages"), 376 CGI::blockquote(CGI::pre($warnings)), 377 ; 378 } 379 380 ################################################################################ 381 # Generic versions of template escapes 382 ################################################################################ 383 384 # Reminder: here are the template functions currently defined: 385 # 386 # head 387 # path 388 # style = text|image 389 # image = URL of image 390 # text = text separator 391 # loginstatus 392 # links 393 # siblings 394 # nav 395 # style = text|image 396 # imageprefix = prefix to image URL 397 # imagesuffix = suffix to image URL 398 # separator = HTML to place in between links 399 # title 400 # body 401 402 sub header { 403 my $self = shift; 404 my $r = $self->{r}; 405 $r->content_type('text/html'); 406 $r->send_http_header(); 407 } 408 409 sub loginstatus { 410 my $self = shift; 411 my $r = $self->{r}; 412 my $user = $r->param("user"); 413 my $eUser = $r->param("effectiveUser"); 414 my $key = $r->param("key"); 415 return "" unless $key; 416 my $exitURL = $r->uri() . "?user=$user&key=$key"; 417 print CGI::small("User:", "$user"); 418 if ($user ne $eUser) { 419 print CGI::br(), CGI::font({-color=>'red'}, 420 CGI::small("Acting as:", "$eUser") 421 ), 422 CGI::br(), CGI::a({-href=>$exitURL}, 423 CGI::small("Stop Acting") 424 ); 425 } 426 return ""; 427 } 428 429 # *** drunk code. rewrite. 430 # also, this should be structured s.t. subclasses can add items to the links 431 # area, i.e. "stacking" 432 sub links { 433 my $self = shift; 434 my $ce = $self->{ce}; 435 my $db = $self->{db}; 436 my $userName = $self->{r}->param("user"); 437 my $courseName = $ce->{courseName}; 438 my $root = $ce->{webworkURLs}->{root}; 439 my $permLevel = $db->getPermissionLevel($userName)->permission(); 440 my $key = $db->getKey($userName)->key(); 441 return "" unless defined $key; 442 443 # URLs to parts of the system 444 my $probSets = "$root/$courseName/?" . $self->url_authen_args(); 445 my $prefs = "$root/$courseName/options/?" . $self->url_authen_args(); 446 my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args(); 447 my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args(); 448 my $logout = "$root/$courseName/logout/?" . $self->url_authen_args(); 449 450 return 451 CGI::a({-href=>$probSets}, "Problem Sets"). CGI::br(). 452 CGI::a({-href=>$prefs}, "User Options"). CGI::br(). 453 ($permLevel > 0 454 ? CGI::a({-href=>$instructor}, "Instructor") . CGI::br() 455 : ""). 456 CGI::a({-href=>$help}, "Help"). CGI::br(). 457 CGI::a({-href=>$logout}, "Log Out"). CGI::br() 458 ; 459 } 460 461 # &if_can will return 1 if the current object->can("do $_[1]") 462 sub if_can ($$) { 463 my ($self, $arg) = (@_); 464 465 if ($self->can("$arg")) { 466 return 1; 467 } else { 468 return 0; 469 } 470 } 471 472 # Every content generator is logged in unless it says otherwise. 473 sub if_loggedin($$) { 474 my ($self, $arg) = (@_); 475 476 return $arg; 477 } 478 479 1; 480 481 __END__ 482 483 =head1 AUTHOR 484 485 Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu 486 and Sam Hathaway, sh002i (at) math.rochester.edu. 487 488 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |