| … | |
… | |
| 14 | use strict; |
14 | use strict; |
| 15 | use warnings; |
15 | use warnings; |
| 16 | use Apache::Constants qw(:common); |
16 | use Apache::Constants qw(:common); |
| 17 | use CGI qw(); |
17 | use CGI qw(); |
| 18 | use URI::Escape; |
18 | use URI::Escape; |
|
|
19 | use WeBWorK::Utils qw(readFile); |
| 19 | #use CGI::Carp qw(fatalsToBrowser); |
20 | #use CGI::Carp qw(fatalsToBrowser); |
| 20 | |
21 | |
| 21 | ################################################################################ |
22 | ################################################################################ |
| 22 | # This is a very unruly file, so I'm going to use very large comments to divide |
23 | # This is a very unruly file, so I'm going to use very large comments to divide |
| 23 | # it into logical sections. |
24 | # it into logical sections. |
| … | |
… | |
| 87 | sub template { |
88 | sub template { |
| 88 | my ($self, $templateFile) = (shift, shift); |
89 | my ($self, $templateFile) = (shift, shift); |
| 89 | my $r = $self->{r}; |
90 | my $r = $self->{r}; |
| 90 | my $courseEnvironment = $self->{courseEnvironment}; |
91 | my $courseEnvironment = $self->{courseEnvironment}; |
| 91 | |
92 | |
|
|
93 | # so even though the variable $/ APPEARS to contain a newline, |
|
|
94 | # <TEMPLATE> is slurping the whole file into the first element of |
|
|
95 | # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!! |
|
|
96 | # |
| 92 | open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; |
97 | #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; |
| 93 | my @template = <TEMPLATE>; |
98 | #my @template = <TEMPLATE>; |
| 94 | close TEMPLATE; |
99 | #close TEMPLATE; |
|
|
100 | # |
|
|
101 | # Let's try something else instead: |
|
|
102 | |
|
|
103 | my @template = split /\n/, readFile($templateFile); |
| 95 | |
104 | |
| 96 | foreach my $line (@template) { |
105 | foreach my $line (@template) { |
|
|
106 | #warn "foo: $line\n"; |
| 97 | # This is incremental regex processing. |
107 | # This is incremental regex processing. |
| 98 | # the /c is so that pos($line) doesn't die when the regex fails. |
108 | # the /c is so that pos($line) doesn't die when the regex fails. |
| 99 | while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { |
109 | while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { |
| 100 | my ($before, $function, $raw_args) = ($1, $2, $3); |
110 | my ($before, $function, $raw_args) = ($1, $2, $3); |
| 101 | # $args here will be a hashref |
111 | # $args here will be a hashref |
| 102 | my $args = $raw_args =~ /\S/ ? cook_args($raw_args) : {}; |
112 | my $args = $raw_args =~ /\S/ ? cook_args($raw_args) : {}; |
| 103 | print $before; |
113 | print $before; |
| 104 | |
114 | |
| 105 | print $self->$function(@_, $args) if $self->can($function); |
115 | if ($self->can($function)) { |
|
|
116 | print $self->$function(@_, $args); |
|
|
117 | } |
| 106 | } |
118 | } |
| 107 | |
119 | |
| 108 | print substr $line, (defined(pos($line)) ? pos($line) : 0); |
120 | print substr $line, (defined(pos($line)) ? pos($line) : 0); |
| 109 | } |
121 | } |
| 110 | } |
122 | } |
| … | |
… | |
| 312 | my $root = $ce->{webworkURLs}->{root}; |
324 | my $root = $ce->{webworkURLs}->{root}; |
| 313 | my $courseName = $ce->{courseName}; |
325 | my $courseName = $ce->{courseName}; |
| 314 | my $probSets = "$root/$courseName/?" . $self->url_authen_args(); |
326 | my $probSets = "$root/$courseName/?" . $self->url_authen_args(); |
| 315 | # my $prefs = "$root/prefs/?" . $self->url_authen_args(); |
327 | # my $prefs = "$root/prefs/?" . $self->url_authen_args(); |
| 316 | # my $help = $ce->{webworkURLs}->{docs} . "?" . $self->url_authen_args(); |
328 | # my $help = $ce->{webworkURLs}->{docs} . "?" . $self->url_authen_args(); |
| 317 | return CGI::p( |
329 | my $logout = "$root/$courseName/"; |
|
|
330 | return |
| 318 | CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(), |
331 | CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(), |
| 319 | # CGI::a({-href=>$prefs}, "User Options"), CGI::br(), |
332 | # CGI::a({-href=>$prefs}, "User Options"), CGI::br(), |
| 320 | # CGI::a({-href=>$help}, "Help"), CGI::br(), |
333 | # CGI::a({-href=>$help}, "Help"), CGI::br(), |
|
|
334 | CGI::a({-href=>$logout}, "Log Out"), CGI::br(), |
| 321 | ); |
335 | ; |
| 322 | } |
336 | } |
| 323 | |
337 | |
| 324 | sub title { |
338 | sub title { |
| 325 | return "WeBWorK"; |
339 | return "WeBWorK"; |
| 326 | } |
340 | } |