| … | |
… | |
| 18 | bless $self, $class; |
18 | bless $self, $class; |
| 19 | return $self; |
19 | return $self; |
| 20 | } |
20 | } |
| 21 | |
21 | |
| 22 | |
22 | |
| 23 | # This generates the template code (eventually using a secondary storage |
|
|
| 24 | # data source, I hope) for the common elements of all WeBWorK pages. |
|
|
| 25 | # Arguments are substitutions for data points within the template. |
|
|
| 26 | sub top { |
|
|
| 27 | my ( |
|
|
| 28 | $self, # invocant |
|
|
| 29 | $title, # Page title |
|
|
| 30 | ) = @_; |
|
|
| 31 | |
|
|
| 32 | my $r = $self->{r}; |
|
|
| 33 | |
|
|
| 34 | print start_html("WeBWorK - $title"); |
|
|
| 35 | |
|
|
| 36 | print h1("WeBWorK $title"); |
|
|
| 37 | } |
|
|
| 38 | |
|
|
| 39 | # This generates the "bottom" of pages. It'll probably be mostly for |
|
|
| 40 | # closing <body> and stuff like that. |
|
|
| 41 | sub bottom { |
|
|
| 42 | my $self = @_; |
|
|
| 43 | print end_html(); |
|
|
| 44 | } |
|
|
| 45 | |
|
|
| 46 | |
|
|
| 47 | # This is a quick and dirty function to print out all (or almost all) of the |
23 | # This is a quick and dirty function to print out all (or almost all) of the |
| 48 | # fields in a form in a specified format. As you can see from the print |
24 | # fields in a form in a specified format. As you can see from the print |
| 49 | # statement, it just prints out $begining$name$middle$value$end for every |
25 | # statement, it just prints out $begining$name$middle$value$end for every |
| 50 | # field who's name doesn't match $qr_omit, a quoted regex. |
26 | # field who's name doesn't match $qr_omit, a quoted regex. |
| 51 | # In it's current incarnation, it should be called from subclasses only, |
27 | # In it's current incarnation, it should be called from subclasses only, |
| 52 | # by saying $self->print_form_data. Of course, you could construct a |
28 | # by saying $self->print_form_data. Of course, you could construct a |
| 53 | # hashref with ->{r} being an Apache::Request, I suppose. |
29 | # hashref with ->{r} being an Apache::Request, I suppose. |
| 54 | |
30 | |
| 55 | sub print_form_data { |
31 | sub print_form_data { |
| 56 | my ($self, $begin, $middle, $end, $qr_omit) = @_; |
32 | my ($self, $begin, $middle, $end, $qr_omit) = @_; |
|
|
33 | my $return_string = ""; |
| 57 | |
34 | |
| 58 | $r=$self->{r}; |
35 | $r=$self->{r}; |
| 59 | my @form_data = $r->param; |
36 | my @form_data = $r->param; |
| 60 | foreach my $name (@form_data) { |
37 | foreach my $name (@form_data) { |
| 61 | next if ($qr_omit and $name =~ /$qr_omit/); |
38 | next if ($qr_omit and $name =~ /$qr_omit/); |
| 62 | my @values = $r->param($name); |
39 | my @values = $r->param($name); |
| 63 | foreach my $value (@values) { |
40 | foreach my $value (@values) { |
| 64 | print $begin, $name, $middle, $value, $end; |
41 | $return_string .= "$begin$name$middle$value$end"; |
| 65 | } |
42 | } |
| 66 | } |
43 | } |
|
|
44 | |
|
|
45 | return $return_string; |
| 67 | } |
46 | } |
| 68 | |
47 | |
| 69 | sub hidden_authen_fields { |
48 | sub hidden_authen_fields { |
| 70 | my $self = shift; |
49 | my $self = shift; |
| 71 | my $r = $self->{r}; |
50 | my $r = $self->{r}; |
| … | |
… | |
| 89 | } |
68 | } |
| 90 | |
69 | |
| 91 | sub initialize {} |
70 | sub initialize {} |
| 92 | |
71 | |
| 93 | sub title { |
72 | sub title { |
| 94 | print "Superclass"; |
73 | return "Superclass"; |
| 95 | } |
74 | } |
| 96 | |
75 | |
| 97 | sub body { |
76 | sub body { |
| 98 | print "Generated content"; |
77 | print "Generated content"; |
|
|
78 | ""; |
|
|
79 | } |
|
|
80 | |
|
|
81 | sub logo { |
|
|
82 | my $self = shift; |
|
|
83 | return $self->{courseEnvironment}->{urls}->{logo}; |
|
|
84 | } |
|
|
85 | |
|
|
86 | sub htdocs_base { |
|
|
87 | my $self = shift; |
|
|
88 | return $self->{courseEnvironment}->{urls}->{base}; |
| 99 | } |
89 | } |
| 100 | |
90 | |
| 101 | sub go { |
91 | sub go { |
| 102 | my $self = shift; |
92 | my $self = shift; |
| 103 | my $r = $self->{r}; |
93 | my $r = $self->{r}; |
| … | |
… | |
| 112 | open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; |
102 | open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; |
| 113 | my @template = <TEMPLATE>; |
103 | my @template = <TEMPLATE>; |
| 114 | close TEMPLATE; |
104 | close TEMPLATE; |
| 115 | |
105 | |
| 116 | foreach my $line (@template) { |
106 | foreach my $line (@template) { |
| 117 | my $pos = 0; |
107 | # This is incremental regex processing. |
| 118 | |
108 | # the /c is so that pos($line) doesn't die when the regex fails. |
| 119 | while ($line =~ m/\G(.*?)<!--#(.*?)\s*-->/g) { |
109 | while ($line =~ m/\G(.*?)<!--#(.*?)\s*-->/gc) { |
| 120 | print "$1"; |
110 | print "$1"; |
| 121 | $pos = pos($line); |
|
|
| 122 | print $self->$2(@_) if $self->can($2); |
111 | print $self->$2(@_) if $self->can($2); |
| 123 | } |
112 | } |
| 124 | # I thought I could use pos($line) here, but /noooooo/ |
113 | # I thought I could use pos($line) here, but /noooooo/ |
| 125 | print substr $line, $pos; |
114 | print substr $line, pos($line); |
| 126 | } |
115 | } |
| 127 | |
116 | |
| 128 | return OK; |
117 | return OK; |
| 129 | } |
118 | } |
| 130 | |
119 | |
Parent Directory
| 
Revision Log
| 
Patch