Parent Directory
|
Revision Log
Revision 323 - (view) (download) (as text)
| 1 : | malsyned | 313 | package WeBWorK::ContentGenerator; |
| 2 : | malsyned | 305 | |
| 3 : | malsyned | 323 | use CGI qw(-compile :html :form); |
| 4 : | use Apache::Constants qw(:common); | ||
| 5 : | |||
| 6 : | malsyned | 313 | # This is a superclass for Apache::WeBWorK's content generators. |
| 7 : | # You are /definitely/ encouraged to read this file, since there are | ||
| 8 : | # "abstract" functions here which show aproximately what form you would | ||
| 9 : | # want over-ridden sub-classes to follow. go() is a particularly pertinent | ||
| 10 : | # example. | ||
| 11 : | |||
| 12 : | malsyned | 305 | # new(Apache::Request, WeBWorK::CourseEnvironment) |
| 13 : | sub new($$$) { | ||
| 14 : | malsyned | 323 | my $invocant = shift; |
| 15 : | my $class = ref($invocant) || $invocant; | ||
| 16 : | malsyned | 305 | my $self = {}; |
| 17 : | ($self->{r}, $self->{courseEnvironment}) = @_; | ||
| 18 : | bless $self, $class; | ||
| 19 : | return $self; | ||
| 20 : | } | ||
| 21 : | |||
| 22 : | malsyned | 323 | # Call this if you want the standard HTML headers, as specified in the |
| 23 : | # template. A common call to this would be: | ||
| 24 : | # $self->headers; return OK if $r->headers_only; | ||
| 25 : | sub header { | ||
| 26 : | my $self = shift; | ||
| 27 : | my $r=$self->{r}; | ||
| 28 : | $r->content_type('text/html'); | ||
| 29 : | $r->send_http_header(); | ||
| 30 : | } | ||
| 31 : | |||
| 32 : | # This generates the template code (eventually using a secondary storage | ||
| 33 : | # data source, I hope) for the common elements of all WeBWorK pages. | ||
| 34 : | # Arguments are substitutions for data points within the template. | ||
| 35 : | sub top { | ||
| 36 : | my ( | ||
| 37 : | $self, # invocant | ||
| 38 : | $title, # Page title | ||
| 39 : | ) = @_; | ||
| 40 : | |||
| 41 : | my $r = $self->{r}; | ||
| 42 : | |||
| 43 : | print start_html("WeBWorK - $title"); | ||
| 44 : | |||
| 45 : | print h1("WeBWorK $title"); | ||
| 46 : | } | ||
| 47 : | |||
| 48 : | # This generates the "bottom" of pages. It'll probably be mostly for | ||
| 49 : | # closing <body> and stuff like that. | ||
| 50 : | sub bottom { | ||
| 51 : | my $self = @_; | ||
| 52 : | print end_html(); | ||
| 53 : | } | ||
| 54 : | |||
| 55 : | |||
| 56 : | malsyned | 313 | # This is a quick and dirty function to print out all (or almost all) of the |
| 57 : | # fields in a form in a specified format. As you can see from the print | ||
| 58 : | # statement, it just prints out $begining$name$middle$value$end for every | ||
| 59 : | # field who's name doesn't match $qr_omit, a quoted regex. | ||
| 60 : | # In it's current incarnation, it should be called from subclasses only, | ||
| 61 : | # by saying $self->print_form_data. Of course, you could construct a | ||
| 62 : | # hashref with ->{r} being an Apache::Request, I suppose. | ||
| 63 : | malsyned | 305 | |
| 64 : | malsyned | 313 | sub print_form_data { |
| 65 : | my ($self, $begin, $middle, $end, $qr_omit) = @_; | ||
| 66 : | |||
| 67 : | $r=$self->{r}; | ||
| 68 : | my @form_data = $r->param; | ||
| 69 : | foreach my $name (@form_data) { | ||
| 70 : | next if ($qr_omit and $name =~ /$qr_omit/); | ||
| 71 : | my @values = $r->param($name); | ||
| 72 : | foreach my $value (@values) { | ||
| 73 : | print $begin, $name, $middle, $value, $end; | ||
| 74 : | } | ||
| 75 : | } | ||
| 76 : | } | ||
| 77 : | |||
| 78 : | malsyned | 323 | sub hidden_authen_fields { |
| 79 : | my $self = shift; | ||
| 80 : | my $r = $self->{r}; | ||
| 81 : | my $courseEnvironment = $self->{courseEnvironment}; | ||
| 82 : | my $html = ""; | ||
| 83 : | |||
| 84 : | foreach $param ("user","key") { | ||
| 85 : | my $value = $r->param($param); | ||
| 86 : | $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); | ||
| 87 : | } | ||
| 88 : | return $html; | ||
| 89 : | } | ||
| 90 : | |||
| 91 : | malsyned | 313 | # Abstract as they get, this go() is meant to be over-ridden by |
| 92 : | # absolutely /anything/ that subclasses it. Most subclasses, however, | ||
| 93 : | # will find it a useful thing to copy and modify, rather than writing from | ||
| 94 : | # scratch. | ||
| 95 : | |||
| 96 : | sub go() { | ||
| 97 : | malsyned | 305 | my $self = shift; |
| 98 : | malsyned | 323 | my $r = $self->{r}; |
| 99 : | my $courseEnvironment = $self->{courseEnvironment}; | ||
| 100 : | |||
| 101 : | $self->header; return OK if $r->header_only; | ||
| 102 : | malsyned | 305 | |
| 103 : | malsyned | 313 | print "You shouldn't see this. This is only a prototype."; |
| 104 : | } | ||
| 105 : | |||
| 106 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |