[system] / trunk / webwork-modperl / lib / WeBWorK / ContentGenerator.pm Repository:
ViewVC logotype

Diff of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 511 Revision 512
… …
87# 87#
88sub template { 88sub template {
89 my ($self, $templateFile) = (shift, shift); 89 my ($self, $templateFile) = (shift, shift);
90 my $r = $self->{r}; 90 my $r = $self->{r};
91 my $courseEnvironment = $self->{courseEnvironment}; 91 my $courseEnvironment = $self->{courseEnvironment};
92 my @ifstack = (1); # Start off in printing mode
93 # say $ifstack[-1] to get the result of the last <#!--if-->
92 94
93 # so even though the variable $/ APPEARS to contain a newline, 95 # so even though the variable $/ APPEARS to contain a newline,
94 # <TEMPLATE> is slurping the whole file into the first element of 96 # <TEMPLATE> is slurping the whole file into the first element of
95 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!! 97 # @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!!
96 # 98 #
97 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 99 #open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
98 #my @template = <TEMPLATE>; 100 #my @template = <TEMPLATE>;
99 #close TEMPLATE; 101 #close TEMPLATE;
100 # 102 #
101 # Let's try something else instead: 103 # Let's try something else instead:
102 local $/="\n";
103 my @template = split /\n/, readFile($templateFile); 104 my @template = split /\n/, readFile($templateFile);
104 105
105 foreach my $line (@template) { 106 foreach my $line (@template) {
106 #warn "foo: $line\n"; 107 #warn "foo: $line\n";
107 # This is incremental regex processing. 108 # This is incremental regex processing.
108 # the /c is so that pos($line) doesn't die when the regex fails. 109 # the /c is so that pos($line) doesn't die when the regex fails.
109 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 110 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) {
110 my ($before, $function, $raw_args) = ($1, $2, $3); 111 my ($before, $function, $raw_args) = ($1, $2, $3);
111 # $args here will be a hashref 112 # $args here will be a hashref
112 my $args = $raw_args =~ /\S/ ? cook_args($raw_args) : {}; 113 my @args = $raw_args =~ /\S/ ? cook_args($raw_args) : {};
114 if ($ifstack[-1]) {
113 print $before; 115 print $before;
114 116 }
117
115 if ($self->can($function)) { 118 if ($self->can($function)) {
119 if ($function eq "if") {
120 push @ifstack, $self->$function(@_, [@args]);
121 } elsif ($function eq "else" and @ifstack > 1) {
122 $ifstack[-1] = not $ifstack[-1];
123 } elsif ($function eq "endif" and @ifstack > 1) {
124 pop $ifstack;
125 } elsif ($ifstack[-1]) {
116 print $self->$function(@_, $args); 126 print $self->$function(@_, {@args});
127 }
117 } 128 }
118 } 129 }
119 130
131 if ($ifstack[-1]) {
120 print substr $line, (defined pos $line) ? pos $line : 0); 132 print substr $line, (defined pos $line) ? pos $line : 0);
133 }
121 } 134 }
122} 135}
123 136
124# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns 137# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns
125# a reference to a hash containing the parsed arguments. 138# a list which pairs into key/values and fits nicely in {}s.
126# 139#
127sub cook_args($) { 140sub cook_args($) {
128 my ($raw_args) = @_; 141 my ($raw_args) = @_;
129 my $args = {}; 142 my @args = ();
130 143
131 # Boy I love m//g in scalar context! Go read the camel book, heathen. 144 # Boy I love m//g in scalar context! Go read the camel book, heathen.
132 # First, get the whole token with the quotes on both ends... 145 # First, get the whole token with the quotes on both ends...
133 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) { 146 while ($raw_args =~ m/\G\s*(\w*)="((?:[^"\\]|\\.)*)"/g) {
134 my ($key, $value) = ($1, $2); 147 my ($key, $value) = ($1, $2);
135 # ... then, rip out all the protecty backspaces 148 # ... then, rip out all the protecty backspaces
136 $value =~ s/\(.)/$1/g; 149 $value =~ s/\(.)/$1/g;
137 $args->{$key} = $value; 150 push @args, $key => $value;
138 } 151 }
139 152
140 return $args; 153 return @args;
141} 154}
142 155
143################################################################################ 156################################################################################
144# Macros used by content generators to render common idioms 157# Macros used by content generators to render common idioms
145################################################################################ 158################################################################################
… …
330# CGI::a({-href=>$help}, "Help"), CGI::br(), 343# CGI::a({-href=>$help}, "Help"), CGI::br(),
331 CGI::a({-href=>$logout}, "Log Out"), CGI::br(), 344 CGI::a({-href=>$logout}, "Log Out"), CGI::br(),
332 ; 345 ;
333} 346}
334 347
335sub title { 348# This is different. It probably should print anything (except in debugging cases)
336 return "WeBWorK"; 349# and it should return a boolean, not a string. &if is called in a nonstandard way
337} 350# by &template, with $args as an arrayref instead of a hashref. this is a hack! yay!
351sub if {
352 my ($self, $args) = @_[0,-1];
353 # A single if "or"s it's components. Nesting produces "and".
354
355 my @args = @$args; # Hahahahaha, get it?!
356
357 if (@args % 2 != 0) {
358 # flip out and kill people, but do not commit seppuku
359 print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n';
360 }
361
362 while (@args > 1) {
363 my ($key, $value) = (shift @args, shift @args);
364
365 if ($key eq "can" and $self->can($value)) {
366 return 1;
367 }
338 368
339sub body { 369 # Other conditions go here, friend.
340 return "Generated content"; 370 }
371
372 return 0;
341} 373}
342 374
3431; 3751;
344 376
345__END__ 377__END__
Legend:
Removed from v.511  
changed lines
  Added in v.512
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9