Add correct timestamp to mbox when processing.
[usenet/usevote.git] / UVtemplate.pm
1 #----------------------------------------------------------------------
2 package UVtemplate;
3 #----------------------------------------------------------------------
4
5 =head1 NAME
6
7 UVtemplate - Templateverarbeitung und String-Formatierungen
8
9 =head1 SYNOPSIS
10
11   use UVtemplate;
12
13   $plate  = UVtemplate->new([%keys]);
14
15             $plate->setKey(%keys);
16   $item   = $plate->addListItem($name, %keys);
17
18   $string = $plate->processTemplate($file);
19
20 =head1 DESCRIPTION
21
22 Mit Hilfe von UVtemplate, wird die komplette Aufbereitung und 
23 Formatierung der Programmausgaben nicht nur ausgelagert sondern
24 auch so flexibiliert, dass sie jederzeit angepasst werden kann,
25 ohne das im eigentlichen Programmcode veraendert werden muss.
26
27 Auf Programmseite wird eine Datenstruktur mit Schluessel-Wert
28 Paaren erzeugt. In den Template-Dateien werden dann spaeter die
29 jeweiligen Schluessel, durch ihre im Programm festgelegten 
30 Werte ersetzt. Zusaetzlich ist es moeglich Schluessel zu Listen
31 zusammenzufassen.
32
33 Da es sich bei den Templates um Ascii-Texte handelt, gibt es 
34 zusaetzlich die Moeglichkeit die Werte der Schluessel zuformatieren
35 um eine einheitliche Ausgabe zu ermoeglichen. D.h. es kann z.B. durch 
36 das Anhaengen von Leerzeichen dafuer gesorgt werden, das ein Schluessel
37 einer Liste immer 60 Zeichen lang ist um ansehnliche Tabellen auszugeben.
38
39 =head1 FUNCTIONS
40
41 =over 3
42
43 =cut
44
45 #----------------------------------------------------------------------
46
47 use strict;
48 use vars qw( $VERSION $functions @dirs);
49 use UVconfig;
50
51 $VERSION = 0.1;
52
53 #----------------------------------------------------------------------
54
55 =item new
56
57 Eine neues Objekt vom Typ UVtemplate anlegen. 
58
59   my $plate = UVtemplate->new();
60
61 Als Parameter koennen gleich beliebig viele Schluessel-Wert-Paare
62 uebergeben werden.
63
64 =cut
65
66 sub new{
67   my $class = shift;
68   my $self  = {};
69
70   if (ref($class)){
71     $self->{FATHER} = $class;
72     bless($self, ref($class));
73
74   }else{
75     bless($self, $class);
76   }
77
78   $self->setKey(@_);
79
80   return $self;
81 }
82
83 =item setKey
84
85 Schluessel und zugehoerige Werte im Objekt speichern.
86
87   $plate->setKey( vote-addr => 'to-vote@dom.ain' );
88   $plate->setKey( datenschutz => 1);
89
90 Ist der zu speichernde Schluessel bereits vorhanden, wird er
91 durch den neuen Wert ueberschrieben.
92
93 =cut
94
95 sub setKey{
96   my $self = shift;
97   my %param = @_;
98
99   foreach my $key (keys(%param)){
100     $self->{KEYS}->{$key} = $param{$key};
101   }
102 }
103
104 =item addListItem
105
106 Erzeugt ein neues Objekt vom Typ UVtemplate und fuegt es der 
107 angebenen Liste hinzu.
108
109   $plate->addListItem(name => 'Musterman', email => 'em@il');
110
111 Da sich Listen wie normale Schluessel-Wert Paare verhalten, 
112 wird die Liste als Array ueber UVtemplate-Objekte unter dem
113 definiertem Schluessel abgelegt. Ist dieser Schluessel bereits
114 gesetzt und enthaehlt keinen Array, so bricht die Funktion ab.
115
116 =cut
117
118 sub addListItem{
119   my $self = shift;
120   my $list = shift;
121
122   # pruefen ob key angegeben ist und falls key vorhanden
123   # eine liste vorliegt
124   return unless ($list && (not($self->{KEYS}->{$list}) ||
125     UNIVERSAL::isa($self->{KEYS}->{$list}, 'ARRAY')));
126
127   # neues Element erzeugen
128   my $new = $self->new( @_ );
129
130   # an listen anhaengen
131   push(@{$self->{KEYS}->{$list}}, $new);
132
133   # referenz zurueckgeben
134   return $new;
135 }
136
137 =item getKey($key)
138
139 Den Wert eines Schluessel ermitteln.
140
141   my $value = $plate->getKey('email');
142
143 Ist der Wert im Objekt nicht gesetzt, wird - falls es sich um ein
144 Element einer Liste handelt - rekursiv beim Vater weiter gesucht.
145
146 So stehen allen Kindern auch die Schluessel-Wert Paare ihrer Eltern
147 zur Verfuegung.
148
149 Zum Schluss wird noch geprueft, ob der Schluessel in usevote.cfg
150 gesetzt wurde. Dadurch sind alle Konfigurationsoptionen direkt
151 in Templates nutzbar.
152
153 =cut
154
155 sub getKey{
156   my $self = shift;
157   my $key  = $_[0];
158
159   my $value;
160
161   do{
162     $value = $self->{KEYS}->{$key};
163     $self  = $self->{FATHER};
164
165   }while(!defined($value) && $self);
166
167   if (!defined($value) && defined($config{$key})) {
168     $value = $config{$key};
169   }
170
171   return $value;
172 }
173
174 #----------------------------------------------------------------------
175
176 sub getRules{
177   my $self = shift;
178
179   do{
180     return $self->{RULES} if ($self->{RULES});
181     $self = $self->{FATHER};
182   }while($self);
183
184   return;
185 }
186
187 =item getConvKey{
188
189 Einen Format ermitteln.
190
191   my $value = $plate->getConvKey('email-adresse');
192
193 Diese Funktion ueberprueft ob eine Formatierung mit den entsprechenden
194 Schluessel definiert ist und ruft dementsprechend die dort definierten
195 Funktionen ueber der Datenstruktur auf.
196
197 Ist kein solches Format definiert, wird der Wert des Schluessel mit
198 einem solchen Namen zurueckgegeben. (Es wird intern getKey aufgerufen).
199
200 =cut
201
202 sub getConvKey{
203   my $self = shift;
204   my $key  = $_[0] || return;
205
206   my $rules = $self->getRules();
207   my $value = $self->getKey($key);
208   
209   $value = '' unless (defined($value));
210
211   if ($rules && ($rules->{$key})){
212     my @funcs = @{$rules->{$key}};
213
214     foreach my $func (@funcs){
215       my ($name, @params) = @$func;
216   
217       if ($functions->{$name}){
218         $value = $functions->{$name}->($self, $value, @params);
219     
220       }else{
221         print STDERR "format function '$name' not found!\n";
222       }
223     }
224   }
225
226   return $value;
227 }
228
229 #----------------------------------------------------------------------
230
231 =item processTemplate
232
233 Daten des Objekts in ein Template einfuegen.
234
235   my $string = $plate->processTemplate('template/info.txt');
236
237 Die angebene Datei wird eingelesen, zerlegt und danach
238 die enstprechenden Platzhalter durch die (formatierten) 
239 Werte aus der Datenstruktur ersetzt.
240
241 =cut
242
243 sub processTemplate{
244   my $self = shift;
245   my $file = $_[0] || return;
246
247   my ($rules, $body) = _split_file($file);
248
249   # konvertierungsregeln parsen
250   $self->{RULES} = _parse_rules($rules);
251
252   # template zerlegen (zuerst fuehrende leerzeilen entfernen!)
253   $body =~ s/^\n+//s;   
254   my $token = UVtemplate::scan->new(string => $body);
255
256   # daten einsetzen
257   return $token->processData($self);
258 }
259
260 sub _split_file{
261   my $file = $_[0] || return;
262
263   my $fname = _complete_filename($file);
264
265   unless ($fname){
266     print STDERR "couldnt find '$file'\n";
267     return;
268   }
269
270   my (@rules, @body);
271
272   open(PLATE, $fname);
273   my @lines = <PLATE>;
274   close(PLATE);
275
276   my $body = 0;
277
278   foreach my $line (@lines){
279     if ($line =~ m/^== TEMPLATE/){
280       $body = 1;
281
282     }else{
283       if ($body){
284         push(@body, $line);
285
286       }else{
287         push(@rules, $line);
288       }
289     }
290   }
291
292   # falls kein Separator definiert war, wird der komplette Text
293   # als Body interpretiert. Es gibt keine Regeln!
294   
295   unless ($body){
296     @body  = @rules;
297     @rules = ();
298   }
299
300   # und nun wieder zu Strings zusammenpappen
301   return (join('', @rules), join('', @body));
302 }
303
304 sub _complete_filename{
305   my $file = $_[0] || return;
306
307   my $dirs = $UVconfig::config{templatedir};
308      @dirs = split(/\s*,\s*/, $dirs) if $dirs;
309
310   my $fname;
311
312   foreach my $dir (@dirs, '.'){
313     $fname = "$dir/$file";
314     return $fname if (-r $fname);
315   }
316 }
317
318 #----------------------------------------------------------------------
319 # Konvertierungs-Regeln
320 #----------------------------------------------------------------------
321
322 sub _parse_rules{
323   my $string = $_[0] || return;
324
325   my @stack;
326   my $rules = {};
327
328   my $this = [];
329     
330   while (length($string) > 0){
331     _strip_chars(\$string);
332
333     my $token = _parse_token(\$string);
334
335     if ($token){
336       push(@stack, $token);
337       
338       _strip_chars(\$string);
339
340       if ($string =~ s/^:=//){
341         # neuen Schluessel vom Stack holen
342         my $key = pop(@stack);
343         
344         # restlichen Stack auf alten Schluessel packen
345         push(@$this, [ @stack ]);
346         @stack = ();
347
348         # neuen Schluessel anlegen
349         $rules->{$key} = $this = [];
350
351       }elsif($string =~ s/^\|//){
352         # stack auf schluessel packen
353         push(@$this, [ @stack ]);
354         @stack = ();
355       }
356
357     }else{
358       # fehlermeldung ausgeben (nacharbeiten!)
359       print STDERR "Syntaxerror in Definition\n";
360       return;
361     }
362   }
363
364   # den Rest vom Stack abarbeiten
365   push(@$this, [ @stack ]) if @stack;
366
367   return $rules;
368 }
369
370 sub _strip_chars{
371   my $line = $_[0] || return;
372
373   # führenden whitespace entfernen
374   $$line =~ s/^\s+//;
375
376   # kommentare bis zum nächsten Zeilenumbruch entfernen
377   $$line =~ s/^#.*$//m;
378 }
379
380
381 sub _parse_token{
382   my $string = shift;
383
384   if ($$string =~ s/^(["'])//){
385     return _parse_string($string, $1);
386
387   }else{
388     return _parse_ident($string);
389   }
390 }
391
392
393 sub _parse_string{
394   my ($string, $limit) = @_;
395
396   my $value;
397
398   while ($$string){
399     if ($$string =~ s/^$limit//){
400       $$string =~ s/^\s*//;
401       return $value;
402
403     }elsif($$string =~ s/^\\(.)//){
404       $value .= $1;
405     
406     }else{
407       $$string =~ s/^[^$limit\\]*//;
408       $value .= $&;
409     }
410   }
411
412   # end of line 
413   return $value;
414 }
415
416
417 sub _parse_ident{
418   my $string = shift;
419
420   if ($$string =~ s/^([A-Za-z0-9-]+)\s*//){
421     return $1;
422   }
423
424   return;
425 }
426
427 #----------------------------------------------------------------------
428
429 BEGIN{
430   $functions = \%UVconfig::functions;
431 }
432
433 #----------------------------------------------------------------------
434 #----------------------------------------------------------------------
435 package UVtemplate::scan;
436 #----------------------------------------------------------------------
437 #----------------------------------------------------------------------
438
439 sub new{
440   my $class = shift;
441   my %param = @_;
442
443   my $self  = {};
444   bless($self, $class);
445
446   $self->parseFile($param{file})     if defined($param{file});
447   $self->parseString($param{string}) if defined($param{string});
448
449   return $self;
450 }
451
452 #----------------------------------------------------------------------
453
454 sub processData{
455   my $self = shift;
456   my $data = $_[0];
457
458   return _process_data($self->{toks}, $data);
459 }
460
461 sub _process_data{
462   my ($toref, $data) = @_;
463   
464   my $string = '';
465   my $length = 0;
466   my $empty  = 0;
467
468   foreach my $token (@$toref){
469     if (ref($token)){
470       my $before = length($string);
471          $empty  = 0;
472     
473       if ($token->[0] eq 'VAR'){
474         my $value = $data->getConvKey(_process_data($token->[1], $data));
475       
476         if (defined($value) && length($value)){
477           $string .= $value;
478
479         }else{
480           $string .= _process_data($token->[2], $data);
481         }
482
483       }elsif($token->[0] eq 'IF'){
484         if ($data->getConvKey(_process_data($token->[1], $data))){
485           $string .= _process_data($token->[2], $data);
486
487         }else{
488           $string .= _process_data($token->[3], $data);
489         }
490      
491       }elsif($token->[0] eq 'LOOP'){
492         my $nodes = $data->getConvKey(_process_data($token->[1], $data));
493         my @block;
494
495         if ($nodes && (UNIVERSAL::isa($nodes, 'ARRAY'))){
496           foreach my $node (@$nodes){
497             push(@block, _process_data($token->[2], $node));
498           }
499
500           $string .= join(_process_data($token->[3], $data), @block);
501         }
502       }
503
504       $length = length($string);
505       $empty  = 1 if ($before == $length);
506
507     }else{
508       if ($empty && ($string =~ m/(\n|^)$/s)){
509         $empty = 0;             # Falls die letzte Zeile nur aus einem Token
510         $token =~ s/^\n//s;     # ohne Inhalt bestand, wird die Zeile entfernt
511       }
512     
513       $string .= $token;
514     }
515   }
516
517   return $string;
518 }
519
520 #----------------------------------------------------------------------
521 # Den String in einen Syntaxbaum abbilden
522
523 sub _parse_token_string{
524   my $self   = shift;
525   my ($string, $intern) = @_;
526
527   my (@token, $toref); 
528   my $data = '';
529
530   while ($string){
531     if ($intern && $string =~ m/^(\]|\|)/){
532       last;
533   
534     }elsif ($string =~ s/^\[//){
535       my $orig = $string;
536     
537       ($toref, $string) = $self->_parse_token($string);
538
539       if (@$toref){
540         push (@token, $data) if $data;
541         $data = '';
542
543         push(@token, $toref) 
544       }
545
546       if ($string !~ s/^\]//){
547         my $pos = $self->{lines} - _count_lines($orig) + 1;
548
549         print STDERR "Scanner: [$pos] missing right bracket\n";
550         return (\@token, $string);
551       }
552       
553     }elsif($string =~ s/^\\n//s){
554       $data .= "\n";
555
556     }elsif($string =~ s/^\\(.)//s){
557       $data .= $1;
558
559     }elsif($intern){
560       $string =~ s/^([^\]\[\|\\]+)//s;
561       $data  .= $1;
562     
563     }else{
564       $string =~ s/^([^\[\\]+)//s;
565       $data  .= $1;
566     } 
567   }
568
569   push (@token, $data) if length($data);
570   return (\@token, $string)
571 }
572
573
574 sub _parse_token{
575   my $self   = shift; 
576   my $string = $_[0];
577
578   my @token = ();
579   
580   if ($string =~ s/^\$//s){ 
581     # Variablen - Syntax: [$key[|<else>]] 
582     push (@token, 'VAR');
583
584   }elsif ($string =~ s/^\?//s){
585     # Bedingung - Syntax: [?if|<then>[|<else>]]
586     push (@token, 'IF');
587
588   }elsif ($string =~ s/^\@//s){
589     # Schleifen - Syntax: [@key|<block>[|<sep>]]
590     push (@token, 'LOOP');
591
592   }elsif ($string =~ s/^#//s){
593     # Kommentare - Syntax: [# ... ]
594     $string = _parse_comment($string);
595
596     return (\@token, $string);
597     
598   }else{
599     print STDERR "unknown token in template\n";
600   }
601
602   my $toref;
603
604   ($toref, $string) = $self->_parse_token_string($string, 1);
605   push(@token, $toref);
606
607   while ($string =~ s/^\|//){
608     ($toref, $string) = $self->_parse_token_string($string, 1);
609     push(@token, $toref);
610   }
611
612   return (\@token, $string);
613 }
614
615
616 sub _parse_comment{
617   my $string = $_[0];
618   my $count  = 1;
619
620   while($string && $count) {
621     $string =~ s/^[^\[\]\\]+//s; # alles außer Klammern und Backslash wegwerfen
622     $string =~ s/^\\.//;        # alles gesperrte löschen
623
624     $count++ if $string =~ s/^\[//;
625     $count-- if $string =~ s/^\]//;
626   }
627
628   $string = ']'.$string if !$count;
629   return $string;
630 }
631
632 #----------------------------------------------------------------------
633
634 sub parseString{
635   my $self = shift;
636   my $text = $_[0];  
637
638   $self->{lines} = _count_lines($text);
639   my ($toref, $rest) = $self->_parse_token_string($text);
640
641   $self->{toks} = $toref;
642 }
643
644
645 sub _count_lines{
646   return 0 unless defined($_[0]);
647
648   my ($string, $count) = ($_[0], 1);
649   $count++ while($string =~ m/\n/sg);
650
651   return $count;
652 }
653
654 #----------------------------------------------------------------------
655 #----------------------------------------------------------------------
656 #----------------------------------------------------------------------
657
658 1;
659
660 =back
661
662 =head1 SYNTAX
663
664 Eine Templatedatei besteht aus zwei Teilen. Am Anfang werden die 
665 Formatierungen bestimmter Schluessel definiert und nach einem
666 Trenner folgt der eigentlich Template-Koerper, der dann von Programm
667 bearbeitet und ausgegeben wird.
668
669   format-key := function1 param | function2 param
670
671   == TEMPLATE ====================================
672
673   Ich bin nun das eigentliche Template:
674
675   format-key: [$format-key]
676
677 Der Trenner beginnt mit den Zeichen '== TEMPLATE' danach koennen
678 beliebige Zeichen folgen um die beiden Sektionen optisch voneinander 
679 abzugrenzen.
680
681 Wenn es keine Formatierungsanweisungen gibt, kann der Trenner auch
682 weggelassen werden. D.h. wenn kein Trenner gefunden wird, wird der
683 komplette Text als Template-Koerper betrachtet.
684
685 =head2 Template-Koerper
686
687 Im Template-Koerper werden die zu ersetzenden Token durch eckige
688 Klammern abgegrenzt. Sollen eckige Klammern im Text ausgegeben werden
689 muessen diese durch einen Backslash freigestellt werden.
690
691   [$termersetzung] [@schleife] nur eine \[ Klammer
692
693 =over 3
694
695 =item $ - Termersetzung 
696
697 Ersetzt den Token durch den Wert des angegeben Schluessels.
698
699   [$formatierung] [$schluessel]
700
701 Es wird zuerst nach einer Formatierung mit den entsprechenden
702 Bezeichner gesucht. Ist dies der Fall werden die entsprechenden
703 Funktionen ausgefuehrt.
704
705 Kann kein Format gefunden, wird direkt in der Datenstruktur
706 nach einem Schhluessel mit dem angegeben Bezeichner gesucht
707 und sein Wert eingesetzt.
708
709 Schlussendlich ist es noch moeglich einen default-Wert zu
710 definieren, der eingesetzt wird, wenn keiner der obigen Wege
711 erfolgreich war.
712
713   Hallo [$name|Unbekannter]!
714
715 =item ? - bedingte Verzeigung
716
717 Ueberprueft ob der Wert des angegebenen Formats/Schluessel
718 boolsch WAHR ist. Dementsprechend wird der then oder else
719 Block eingefuegt.
720
721   [?if|then|else] oder auch nur [?if|then]
722
723 Die then/else Bloecke werden natuerlich auch auf Tokens
724 geparst und diese dementsprechend ersetzt.
725
726 =item @ - Schleifen/Listen
727
728 Der nachfolgende Textblock wird fuer alle Elemente des durch
729 den Schluessel bezeichneten Arrays ausgefuehrt und eingefuegt.
730
731   [@schluessel|block] oder [@schluessel|block|sep]
732
733 Als zweiter Parameter kann ein Separtor definiert werden, mit
734 dem sich z.B. kommaseparierte Listen erzeugen lassen, da der
735 Separator eben nur zwischen den Element eingefuegt wird.
736
737 Auch fuer Schleifen koennen Formatierungen genutzt werden.
738 Allerdings darf kein String zurueckgegeben werden, sondern
739 ein Array mit einer Menge von UVtemplate-Objekten.
740
741 =item # - Kommentare
742
743 Token die nach der Bearbeitungen entfernt werden.
744
745   [# mich sieht man nicht]
746
747 =item Sonstiges
748
749 Um in Listen einen Zeilenumbruch zu erzwingen, muss 
750 lediglich ein '\n' eingefuegt werden, falls eine kompakte
751 Definition der Liste erfolgen soll.
752
753   [@names|[name] [email]\n]
754
755 =back
756
757 =head2 Formatierungen
758
759 Eine Formatierung besteht eigentlich nur aus dem entsprechenden
760 Namen und einer beliebigen Anzahl von Funktionsaufrufen:
761
762   format := funktion param1 "param 2" | funktion param
763
764 Aehnlich der Unix-Shell-Funktionalitaet, wird dabei die Ausgabe
765 einer Funktion an die folgende weitergeleitet. So ist es moeglich
766 verschiedenste simple Formatierungen zu kombinieren um nicht fuer
767 jeden Spezialfall eine neue Funktion schreiben zu muessen.
768
769 Die jeweilige Formatierungsfunktion erhaelt als Input die Datenstruktur,
770 den Output der vorherigen Funktion und die definierten Parameter in der
771 entsprechenden Reihenfolge.
772
773 Zahlen und einfache Bezeichner koennen direkt definiert werden. Sollen
774 Sonderzeichen oder Leerzeichen uebergeben werden muessen diese gequotet
775 werden. Dazu kann ' also auch " verwendet werden.
776
777 Die Funktionen geben im Allgemeinen einen String zurueck. Im Rahmen
778 von Listen können auch Arrays uebergeben werden.
779
780 Die erste Funktion duerfte ueblicherweise 'value' sein. Sie gibt den
781 des angegeben Schluessel zurueck, der dann von den folgenden Funktionen
782 definiert wird.
783
784   name-60 := value name | fill-right 60
785
786 Das Format "name-60" definiert also den Wert des Schluessel "name" der
787 um Leerzeichen aufgefuellt wird, bis eine Laenge von 60 Zeichen 
788 erreicht wird.
789
790   name-email := value name | justify-behind mail 72
791
792 "name-email" resultiert in einem String, der zwischen den Werten
793 von "name" und "email" genau so viele Leerzeichen enthaelt, damit
794 der gesamte String 72 Zeichen lang ist.
795
796 Wird dieses Format in einer Liste angewandt, erhaelt man eine Tabelle
797 in der die linke Spalte linksbuendig und die rechte Spalte entsprechend
798 rechtsbuendig ist.
799
800 Soweit ein kleiner Ueberblick ueber die Formatierungen. 
801 Ausfuehrliche Funktionsbeschreibungen und weitere Beispiele finden
802 sich in der Dokumentation des Moduls UVformat.
803
804 =head1 SEE ALSO
805
806 L<UVformats>
807
808 =head1 AUTHOR
809
810 Cornell Binder <cobi@dex.de>
This page took 0.031106 seconds and 3 git commands to generate.