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

patrick-canterino.de