| 1 | package WeBWorK::ContentGenerator; |
1 | package WeBWorK::ContentGenerator; |
|
|
2 | |
|
|
3 | use CGI qw(-compile :html :form); |
|
|
4 | use Apache::Constants qw(:common); |
| 2 | |
5 | |
| 3 | # This is a superclass for Apache::WeBWorK's content generators. |
6 | # This is a superclass for Apache::WeBWorK's content generators. |
| 4 | # You are /definitely/ encouraged to read this file, since there are |
7 | # You are /definitely/ encouraged to read this file, since there are |
| 5 | # "abstract" functions here which show aproximately what form you would |
8 | # "abstract" functions here which show aproximately what form you would |
| 6 | # want over-ridden sub-classes to follow. go() is a particularly pertinent |
9 | # want over-ridden sub-classes to follow. go() is a particularly pertinent |
| 7 | # example. |
10 | # example. |
| 8 | |
11 | |
| 9 | # new(Apache::Request, WeBWorK::CourseEnvironment) |
12 | # new(Apache::Request, WeBWorK::CourseEnvironment) |
| 10 | sub new($$$) { |
13 | sub new($$$) { |
| 11 | my $proto = shift; |
14 | my $invocant = shift; |
| 12 | my $class = ref($proto) || $proto; |
15 | my $class = ref($invocant) || $invocant; |
| 13 | my $self = {}; |
16 | my $self = {}; |
| 14 | ($self->{r}, $self->{courseEnvironment}) = @_; |
17 | ($self->{r}, $self->{courseEnvironment}) = @_; |
| 15 | bless $self, $class; |
18 | bless $self, $class; |
| 16 | return $self; |
19 | return $self; |
| 17 | } |
20 | } |
|
|
21 | |
|
|
22 | # 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 | |
| 18 | |
55 | |
| 19 | # This is a quick and dirty function to print out all (or almost all) of the |
56 | # This is a quick and dirty function to print out all (or almost all) of the |
| 20 | # fields in a form in a specified format. As you can see from the print |
57 | # fields in a form in a specified format. As you can see from the print |
| 21 | # statement, it just prints out $begining$name$middle$value$end for every |
58 | # statement, it just prints out $begining$name$middle$value$end for every |
| 22 | # field who's name doesn't match $qr_omit, a quoted regex. |
59 | # field who's name doesn't match $qr_omit, a quoted regex. |
| … | |
… | |
| 36 | print $begin, $name, $middle, $value, $end; |
73 | print $begin, $name, $middle, $value, $end; |
| 37 | } |
74 | } |
| 38 | } |
75 | } |
| 39 | } |
76 | } |
| 40 | |
77 | |
|
|
78 | 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 | |
| 41 | # Abstract as they get, this go() is meant to be over-ridden by |
91 | # Abstract as they get, this go() is meant to be over-ridden by |
| 42 | # absolutely /anything/ that subclasses it. Most subclasses, however, |
92 | # absolutely /anything/ that subclasses it. Most subclasses, however, |
| 43 | # will find it a useful thing to copy and modify, rather than writing from |
93 | # will find it a useful thing to copy and modify, rather than writing from |
| 44 | # scratch. |
94 | # scratch. |
| 45 | |
95 | |
| 46 | sub go() { |
96 | sub go() { |
| 47 | my $self = shift; |
97 | my $self = shift; |
| 48 | $r = shift; |
98 | my $r = $self->{r}; |
| 49 | $r->content_type($ct); |
99 | my $courseEnvironment = $self->{courseEnvironment}; |
| 50 | foreach $key (keys %headers) { |
100 | |
| 51 | $r->header_out($key, $headers{$key}); |
|
|
| 52 | } |
|
|
| 53 | $r->send_http_header; |
|
|
| 54 | |
|
|
| 55 | return OK if $r->header_only; |
101 | $self->header; return OK if $r->header_only; |
| 56 | |
102 | |
| 57 | print "You shouldn't see this. This is only a prototype."; |
103 | print "You shouldn't see this. This is only a prototype."; |
| 58 | } |
104 | } |
| 59 | |
105 | |
| 60 | 1; |
106 | 1; |
Parent Directory
| 
Revision Log
| 
Patch