| 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 |