1 #----------------------------------------------------------------------
3 #----------------------------------------------------------------------
7 UVformats - Methoden zur Stringformatierung
14 fill-left <width> <character>
15 fill-right <width> <character>
16 fill-center <width> <character>
18 justify <name-of-key> <width>
19 justify-before <name-of-key> <width>
20 justify-behind <name-of-key> <width>
26 multi-graph <width> <position> <count>
27 multi-line <width> <count>
30 replace <original-string> <replacement-string>
31 sprintf <format-string>
37 Dieses Modul stellt verschiedenste Methoden bereit, um die Strings in
38 den Templates auf die unterschiedlichste Art zu formatieren.
40 Dieses Modul beschraenkt sich auf die Beschreibung der Funktionen. Ihre
41 Einbindung wird in UVtemplates beschrieben.
49 #----------------------------------------------------------------------
52 use vars qw(@ISA @EXPORT $VERSION $functions);
58 @EXPORT = qw( getFunctions );
61 #use POSIX qw(strftime);
64 #----------------------------------------------------------------------
70 #----------------------------------------------------------------------
73 Gibt den Wert eines Schluessel zurueck.
75 new-key := value 'old-key' | <other-functions> ...
77 Diese Funktion sollte dann eingesetzt werden, wenn man einen virtuellen
78 Schluessel erzeugen will. D.h. der Bezeichner nicht im Template als
79 Schluessel vorhanden ist. Durch den Einsatz von value wird der Wert eines
80 anderen Schluessel kopiert und kann dann weiter formatiert werden.
85 my ($data, $value, $key) = @_;
86 return $data->getKey($key);
89 #----------------------------------------------------------------------
93 Den Wert eines anderen Schluessels an den bisherigen String anhaengen.
95 ... | append 'other-key' | ...
97 Per default wird als Trenner der beiden String ein Leerzeichen verwendet.
98 Soll dieses entfallen oder ein anderes Zeichen benutzt werden, so kann
99 ein dementsprechender drittere Parameter angegeben werden.
101 ... | append 'other-key' '' | ...
102 ... | append 'other-key' '_' | ...
104 Im ersten Beispiel wird der Wert von C<other-key> nahtlos hinzugefuegt.
105 Im zweiten statt des Leerzeichens '_' benutzt.
110 my ($data, $value, $key, $sep) = @_;
112 $sep = ' ' unless defined($sep);
114 return $value. $sep. $data->getConvKey($key);
117 #----------------------------------------------------------------------
119 =item fill-left, fill-right, fill-center
121 Fuellt den String entsprechend mit Zeichen auf bis die gewuenschte
122 Laenge erreicht ist. Bei C<fill-left> werden die Zeichen vorranggestellt,
123 bei C<fill-right> angehaengt. C<fill-center> verteilt die Zeichen
124 gleichmaessig vor und nach dem String.
126 ... | fill-left 72 '.' | ...
128 Wird kein zweiter Parameter angegeben, wird automatisch das Leerzeichen
131 ... | fill-right 60 | ...
133 Ist der String bereits laenger als gewuenscht, wird er nicht weiter
134 veraendert und auch nicht verkuerzt.
139 my ($data, $value, $width, $char) = @_;
142 $char = ' ' unless (defined($char) && length($char) == 1);
144 my $fill = $width - length($value);
146 $value = $char x $fill . $value if ($fill > 0);
152 my ($data, $value, $width, $char) = @_;
157 my $fill = $width - length($value);
159 $value .= $char x $fill if ($fill > 0);
165 my ($data, $value, $width, $char) = @_;
170 my $fill = $width - length($value);
173 my $left = int($fill / 2);
174 my $right = $fill - $left;
176 $value = $char x $left . $value . $char x $right;
182 #----------------------------------------------------------------------
184 =item justify, justify-before, justify-behind
186 Fuegt zwischen den existierenden String und dem Wert des angegebenen
187 Schluessel genau so viele Leerzeichen ein, damit die gewuenschte
188 Stringlaenge erreicht wird.
190 ... | justify-behind 'key' 72 | ...
192 C<justify-behind> haengt den Wert des Schluessel an das Ende des Strings,
193 C<justify-before> stellt es davor.
195 justify-behind: existing-string.........value-of-key
196 justify-before: value-of-key.........existing-string
198 C<justify> ist lediglich ein Alias auf C<justify-behind>.
200 Sind die beiden Strings zusammen länger als die gewuenschte
201 Zeilenlaenge, wird automatisch einen Zeilenbruch eingefuegt
202 und beide Zeilen entsprechend mit Leerzeichen gefuellt.
204 very-very-very-long-existing-string.........\n
205 ...................and-a-too-long-new-string
210 my ($data, $value, $key, $width) = @_;
211 return _justify( $value, $data->getConvKey($key), $width);
215 my ($data, $value, $key, $width) = @_;
216 return _justify( $data->getConvKey($key), $value, $width);
220 my ($lval, $rval, $width) = @_;
224 if (length($lval.$rval) >= $width ){
225 # wir basteln zwei zeilen
226 $lval .= $sep x ($width - length($lval));
227 $rval = $sep x ($width - length($rval)) . $rval;
229 return $lval."\n".$rval;
232 my $fill = $width - length($lval) - length($rval);
233 return $lval . $sep x $fill . $rval;
237 #----------------------------------------------------------------------
241 Gibt nur die ersten Worte eines Strings zurueck, die vollstaendig
242 innerhalb der angegebenen Laenge liegen.
247 my ($data, $value, $width) = @_;
249 my @words = split('\s+', $value);
252 $string .= shift(@words);
254 while(@words && (length($string) + length($words[0]) + 1) < $width){
255 $string .= ' ' . shift(@words);
263 Alle Woerter am Anfang des Strings entfernen, die komplett innerhalb
264 der angegebenen Laenge liegen.
269 my ($data, $value, $width) = @_;
271 my @words = split('\s+', $value);
273 # das erste "Wort" immer verwerfen, egal wie lang es ist
274 my $first = shift(@words);
275 my $length = length($first);
277 while (@words && ( $length + length($words[0]) + 1 ) < $width ){
278 $length += length($words[0]) + 1;
282 return join(' ', @words);
287 Zerlegt einen String in einen Array, in dem die einzelnen Zeilen nicht
288 laenger als die gewuenschte Anzahl Zeichen sind.
290 absatz := value 'key' | create-lines 72
292 Mit Hilfe dieser Funktion ist es moeglich, ueberlange Zeilen zu Absatzen
295 Die Funktion erzeugt intern eine Liste, die jeweils den Schluessel C<line>
296 mit dem entsprechenden String als Wert enthaelt.
298 Im Template wird der so Absatz dann mit Hilfe des Schleifen-Syntax
303 Achtung! Da die Funktion keinen String zurueckgibt, sollte sie am Ende
304 der Kette stehen, da die normalen Formatierungsfunktionen einen String
310 my ($data, $value, $width) = @_;
312 my @words = split('\s+', $value);
317 my $string .= shift(@words);
319 while(@words && (length($string) + length($words[0]) + 1) < $width){
320 $string .= ' ' . shift(@words);
323 my $new = $data->new( line => $string );
330 #----------------------------------------------------------------------
332 =item multi-graph, multi-line
334 Spezielle Funktionen, um eine bestimmte graphische Ausgabe fuer
335 Votings mit mehreren Abstimmungspunkten zu erzeugen:
337 Punkt 1 --------------------------+
338 Punkt 2a ------------------------+|
339 Punkt 2b -----------------------+||
340 Punkt 3 -----------------------+|||
345 C<multi-graph> ist hierbei für die Formatierung der einzelnen Abstimmungspunkte
348 multi-graph 'key' 'width' 'pos-key' 'max-key'
350 Der erste Parameter gibt den Schluessel an, dessen Wert als Abstimmungspunkt
351 ausgegeben werden soll. C<width> die Laenge des zu erzeugenden Strings.
352 C<pos-key> und C<max-key> sind die Namen der Schluessel, in denen stehen
353 muss, um den wievielten Abstimmungspunkt es sich handelt (per default 'pos')
354 und wieviele Abstimmungspunkte es insgesamt gibt ('anzpunkte').
356 C<multi-line> erzeugt einfach nur einen String in der gewuenschten
357 Laenge, der entsprechend der Anzahl der Abstimmungspunkte mit '|'
363 my ($data, $value, $width, $pkey, $okey) = @_;
366 my $pos = $data->getKey($pkey || 'pos');
367 my $of = $data->getKey($okey || 'anzpunkte');
371 $gfx = ' ---'.'-' x ($of-$pos) .'+'. '|' x ($pos - 1) if ($pos && $of);
373 if (length($value.$gfx) < $width){
374 $value = ' ' x ($width - length($value.$gfx)) . $value . $gfx;
376 }elsif (length($value.$gfx) > $width){
377 my @lines = _wrap($value, $width - length($gfx));
379 $value = shift(@lines) . $gfx;
380 $value = ' ' x ($width - length($value)) . $value;
383 $gfx = ' '.' ' x ($of-$pos) . '|' x ($pos) if ($pos && $of);
385 foreach my $line (@lines){
386 $value .= "\n".' ' x ($width - length($line.$gfx)) . $line . $gfx;
394 my ($data, undef, $width, $okey) = @_;
397 my $of = $data->getKey($okey || 'anzpunkte') || 0;
399 return ' ' x ($width - $of) . '|' x $of;
404 my ($string, $width) = @_;
406 my @words = split('\s+', $string);
411 my $line .= shift(@words);
413 while(@words && (length($line) + length($words[0]) + 1) < $width){
414 $line .= ' ' . shift(@words);
424 #----------------------------------------------------------------------
428 Stellt in einem (mehrzeiligem) String jeder Zeile den gewuenschten
431 body := value 'body' | quote '> '
436 my ($data, $value, $quotechar) = @_;
438 $quotechar = '> ' unless defined($quotechar);
440 $value =~ s/^/$quotechar/mg;
445 #----------------------------------------------------------------------
449 Ersetzt in einem String ein oder mehrere Zeichen durch eine beliebige
450 Anzahl anderer Zeichen. Diese Funktion kann z.B. genutzt werden, um
451 beim Result die Mailadressen zu verfremden (Schutz vor Adress-Spidern).
453 mail := value 'mail' | replace '@' '-at-'
458 my ($data, $value, $original, $replacement) = @_;
460 $original = ' ' unless defined($original);
461 $replacement = ' ' unless defined($replacement);
463 $value =~ s/\Q$original\E/$replacement/g;
468 #----------------------------------------------------------------------
472 Gibt Text oder Zahlen mittels der Funktion sprintf formatiert aus
473 (siehe "man 3 sprintf" oder "perldoc -f sprintf").
475 proportion := value 'proportion' | sprintf '%6.3f'
480 my ($data, $value, $format) = @_;
482 $format = '%s' unless defined($format);
484 return sprintf($format, $value);
488 #----------------------------------------------------------------------
490 =item generate_date_header
492 Gibt ein Datum im RFC822-Format zur Verwendung im Date:-Header einer
495 date := generate_date_header
499 sub generate_date_header{
500 my ($data, $value, $format) = @_;
501 #return strftime('%a, %d %b %Y %H:%M:%S %z', localtime);
505 #----------------------------------------------------------------------
509 Gibt eine Message-ID im RFC822-Format zur Verwendung im Message-ID:-Header
512 msgid := generate_msgid
517 return ("<".$$.time().rand(999)."\@".$UVconfig::config{fqdn}.">");
521 #----------------------------------------------------------------------
524 %UVconfig::functions = ( %UVconfig::functions,
528 'fill-left' => \&fill_left,
529 'fill-right' => \&fill_right,
530 'fill-both' => \&fill_both,
532 justify => \&justify_behind,
533 'justify-behind' => \&justify_behind,
534 'justify-before' => \&justify_before,
536 'first-words' => \&first_words,
537 'drop-words' => \&drop_words,
539 'create-lines' => \&create_lines,
541 'multi-graph' => \&mgraph,
542 'multi-line' => \&mgline,
545 'replace' => \&replace,
546 'sprintf' => \&sprintf,
548 'generate-date-header' => \&generate_date_header,
549 'generate-msgid' => \&generate_msgid
555 #----------------------------------------------------------------------
565 Cornell Binder <cobi@dex.de>
566 Marc Langer <usevote@marclanger.de>