Template.pm

   1 package Template;
   2
   3 #
   4 # Template (Version 2.5)
   5 #
   6 # Klasse zum Parsen von Templates
   7 #
   8 # Autor:            Patrick Canterino <patrick@patshaping.de>
   9 # Letzte Aenderung: 25.11.2011
  10 #
  11 # Copyright (C) 2002-2011 Patrick Canterino
  12 #
  13 # Diese Datei kann unter den Bedingungen der "Artistic License 2.0"
  14 # weitergegeben und / oder veraendert werden.
  15 # Siehe:
  16 # http://www.opensource.org/licenses/artistic-license-2.0
  17 #
  18
  19 use strict;
  20
  21 use Carp qw(croak);
  22 use File::Spec;
  23
  24 # new()
  25 #
  26 # Konstruktor
  27 #
  28 # Parameter: -keine-
  29 #
  30 # Rueckgabe: Template-Objekt
  31
  32 sub new {
  33     my $class = shift;
  34     my $self  = {file => '', template => '', original => '', old_parsing => 0, vars => {}, defined_vars => [], loop_vars => {}};
  35     return bless($self,$class);
  36 }
  37
  38 # get_template()
  39 #
  40 # Kompletten Vorlagentext zurueckgeben
  41 #
  42 # Parameter: -keine-
  43 #
  44 # Rueckgabe: Kompletter Vorlagentext (String)
  45
  46 sub get_template {
  47     return shift->{'template'};
  48 }
  49
  50 # set_template()
  51 #
  52 # Kompletten Vorlagentext aendern
  53 #
  54 # Parameter: Vorlagentext
  55 #
  56 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
  57
  58 sub set_template($) {
  59     my ($self,$template) = @_;
  60     $self->{'template'}  = $template;
  61 }
  62
  63 # add_text()
  64 #
  65 # Vorlagentext ans Template-Objekt anhaengen
  66 #
  67 # Parameter: Vorlagentext
  68 #
  69 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
  70
  71 sub add_text($) {
  72     my ($self,$text) = @_;
  73     $self->set_template($self->get_template.$text);
  74 }
  75
  76 # read_file()
  77 #
  78 # Einlesen einer Vorlagendatei und {INCLUDE}-Anweisungen ggf. verarbeiten
  79 # (Text wird an bereits vorhandenen Text angehaengt)
  80 #
  81 # Parameter: 1. Datei zum Einlesen
  82 #            2. Status-Code (Boolean):
  83 #               true  => {INCLUDE}-Anweisungen nicht verarbeiten
  84 #               false => {INCLUDE}-Anweisungen verarbeiten (Standard)
  85 #
  86 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
  87
  88 sub read_file($;$) {
  89     my ($self,$file,$not_include) = @_;
  90     local *FILE;
  91
  92     $self->{'file'} = $file;
  93
  94     open(FILE,'<'.$file) or croak "Open $file: $!";
  95     read(FILE, my $content, -s $file);
  96     close(FILE) or croak "Closing $file: $!";
  97
  98     $self->add_text($content);
  99     $self->save_state;
 100
 101     $self->parse_includes unless($not_include);
 102 }
 103
 104 # set_var()
 105 #
 106 # Wert einer Variable setzen
 107 #
 108 # Parameter: 1. Name der Variable
 109 #            2. Wert, den die Variable erhalten soll
 110 #
 111 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 112
 113 sub set_var($$) {
 114     my ($self,$var,$content) = @_;
 115     $self->{'vars'}->{$var} = $content;
 116 }
 117
 118 # get_var()
 119 #
 120 # Wert einer Variable zurueckgeben
 121 #
 122 # Parameter: (optional) Variablenname
 123 #
 124 # Rueckgabe: Wert der Variable;
 125 #            wenn die Variable nicht existiert, false;
 126 #            wenn kein Variablenname angegeben wurde, wird ein
 127 #            Array mit den Variablennamen zurueckgegeben
 128
 129 sub get_var(;$) {
 130     my ($self,$var) = @_;
 131
 132     if(defined $var) {
 133         if($self->{'vars'}->{$var}) {
 134             return $self->{'vars'}->{$var};
 135         }
 136         else {
 137             return undef;
 138         }
 139     }
 140     else {
 141         return keys %{$self->{'vars'}};
 142     }
 143 }
 144
 145 # set_vars()
 146 #
 147 # Komplettes Variablen-Array mit einem anderen Array ueberschreiben
 148 #
 149 # Parameter: Array
 150 #
 151 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 152
 153 sub set_vars($) {
 154     my ($self,$vars) = @_;
 155     $self->{'vars'} = $vars;
 156 }
 157
 158 # add_vars()
 159 #
 160 # Zum bestehenden Variablen-Array weitere Variablen in Form eines Arrays
 161 # hinzufuegen
 162 #
 163 # Parameter: Array
 164 #
 165 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 166
 167 sub add_vars($) {
 168     my ($self,$vars) = @_;
 169     $self->{'vars'}  = {(%{$self->{'vars'}}, %$vars)};
 170
 171     #while(my ($name,$content) = each(%$vars)) {
 172     #    $self->{'vars'}->{$name} = $content;
 173     #}
 174 }
 175
 176 # set_loop_data()
 177 #
 178 # Daten fuer eine Schleife setzen
 179 #
 180 # Parameter: 1. Name der Schleife
 181 #            2. Array-Referenz mit den Hash-Referenzen mit
 182 #               den Variablen fuer die Schleifendurchgaenge
 183 #
 184 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 185
 186 sub set_loop_data($$) {
 187     my ($self,$loop,$data) = @_;
 188     $self->{'loop_vars'}->{$loop} = $data;
 189 }
 190
 191 # add_loop_data()
 192 #
 193 # Daten fuer einen Schleifendurchgang hinzufuegen
 194 #
 195 # Parameter: 1. Name der Schleife
 196 #            2. Hash-Referenz mit den Variablen fuer den
 197 #               Schleifendurchgang
 198 #
 199 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 200
 201 sub add_loop_data($$) {
 202     my ($self,$loop,$data) = @_;
 203
 204     if($self->{'loop_vars'}->{$loop} && ref($self->{'loop_vars'}->{$loop}) eq 'ARRAY') {
 205         push(@{$self->{'loop_vars'}->{$loop}},$data);
 206     }
 207     else {
 208         $self->{'loop_vars'}->{$loop} = [$data];
 209     }
 210 }
 211
 212 # parse()
 213 #
 214 # In der Template definierte Variablen auslesen, Variablen
 215 # ersetzen, {IF}- und {TRIM}-Bloecke parsen
 216 #
 217 # Parameter: -nichts-
 218 #
 219 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 220
 221 sub parse {
 222     my $self = shift;
 223     return $self->parse_old if($self->{'old_parsing'});
 224
 225     # Zuerst die Schleifen parsen
 226
 227     if($self->{'loop_vars'} && (my @loops = keys(%{$self->{'loop_vars'}}))) {
 228         foreach my $loop(@loops) {
 229             $self->parse_loop($loop);
 230         }
 231     }
 232
 233     # In Template-Datei definierte Variablen auslesen
 234
 235     $self->get_defined_vars;
 236
 237     # Variablen ersetzen
 238
 239     my @vars = $self->get_var;
 240
 241     if(defined(@vars) && scalar(@vars) > 0) {
 242         $self->parse_if_blocks;
 243         $self->replace_vars;
 244     }
 245
 246     # {TRIM}-Bloecke entfernen
 247
 248     $self->parse_trim_blocks;
 249 }
 250
 251 # parse_old()
 252 #
 253 # In der Template definierte Variablen auslesen, Variablen
 254 # ersetzen, {IF}- und {TRIM}-Bloecke parsen
 255 # (alte Methode)
 256 #
 257 # Parameter: -nichts-
 258 #
 259 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 260
 261 sub parse_old {
 262     my $self = shift;
 263
 264     # Zuerst die Schleifen parsen
 265
 266     if($self->{'loop_vars'} && (my @loops = keys(%{$self->{'loop_vars'}}))) {
 267         foreach my $loop(@loops) {
 268             $self->parse_loop($loop);
 269         }
 270     }
 271
 272     # Normale Variablen durchgehen
 273
 274     foreach my $var($self->get_var) {
 275         my $val = $self->get_var($var);
 276
 277         $self->parse_if_block($var,$val);
 278
 279         if(ref($val) eq 'ARRAY') {
 280             $self->fillin_array($var,$val);
 281         }
 282         else {
 283             $self->fillin($var,$val);
 284         }
 285     }
 286
 287     # Jetzt dasselbe mit denen, die direkt in der Template-Datei definiert
 288     # sind, machen. Ich weiss, dass das eine ziemlich unsaubere Loesung ist,
 289     # aber es funktioniert
 290
 291     $self->get_defined_vars;
 292
 293     foreach my $var(@{$self->{'defined_vars'}}) {
 294         my $val = $self->get_var($var);
 295
 296         $self->parse_if_block($var,$val);
 297         $self->fillin($var,$val);
 298     }
 299
 300     # {TRIM}-Bloecke entfernen
 301
 302     $self->parse_trim_blocks;
 303 }
 304
 305 # fillin()
 306 #
 307 # Variablen durch Text ersetzen
 308 #
 309 # Parameter: 1. Variable zum Ersetzen
 310 #            2. Text, durch den die Variable ersetzt werden soll
 311 #
 312 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 313
 314 sub fillin($$) {
 315     my ($self,$var,$text) = @_;
 316
 317     $text = '' unless defined $text; # Um Fehler zu vermeiden
 318
 319     my $template = $self->get_template;
 320     $template    = str_replace('{'.$var.'}',$text,$template);
 321
 322     $self->set_template($template);
 323 }
 324
 325 # fillin_array()
 326 #
 327 # Variable durch Array ersetzen
 328 #
 329 # Parameter: 1. Variable zum Ersetzen
 330 #            2. Array-Referenz, durch die die Variable ersetzt werden soll
 331 #            3. Zeichenkette, mit der das Array verbunden werden soll
 332 #               (Standard: '')
 333 #
 334 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 335
 336 sub fillin_array($$;$) {
 337     my ($self,$var,$array,$glue) = @_;
 338     $glue = '' unless defined $glue;
 339
 340     $self->fillin($var,join($glue,@$array));
 341 }
 342
 343 # replace_vars()
 344 #
 345 # Variablen eine nach der anderen ersetzen. Sollte in einer Variable eine
 346 # andere Variable auftauchen, so wird diese nicht ersetzt.
 347 #
 348 # Parameter: Array mit zu parsenden Variablen (optional)
 349 #
 350 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 351
 352 sub replace_vars(;@) {
 353     my ($self,@valid) = @_;
 354     my $template = $self->get_template;
 355
 356     my @valid_vars = (@valid) ? @valid : $self->get_var;
 357
 358     for(my $x=0;$x<length($template);$x++) {
 359         if(substr($template,$x,1) eq '{') {
 360             foreach my $var(@valid_vars) {
 361                 # Pruefen, ob hier eine gueltige Variable beginnt
 362
 363                 if(substr($template,$x+1,length($var)+1) eq $var.'}') {
 364                     my $content;
 365                     my $val = $self->get_var($var);
 366
 367                     if(ref($val) eq 'ARRAY') {
 368                         $content = join('',@$val);
 369                     }
 370                     else {
 371                         $content = $val;
 372                     }
 373
 374                     # Daten vor und nach der Variable
 375
 376                     my $pre  = substr($template,0,$x);
 377                     my $post = substr($template,length($pre)+2+length($var));
 378
 379                     # Alles neu zusammensetzen
 380
 381                     $template = $pre.$content.$post;
 382
 383                     # Zaehler aendern
 384
 385                     $x = length($pre.$content)-1;
 386                 }
 387             }
 388         }
 389     }
 390
 391     $self->set_template($template);
 392 }
 393
 394 # to_file()
 395 #
 396 # Template in Datei schreiben
 397 #
 398 # Parameter: Datei-Handle
 399 #
 400 # Rueckgabe: Status-Code (Boolean)
 401
 402 sub to_file($) {
 403     my ($self,$handle) = @_;
 404     return print $handle $self->get_template;
 405 }
 406
 407 # reset()
 408 #
 409 # Den gesicherten Stand des Template-Textes wiederherstellen
 410 #
 411 # Parameter: -nichts-
 412 #
 413 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 414
 415 sub reset {
 416     my $self = shift;
 417     $self->{'template'} = $self->{'original'};
 418 }
 419
 420 # save_state()
 421 #
 422 # Aktuellen Stand des Template-Textes sichern
 423 # (alte Sicherung wird ueberschrieben)
 424 #
 425 # Parameter: -nichts-
 426 #
 427 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 428
 429 sub save_state {
 430     my $self = shift;
 431     $self->{'original'} = $self->{'template'};
 432 }
 433
 434 # parse_loop()
 435 #
 436 # Eine Schleife parsen
 437 #
 438 # Parameter: Name der Schleife
 439 #
 440 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 441
 442 sub parse_loop($) {
 443     my ($self,$name) = @_;
 444
 445     my $template = $self->get_template;
 446     return if(index($template,'{LOOP '.$name.'}') == -1);
 447
 448     my $offset   = 0;
 449     my $name_len = length($name);
 450
 451     while((my $begin = index($template,'{LOOP '.$name.'}',$offset)) != -1) {
 452         if((my $end = index($template,'{ENDLOOP}',$begin+6+$name_len)) != -1) {
 453             my $block   = substr($template,$begin,$end+9-$begin);
 454             my $content = substr($block,$name_len+7,-9);
 455
 456             my $parsed_block = '';
 457
 458             for(my $x=0;$x<scalar @{$self->{'loop_vars'}->{$name}};$x++) {
 459                 my $loop_data = $self->{'loop_vars'}->{$name}->[$x];
 460                 my @loop_vars = keys(%$loop_data);
 461
 462                 my $ctpl = new Template;
 463                 $ctpl->set_template($content);
 464
 465                 foreach my $loop_var(@loop_vars) {
 466                     $ctpl->set_var($name.'.'.$loop_var,$loop_data->{$loop_var});
 467                 }
 468
 469                 if($self->{'old_parsing'}) {
 470                     $ctpl->parse_old;
 471                 }
 472                 else {
 473                     $ctpl->parse;
 474                 }
 475
 476                 $parsed_block .= $ctpl->get_template;
 477
 478                 undef($ctpl);
 479             }
 480
 481             $template = str_replace($block,$parsed_block,$template);
 482             $offset   = $begin+length($parsed_block);
 483         }
 484         else {
 485             last;
 486         }
 487     }
 488
 489     $self->set_template($template);
 490 }
 491
 492 # get_defined_vars()
 493 #
 494 # In der Template-Datei definierte Variablen auslesen
 495 #
 496 # Parameter: -nichts-
 497 #
 498 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 499
 500 sub get_defined_vars {
 501     my $self = shift;
 502
 503     my $template = $self->get_template;
 504     return if(index($template,'{DEFINE ') == -1);
 505
 506     my $offset = 0;
 507
 508     while(index($template,'{DEFINE ',$offset) != -1) {
 509         my $begin = index($template,'{DEFINE ',$offset)+8;
 510         $offset   = $begin;
 511
 512         my $name    = '';
 513         my $content = '';
 514
 515         my $var_open     = 0;
 516         my $name_found   = 0;
 517         my $define_block = 0;
 518
 519         for(my $x=$begin;$x<length($template);$x++) {
 520             if(substr($template,$x,1) eq "\012" || substr($template,$x,1) eq "\015") {
 521                 # Wenn in einem {DEFINE}-Block ein Zeilenumbruch gefunden wird,
 522                 # brechen wir mit dem Parsen des Blockes ab
 523
 524                 last;
 525             }
 526
 527             if($var_open == 1) {
 528                 if(substr($template,$x,1) eq '"') {
 529                     # Der Inhalt der Variable ist hier zu Ende
 530
 531                     $var_open = 0;
 532
 533                     if(substr($template,$x+1,1) eq '}') {
 534                         # Hier ist der Block zu Ende
 535
 536                         if(not defined $self->get_var($name)) {
 537                             # Die Variable wird nur gesetzt, wenn sie nicht bereits gesetzt ist
 538
 539                             $self->set_var($name,$content);
 540                             push(@{$self->{'defined_vars'}},$name);
 541                         }
 542
 543                         # {DEFINE}-Block entfernen
 544
 545                         my $pre  = substr($template,0,$begin-8);
 546                         my $post = substr($template,$x+2);
 547
 548                         $template = $pre.$post;
 549
 550                         # Fertig!
 551
 552                         $offset = length($pre);
 553                         last;
 554                     }
 555                 }
 556                 elsif(substr($template,$x,1) eq '\\') {
 557                     # Ein Backslash wurde gefunden, er dient zum Escapen von Zeichen
 558
 559                     if(substr($template,$x+1,1) eq 'n') {
 560                         # "\n" in Zeilenumbrueche umwandeln
 561
 562                         $content .= "\n";
 563                     }
 564                     else {
 565                         $content .= substr($template,$x+1,1);
 566                     }
 567
 568                     $x++;
 569                 }
 570                 else {
 571                     $content .= substr($template,$x,1);
 572                 }
 573             }
 574             else {
 575                 if($name_found == 1) {
 576                     if($var_open == 0) {
 577                         if(substr($template,$x,1) eq '"') {
 578                             $var_open = 1;
 579                         }
 580                         else {
 581                             last;
 582                         }
 583                     }
 584                 }
 585                 else {
 586                     # Variablennamen auslesen
 587
 588                     if(substr($template,$x,1) eq '}' && $name ne '') {
 589                         # Wir haben einen {DEFINE}-Block
 590
 591                         $name_found   = 1;
 592                         $define_block = 1;
 593
 594                         # Alles ab hier sollte mit dem Teil verbunden werden, der das
 595                         # {DEFINE} in einer Zeile verarbeitet
 596
 597                         # Der Parser fuer {DEFINE}-Bloecke ist nicht rekursiv, was auch
 598                         # nicht noetig sein sollte
 599
 600                         if((my $end = index($template,'{ENDDEFINE}',$x)) != -1) {
 601                             $x++;
 602
 603                             $content = substr($template,$x,$end-$x);
 604
 605                         if(not defined $self->get_var($name)) {
 606                             # Die Variable wird nur gesetzt, wenn sie nicht bereits gesetzt ist
 607
 608                             $self->set_var($name,$content);
 609                             push(@{$self->{'defined_vars'}},$name);
 610                         }
 611
 612                         my $pre  = substr($template,0,$begin-8);
 613                         my $post = substr($template,$end+11);
 614
 615                         $template = $pre.$post;
 616
 617                         # Fertig!
 618
 619                         $offset = length($pre);
 620                         last;
 621                     }
 622                     else {
 623                         last;
 624                     }
 625                 }
 626                 elsif(substr($template,$x,1) ne ' ') {
 627                     $name .= substr($template,$x,1);
 628                 }
 629                 elsif(substr($template,$x,1) ne '') {
 630                     $name_found = 1;
 631                 }
 632                 else {
 633                     last;
 634                 }
 635             }
 636         }
 637     }
 638  }
 639
 640  $self->set_template($template);
 641 }
 642
 643 # parse_if_block()
 644 #
 645 # IF-Bloecke verarbeiten
 646 #
 647 # Parameter: 1. Name des IF-Blocks (das, was nach dem IF steht)
 648 #            2. Status-Code (true  => Inhalt anzeigen
 649 #                            false => Inhalt nicht anzeigen
 650 #            3. true  => Verneinten Block nicht parsen
 651 #               false => Verneinten Block parsen (Standard)
 652 #
 653 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 654
 655 sub parse_if_block($$;$) {
 656     my ($self,$name,$state,$no_negate) = @_;
 657     my $template                       = $self->get_template;
 658
 659     my $count = 0;
 660
 661     while(index($template,'{IF '.$name.'}') >= 0) {
 662         # Das alles hier ist nicht wirklich elegant geloest...
 663         # ... aber solange es funktioniert... ;-)
 664
 665         $count++;
 666
 667         my $start    = index($template,'{IF '.$name.'}');
 668         my $tpl_tmp  = substr($template,$start);
 669         my @splitted = explode('{ENDIF}',$tpl_tmp);
 670
 671         my $block = ''; # Kompletter bedingter Block
 672         my $ifs   = 0;  # IF-Zaehler (wird fuer jedes IF erhoeht und fuer jedes ENDIF erniedrigt)
 673
 674         # {IF}
 675
 676         for(my $x=0;$x<@splitted;$x++) {
 677             croak 'Nesting error found while parsing IF block "'.$name.'" nr. '.$count.' in template file "'.$self->{'file'}.'"' if($x == $#splitted);
 678
 679             $ifs += substr_count($splitted[$x],'{IF '); # Zum Zaehler jedes Vorkommen von IF hinzuzaehlen
 680             $ifs--;                                     # Zaehler um 1 erniedrigen
 681             $block .= $splitted[$x].'{ENDIF}';          # Daten zum Block hinzufuegen
 682
 683             if($ifs == 0) {
 684                 # Zaehler wieder 0, also haben wir das Ende des IF-Blocks gefunden :-))
 685
 686                 last;
 687             }
 688         }
 689
 690         my $if_block = substr($block,length($name)+5,-7); # Alles zwischen {IF} und {ENDIF}
 691
 692         # {ELSE}
 693
 694         my $else_block = ''; # Alles ab {ELSE}
 695            $ifs        = 0;  # IF-Zaehler
 696
 697         @splitted = explode('{ELSE}',$if_block);
 698
 699         for(my $x=0;$x<@splitted;$x++) {
 700             $ifs += substr_count($splitted[$x],'{IF ');    # Zum Zaehler jedes Vorkommen von IF hinzuzaehlen
 701             $ifs -= substr_count($splitted[$x],'{ENDIF}'); # Vom Zaehler jedes Vorkommen von ENDIF abziehen
 702
 703             if($ifs == 0) {
 704                 # Zaehler 0, also haben wir das Ende des IF-Abschnitts gefunden
 705
 706                 # Aus dem Rest den ELSE-Block zusammenbauen
 707
 708                 for(my $y=$x+1;$y<@splitted;$y++) {
 709                     $else_block .= '{ELSE}'.$splitted[$y];
 710                 }
 711
 712                 if($else_block) {
 713                     $if_block   = substr($if_block,0,length($if_block)-length($else_block));
 714                     $else_block = (length($else_block) > 6) ? substr($else_block,6) : '';    # Ansonsten gibt es Fehler
 715                 }
 716
 717                 last;
 718             }
 719         }
 720
 721         my $replacement = ($state) ? $if_block : $else_block;
 722
 723         $template = str_replace($block,$replacement,$template);
 724     }
 725
 726     $self->set_template($template);
 727
 728     # Evtl. verneinte Form parsen
 729
 730     unless($no_negate) {
 731         $self->parse_if_block('!'.$name,not($state),1);
 732     }
 733 }
 734
 735 # parse_if_blocks()
 736 #
 737 # IF-Bloecke zu allen definierten Variablen verarbeiten
 738 #
 739 # Parameter: Array mit zu verarbeitenden IF-Bloecken (optional)
 740 #
 741 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 742
 743 sub parse_if_blocks(;@) {
 744     my ($self,@valid) = @_;
 745
 746     my @valid_vars = (@valid) ? @valid : $self->get_var;
 747
 748     foreach my $valid_var(@valid_vars)  {
 749         $self->parse_if_block($valid_var,$self->get_var($valid_var));
 750     }
 751 }
 752
 753 # parse_trim_blocks()
 754 #
 755 # {TRIM}-Bloecke parsen
 756 #
 757 # Dieser Parser ist nicht rekursiv, was auch nicht
 758 # noetig sein sollte.
 759 #
 760 # Parameter: -nichts-
 761 #
 762 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 763
 764 sub parse_trim_blocks {
 765     my $self = shift;
 766
 767     my $template = $self->get_template;
 768     return if(index($template,'{TRIM}') == -1);
 769
 770     my $offset = 0;
 771
 772     while((my $begin = index($template,'{TRIM}')) >= 0) {
 773         if((my $end = index($template,'{ENDTRIM}',$begin+6)) >= 0) {
 774             my $block   = substr($template,$begin,$end+9-$begin);
 775             my $content = substr($block,6,-9);
 776
 777             my $trimmed = $content;
 778             $trimmed    =~ s/^\s+//s;
 779             $trimmed    =~ s/\s+$//s;
 780
 781             $template   = str_replace($block,$trimmed,$template);
 782
 783             $offset     = $begin+length($trimmed);
 784         }
 785         else {
 786             last;
 787         }
 788     }
 789
 790     $self->set_template($template);
 791 }
 792
 793 # parse_condtag()
 794 #
 795 # Bedingungstags in einem Vorlagentext verarbeiten
 796 #
 797 # Parameter: 1. Tagname
 798 #            2. Status-Code (true  => Tag-Inhalt anzeigen
 799 #                            false => Tag-Inhalt nicht anzeigen
 800 #
 801 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 802
 803 sub parse_condtag($$) {
 804     my ($self,$condtag,$state) = @_;
 805
 806     my $template = $self->get_template;
 807
 808     while(index($template,'<'.$condtag.'>') >= 0) {
 809         my $start = index($template,'<'.$condtag.'>');                                # Beginn des Blocks
 810         my $end   = index($template,'</'.$condtag.'>')+length($condtag)+3;            # Ende des Blocks
 811
 812         my $extract = substr($template,$start,$end-$start);                           # Kompletten Bedingungsblock extrahieren...
 813
 814         my $replacement = ($state) ? substr($extract,length($condtag)+2,0-length($condtag)-3) : '';
 815
 816         $template = str_replace($extract,$replacement,$template);                     # Block durch neue Daten ersetzen
 817     }
 818
 819     $self->set_template($template);
 820 }
 821
 822 # parse_includes()
 823 #
 824 # {INCLUDE}-Anweisungen verarbeiten
 825 #
 826 # Parameter: -nichts-
 827 #
 828 # Rueckgabe: -nichts- (Template-Objekt wird modifiziert)
 829
 830 sub parse_includes {
 831     my $self = shift;
 832
 833     my $template = $self->get_template;
 834     return if(index($template,'{INCLUDE ') == -1);
 835
 836     my $offset = 0;
 837
 838     my $y = 0;
 839
 840     while((my $begin = index($template,'{INCLUDE ',$offset)) != -1) {
 841         $y++;
 842
 843         my $start = $begin+9;
 844         $offset   = $start;
 845         my $long  = 0;
 846
 847         if(substr($template,$start,1) eq '"') {
 848             $long = 1;
 849             $start++;
 850         }
 851
 852         my $file = '';
 853         my $skip = 0;
 854
 855         for(my $x=$start;$x<length($template);$x++) {
 856             my $c = substr($template,$x,1);
 857
 858             if($c eq "\012" && $c eq "\015") {
 859                 $skip = 1;
 860                 last;
 861             }
 862             elsif($long == 0 && $c eq ' ') {
 863                 $skip = 1;
 864                 last;
 865             }
 866             elsif($long == 1 && $c eq '"') {
 867                 $skip = 1 if(substr($template,$x+1,1) ne '}');
 868                 last;
 869             }
 870             elsif($long == 0 && $c eq '}') {
 871                 last;
 872             }
 873             else {
 874                 $file .= $c;
 875             }
 876         }
 877
 878         next if($skip == 1);
 879
 880         if($file ne '') {
 881             my $filepath = $file;
 882
 883             unless(File::Spec->file_name_is_absolute($file)) {
 884                 my $dir   = (File::Spec->splitpath($self->{'file'}))[1];
 885                 $dir      = '.' unless($dir);
 886                 $filepath = File::Spec->catfile($dir,$file);
 887             }
 888
 889             if(-f $filepath) {
 890                 my $inc = new Template;
 891                 $inc->read_file($filepath);
 892
 893                 my $end = ($long == 1)
 894                         ? $start + length($file) + 2
 895                         : $start + length($file) + 1;
 896
 897                 my $pre  = substr($template,0,$begin);
 898                 my $post = substr($template,$end);
 899
 900                 $template = $pre.$inc->get_template.$post;
 901                 $offset   = length($pre)+length($inc->get_template);
 902
 903                 undef($inc);
 904             }
 905         }
 906     }
 907
 908     $self->set_template($template);
 909 }
 910
 911 # ==================
 912 #  Private Funktion
 913 # ==================
 914
 915 # explode()
 916 #
 917 # Eine Zeichenkette ohne regulaere Ausdruecke auftrennen
 918 # (split() hat einen Bug, deswegen verwende ich es nicht)
 919 #
 920 # Parameter: 1. Trennzeichenkette
 921 #            2. Zeichenkette, die aufgetrennt werden soll
 922 #            3. Maximale Zahl von Teilen
 923 #
 924 # Rueckgabe: Aufgetrennte Zeichenkette (Array)
 925
 926 sub explode($$;$) {
 927     my ($separator,$string,$limit) = @_;
 928     my @splitted;
 929
 930     my $x       = 1;
 931     my $offset  = 0;
 932     my $sep_len = length($separator);
 933
 934     while((my $pos = index($string,$separator,$offset)) >= 0 && (!$limit || $x < $limit)) {
 935         my $part = substr($string,$offset,$pos-$offset);
 936         push(@splitted,$part);
 937
 938         $offset = $pos+$sep_len;
 939
 940         $x++;
 941     }
 942
 943     push(@splitted,substr($string,$offset,length($string)-$offset));
 944
 945     return @splitted;
 946 }
 947
 948 # str_replace()
 949 #
 950 # Zeichenkette durch andere ersetzen
 951 #
 952 # Parameter: 1. Zu ersetzender Text
 953 #            2. Ersetzender Text
 954 #            3. Zeichenkette, in der ersetzt werden soll
 955 #
 956 # Rueckgabe: Bearbeitete Zeichenkette (String)
 957
 958 sub str_replace($$$) {
 959     my ($search,$replace,$subject) = @_;
 960     $search = quotemeta($search);
 961
 962     $subject =~ s/$search/$replace/gs;
 963
 964     return $subject;
 965 }
 966
 967 # substr_count()
 968 #
 969 # Zaehlt, wie oft ein String in einem String vorkommt
 970 # (Emulation der PHP-Funktion substr_count())
 971 #
 972 # Parameter: 1. Zu durchsuchender String
 973 #            2. Zu suchender String
 974 #
 975 # Rueckgabe: Anzahl der Vorkommnisse (Integer)
 976
 977 sub substr_count($$) {
 978     my ($haystack,$needle) = @_;
 979     my $qmneedle = quotemeta($needle);
 980
 981     my $count = 0;
 982
 983     $count++ while($haystack =~ /$qmneedle/g);
 984
 985     return $count;
 986 }
 987
 988 # it's true, baby ;-)
 989
 990 1;
 991
 992 #
 993 ### Ende ###