Revision a59350b1
Von Moritz Bunkus vor etwa 17 Jahren hinzugefügt
| SL/Template.pm | ||
|---|---|---|
| 28 | 28 |
sub _init {
|
| 29 | 29 |
my $self = shift; |
| 30 | 30 |
|
| 31 |
$self->{"source"} = shift;
|
|
| 32 |
$self->{"form"} = shift;
|
|
| 33 |
$self->{"myconfig"} = shift;
|
|
| 34 |
$self->{"userspath"} = shift;
|
|
| 31 |
$self->{source} = shift;
|
|
| 32 |
$self->{form} = shift;
|
|
| 33 |
$self->{myconfig} = shift;
|
|
| 34 |
$self->{userspath} = shift;
|
|
| 35 | 35 |
|
| 36 |
$self->{"error"} = undef;
|
|
| 36 |
$self->{error} = undef;
|
|
| 37 |
|
|
| 38 |
$self->set_tag_style('<%', '%>');
|
|
| 39 |
} |
|
| 40 |
|
|
| 41 |
sub set_tag_style {
|
|
| 42 |
my $self = shift; |
|
| 43 |
my $tag_start = shift; |
|
| 44 |
my $tag_end = shift; |
|
| 45 |
|
|
| 46 |
$self->{tag_start} = $tag_start;
|
|
| 47 |
$self->{tag_end} = $tag_end;
|
|
| 48 |
$self->{tag_start_qm} = quotemeta $tag_start;
|
|
| 49 |
$self->{tag_end_qm} = quotemeta $tag_end;
|
|
| 37 | 50 |
} |
| 38 | 51 |
|
| 39 | 52 |
sub cleanup {
|
| ... | ... | |
| 140 | 153 |
|
| 141 | 154 |
my $form = $self->{"form"};
|
| 142 | 155 |
|
| 143 |
while ($text =~ /<\%(.*?)\%>/) {
|
|
| 156 |
while ($text =~ /$self->{tag_start_qm}(.+?)$self->{tag_end_qm}/) {
|
|
| 157 |
my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]); |
|
| 144 | 158 |
my ($var, @options) = split(/\s+/, $1); |
| 145 | 159 |
my $value = $form->{$var};
|
| 146 | 160 |
|
| 161 |
$main::lxdebug->message(0, "REPL var: $1"); |
|
| 162 |
|
|
| 147 | 163 |
for (my $i = 0; $i < scalar(@indices); $i++) {
|
| 148 | 164 |
last unless (ref($value) eq "ARRAY"); |
| 149 | 165 |
$value = $value->[$indices[$i]]; |
| 150 | 166 |
} |
| 151 | 167 |
$value = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options)); |
| 152 |
substr($text, $-[0], $+[0] - $-[0]) = $value;
|
|
| 168 |
substr($text, $tag_pos, $tag_len) = $value;
|
|
| 153 | 169 |
} |
| 154 | 170 |
|
| 155 | 171 |
return $text; |
| ... | ... | |
| 205 | 221 |
# and <%lastpage%> |
| 206 | 222 |
|
| 207 | 223 |
my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2);
|
| 208 |
$pb =~ s/<%sumcarriedforward%>/$psum/g;
|
|
| 209 |
$pb =~ s/<%lastpage%>/$current_page/g;
|
|
| 224 |
$pb =~ s/$self->{tag_start_qm}sumcarriedforward$self->{tag_end_qm}/$psum/g;
|
|
| 225 |
$pb =~ s/$self->{tag_start_qm}lastpage$self->{tag_end_qm}/$current_page/g;
|
|
| 210 | 226 |
|
| 211 | 227 |
my $new_text = $self->parse_block($pb, (@indices, $i)); |
| 212 | 228 |
return undef unless (defined($new_text)); |
| ... | ... | |
| 236 | 252 |
sub find_end {
|
| 237 | 253 |
my ($self, $text, $pos, $var, $not) = @_; |
| 238 | 254 |
|
| 255 |
my $tag_start_len = length $self->{tag_start};
|
|
| 256 |
|
|
| 239 | 257 |
my $depth = 1; |
| 240 | 258 |
$pos = 0 unless ($pos); |
| 241 | 259 |
|
| 242 | 260 |
while ($pos < length($text)) {
|
| 243 | 261 |
$pos++; |
| 244 | 262 |
|
| 245 |
next if (substr($text, $pos - 1, 2) ne '<%'); |
|
| 263 |
next if (substr($text, $pos - 1, length($self->{tag_start})) ne $self->{tag_start});
|
|
| 264 |
|
|
| 265 |
my $keyword_pos = $pos - 1 + $tag_start_len; |
|
| 246 | 266 |
|
| 247 |
if ((substr($text, $pos + 1, 2) eq 'if') || (substr($text, $pos + 1, 3) eq 'for')) {
|
|
| 267 |
if ((substr($text, $keyword_pos, 2) eq 'if') || (substr($text, $keyword_pos, 3) eq 'for')) {
|
|
| 248 | 268 |
$depth++; |
| 249 | 269 |
|
| 250 |
} elsif ((substr($text, $pos + 1, 4) eq 'else') && (1 == $depth)) {
|
|
| 270 |
} elsif ((substr($text, $keyword_pos, 4) eq 'else') && (1 == $depth)) {
|
|
| 251 | 271 |
if (!$var) {
|
| 252 |
$self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
|
|
| 272 |
$self->{"error"} =
|
|
| 273 |
"$self->{tag_start}else$self->{tag_end} outside of "
|
|
| 274 |
. "$self->{tag_start}if$self->{tag_end} / "
|
|
| 275 |
. "$self->{tag_start}ifnot$self->{tag_end}.";
|
|
| 253 | 276 |
return undef; |
| 254 | 277 |
} |
| 255 | 278 |
|
| 256 | 279 |
my $block = substr($text, 0, $pos - 1); |
| 257 | 280 |
substr($text, 0, $pos - 1) = ""; |
| 258 |
$text =~ s!^<\%[^\%]+\%>!!;
|
|
| 259 |
$text = '<%if' . ($not ? " " : "not ") . $var . '%>' . $text;
|
|
| 281 |
$text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
|
|
| 282 |
$text = $self->{tag_start} . 'if' . ($not ? " " : "not ") . $var . $self->{tag_end} . $text;
|
|
| 260 | 283 |
|
| 261 | 284 |
return ($block, $text); |
| 262 | 285 |
|
| 263 |
} elsif (substr($text, $pos + 1, 3) eq 'end') {
|
|
| 286 |
} elsif (substr($text, $keyword_pos, 3) eq 'end') {
|
|
| 264 | 287 |
$depth--; |
| 265 | 288 |
if ($depth == 0) {
|
| 266 | 289 |
my $block = substr($text, 0, $pos - 1); |
| 267 | 290 |
substr($text, 0, $pos - 1) = ""; |
| 268 |
$text =~ s!^<\%[^\%]+\%>!!;
|
|
| 291 |
$text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
|
|
| 269 | 292 |
|
| 270 | 293 |
return ($block, $text); |
| 271 | 294 |
} |
| ... | ... | |
| 283 | 306 |
my $new_contents = ""; |
| 284 | 307 |
|
| 285 | 308 |
while ($contents ne "") {
|
| 286 |
my $pos_if = index($contents, '<%if');
|
|
| 287 |
my $pos_foreach = index($contents, '<%foreach');
|
|
| 309 |
my $pos_if = index($contents, $self->{tag_start} . 'if');
|
|
| 310 |
my $pos_foreach = index($contents, $self->{tag_start} . 'foreach');
|
|
| 288 | 311 |
|
| 289 | 312 |
if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
|
| 290 | 313 |
$new_contents .= $self->substitute_vars($contents, @indices); |
| ... | ... | |
| 295 | 318 |
$new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices); |
| 296 | 319 |
substr($contents, 0, $pos_foreach) = ""; |
| 297 | 320 |
|
| 298 |
if ($contents !~ m|^<\%foreach (.*?)\%>|) {
|
|
| 299 |
$self->{"error"} = "Malformed <\%foreach\%>.";
|
|
| 321 |
if ($contents !~ m|^$self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm}|) {
|
|
| 322 |
$self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}.";
|
|
| 300 | 323 |
$main::lxdebug->leave_sub(); |
| 301 | 324 |
return undef; |
| 302 | 325 |
} |
| ... | ... | |
| 308 | 331 |
my $block; |
| 309 | 332 |
($block, $contents) = $self->find_end($contents); |
| 310 | 333 |
if (!$block) {
|
| 311 |
$self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
|
|
| 334 |
$self->{"error"} = "Unclosed $self->{tag_start}foreach$self->{tag_end}." unless ($self->{"error"});
|
|
| 312 | 335 |
$main::lxdebug->leave_sub(); |
| 313 | 336 |
return undef; |
| 314 | 337 |
} |
| ... | ... | |
| 324 | 347 |
$new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices); |
| 325 | 348 |
substr($contents, 0, $pos_if) = ""; |
| 326 | 349 |
|
| 327 |
if ($contents !~ m|^<\%if\s*(not)?\s+(.*?)\%>|) {
|
|
| 328 |
$self->{"error"} = "Malformed <\%if\%>.";
|
|
| 350 |
if ($contents !~ m|^$self->{tag_start_qm}if\s*(not)?\s+(.*?)$self->{tag_end_qm}|) {
|
|
| 351 |
$self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
|
|
| 329 | 352 |
$main::lxdebug->leave_sub(); |
| 330 | 353 |
return undef; |
| 331 | 354 |
} |
| ... | ... | |
| 336 | 359 |
|
| 337 | 360 |
($block, $contents) = $self->find_end($contents, 0, $var, $not); |
| 338 | 361 |
if (!$block) {
|
| 339 |
$self->{"error"} = "Unclosed <\%if${not}\%>." unless ($self->{"error"});
|
|
| 362 |
$self->{"error"} = "Unclosed $self->{tag_start}if${not}$self->{tag_end}." unless ($self->{"error"});
|
|
| 340 | 363 |
$main::lxdebug->leave_sub(); |
| 341 | 364 |
return undef; |
| 342 | 365 |
} |
| ... | ... | |
| 363 | 386 |
return $new_contents; |
| 364 | 387 |
} |
| 365 | 388 |
|
| 389 |
sub parse_first_line {
|
|
| 390 |
my $self = shift; |
|
| 391 |
my $line = shift || ""; |
|
| 392 |
|
|
| 393 |
if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) {
|
|
| 394 |
if ($1 eq $2) {
|
|
| 395 |
$self->{error} = "The tag start and end markers must not be equal.";
|
|
| 396 |
return 0; |
|
| 397 |
} |
|
| 398 |
|
|
| 399 |
$self->set_tag_style($1, $2); |
|
| 400 |
} |
|
| 401 |
|
|
| 402 |
return 1; |
|
| 403 |
} |
|
| 404 |
|
|
| 366 | 405 |
sub parse {
|
| 367 | 406 |
my $self = $_[0]; |
| 368 | 407 |
local *OUT = $_[1]; |
| ... | ... | |
| 372 | 411 |
$self->{"error"} = "$!";
|
| 373 | 412 |
return 0; |
| 374 | 413 |
} |
| 375 |
@_ = <IN>;
|
|
| 414 |
my @lines = <IN>;
|
|
| 376 | 415 |
close(IN); |
| 377 | 416 |
|
| 378 |
my $contents = join("", @_);
|
|
| 417 |
return 0 if (!$self->parse_first_line($lines[0])); |
|
| 418 |
|
|
| 419 |
my $contents = join("", @lines);
|
|
| 379 | 420 |
|
| 380 | 421 |
# detect pagebreak block and its parameters |
| 381 |
if ($contents =~ /<%pagebreak\s+(\d+)\s+(\d+)\s+(\d+)\s*%>(.*?)<%end(\s*pagebreak)?%>/s) {
|
|
| 422 |
if ($contents =~ /$self->{tag_start_qm}pagebreak\s+(\d+)\s+(\d+)\s+(\d+)\s*$self->{tag_end_qm}(.*?)$self->{tag_start_qm}end(\s*pagebreak)?$self->{tag_end_qm}/s) {
|
|
| 382 | 423 |
$self->{"chars_per_line"} = $1;
|
| 383 | 424 |
$self->{"lines_on_first_page"} = $2;
|
| 384 | 425 |
$self->{"lines_on_second_page"} = $3;
|
Auch abrufbar als: Unified diff
Beim Parsen von text-basierten Vorlagen (HTML, LaTeX) kann jetzt in der ersten Zeile das Format der Tags bestimmt werden. Dazu wird etwas wie "((set-tag-style))" benutzt. Die Nicht-Leerzeichen links und rechts vom Wort "set-tag-style" bestimmen, wie ein von Lx-Office zu parsendes Tag beginnt und wie es endet.