Update documentation from upstream.
[usenet/usevote.git] / UVformats.pm
1 #----------------------------------------------------------------------
2   package UVformats;
3 #----------------------------------------------------------------------
4
5 =head1 NAME
6
7 UVformats - Methoden zur Stringformatierung
8
9 =head1 SYNOPSIS
10
11   value  <name-of-key>
12   append <name-of-key>
13
14   fill-left   <width> <character>
15   fill-right  <width> <character>
16   fill-center <width> <character>
17
18   justify        <name-of-key> <width>
19   justify-before <name-of-key> <width>
20   justify-behind <name-of-key> <width>
21   
22   first-words  <width>
23   drop-words   <width>
24   create-lines <width>
25
26   multi-graph <width> <position> <count>
27   multi-line  <width> <count>
28
29   quote <string>
30   replace <original-string> <replacement-string>
31   sprintf <format-string>
32
33   generate_date_header
34
35 =head1 DESCRIPTION
36
37 Dieses Modul stellt verschiedenste Methoden bereit, um die Strings in 
38 den Templates auf die unterschiedlichste Art zu formatieren. 
39
40 Dieses Modul beschraenkt sich auf die Beschreibung der Funktionen. Ihre
41 Einbindung wird in UVtemplates beschrieben.
42
43 =head1 FUNCTIONS
44
45 =over 3
46
47 =cut
48
49 #----------------------------------------------------------------------
50
51 use strict;
52 use vars qw(@ISA @EXPORT $VERSION $functions);
53
54 use Exporter;
55 $VERSION = 0.01;
56
57 @ISA = qw(Exporter);
58 @EXPORT = qw( getFunctions );
59
60 use Text::Wrap;
61 #use POSIX qw(strftime);
62 use Email::Date;
63
64 #----------------------------------------------------------------------
65
66 sub getFunctions{
67   return $functions;
68 }
69
70 #----------------------------------------------------------------------
71 =item value
72
73 Gibt den Wert eines Schluessel zurueck. 
74
75   new-key := value 'old-key' | <other-functions> ...
76
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.
81
82 =cut
83
84 sub value{
85   my ($data, $value, $key) = @_;
86   return $data->getKey($key);
87 }
88
89 #----------------------------------------------------------------------
90
91 =item append
92
93 Den Wert eines anderen Schluessels an den bisherigen String anhaengen.
94
95   ... | append 'other-key' | ...
96
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.
100
101   ... | append 'other-key' ''  | ...
102   ... | append 'other-key' '_' | ...
103
104 Im ersten Beispiel wird der Wert von C<other-key> nahtlos hinzugefuegt.
105 Im zweiten statt des Leerzeichens '_' benutzt.
106
107 =cut
108
109 sub append{
110   my ($data, $value, $key, $sep) = @_;
111
112   $sep = ' ' unless defined($sep);
113
114   return $value. $sep. $data->getConvKey($key);
115 }
116
117 #----------------------------------------------------------------------
118
119 =item fill-left, fill-right, fill-center
120
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.
125
126   ... | fill-left 72 '.' | ...
127
128 Wird kein zweiter Parameter angegeben, wird automatisch das Leerzeichen
129 benutzt.
130
131   ... | fill-right 60 | ...
132
133 Ist der String bereits laenger als gewuenscht, wird er nicht weiter
134 veraendert und auch nicht verkuerzt.
135
136 =cut
137
138 sub fill_left{ 
139   my ($data, $value, $width, $char) = @_;
140
141   $width ||= 72;
142   $char  = ' ' unless (defined($char) && length($char) == 1);
143
144   my $fill = $width - length($value);
145
146   $value = $char x $fill . $value if ($fill > 0);
147
148   return $value;
149 }
150
151 sub fill_right{ 
152   my ($data, $value, $width, $char) = @_;
153
154   $width ||= 72;
155   $char  ||= ' ';
156
157   my $fill = $width - length($value);
158
159   $value .= $char x $fill if ($fill > 0);
160
161   return $value;
162 }
163
164 sub fill_both{ 
165   my ($data, $value, $width, $char) = @_;
166
167   $width ||= 72;
168   $char  ||= ' ';
169
170   my $fill = $width - length($value);
171   
172   if ($fill > 0){
173     my $left  = int($fill / 2);
174     my $right = $fill - $left;
175
176     $value = $char x $left . $value . $char x $right; 
177   }
178
179   return $value;
180 }
181
182 #----------------------------------------------------------------------
183
184 =item justify, justify-before, justify-behind
185
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.
189
190   ... | justify-behind 'key' 72 | ...
191
192 C<justify-behind> haengt den Wert des Schluessel an das Ende des Strings,
193 C<justify-before> stellt es davor.
194
195   justify-behind: existing-string.........value-of-key
196   justify-before: value-of-key.........existing-string
197
198 C<justify> ist lediglich ein Alias auf C<justify-behind>.
199
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.
203
204   very-very-very-long-existing-string.........\n
205   ...................and-a-too-long-new-string
206
207 =cut
208
209 sub justify_behind{
210   my ($data, $value, $key, $width) = @_;
211   return _justify( $value, $data->getConvKey($key), $width);
212 }
213
214 sub justify_before{
215   my ($data, $value, $key, $width) = @_;
216   return _justify( $data->getConvKey($key), $value, $width);
217 }
218
219 sub _justify{
220   my ($lval, $rval, $width) = @_;
221
222   my $sep = ' ';
223
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;
228
229     return $lval."\n".$rval;
230
231   }else{
232     my $fill = $width - length($lval) - length($rval);
233     return $lval . $sep x $fill . $rval;
234   }
235 }
236
237 #----------------------------------------------------------------------
238
239 =item first-words
240
241 Gibt nur die ersten Worte eines Strings zurueck, die vollstaendig
242 innerhalb der angegebenen Laenge liegen.
243
244 =cut
245
246 sub first_words{
247   my ($data, $value, $width) = @_;
248
249   my @words = split('\s+', $value);
250   my $string;
251
252   $string .= shift(@words);
253
254   while(@words && (length($string) + length($words[0]) + 1) < $width){
255     $string .= ' ' . shift(@words);
256   }
257
258   return $string;
259 }
260
261 =item drop-words
262
263 Alle Woerter am Anfang des Strings entfernen, die komplett innerhalb
264 der angegebenen Laenge liegen.
265
266 =cut
267
268 sub drop_words{
269   my ($data, $value, $width) = @_;
270
271   my @words = split('\s+', $value);
272
273   # das erste "Wort" immer verwerfen, egal wie lang es ist
274   my $first  = shift(@words);
275   my $length = length($first);
276
277   while (@words && ( $length + length($words[0]) + 1 ) < $width ){
278     $length += length($words[0]) + 1;
279     shift(@words);
280   }
281
282   return join(' ', @words);
283 }
284
285 =item create-lines
286
287 Zerlegt einen String in einen Array, in dem die einzelnen Zeilen nicht
288 laenger als die gewuenschte Anzahl Zeichen sind.
289
290   absatz := value 'key' | create-lines 72 
291
292 Mit Hilfe dieser Funktion ist es moeglich, ueberlange Zeilen zu Absatzen
293 umzuformatieren.
294
295 Die Funktion erzeugt intern eine Liste, die jeweils den Schluessel C<line>
296 mit dem entsprechenden String als Wert enthaelt. 
297
298 Im Template wird der so Absatz dann mit Hilfe des Schleifen-Syntax
299 eingebunden:
300
301   [@absatz|[line]\n]
302
303 Achtung! Da die Funktion keinen String zurueckgibt, sollte sie am Ende
304 der Kette stehen, da die normalen Formatierungsfunktionen einen String
305 als Input erwartern!
306
307 =cut
308
309 sub create_lines{
310   my ($data, $value, $width) = @_;
311
312   my @words = split('\s+', $value);
313
314   my @lines;
315
316   while (@words){
317     my $string .= shift(@words);
318
319     while(@words && (length($string) + length($words[0]) + 1) < $width){
320       $string .= ' ' . shift(@words);
321     }
322
323     my $new = $data->new( line => $string );
324     push(@lines, $new);
325   }
326
327   return \@lines;
328 }
329
330 #----------------------------------------------------------------------
331
332 =item multi-graph, multi-line
333
334 Spezielle Funktionen, um eine bestimmte graphische Ausgabe fuer
335 Votings mit mehreren Abstimmungspunkten zu erzeugen:
336
337   Punkt 1 --------------------------+
338   Punkt 2a ------------------------+|
339   Punkt 2b -----------------------+||
340   Punkt 3 -----------------------+|||
341                                  ||||
342   Name of Voter 1                jjnn
343   Name of Voter 2                nnjj
344
345 C<multi-graph> ist hierbei für die Formatierung der einzelnen Abstimmungspunkte 
346 zustaendig.
347
348   multi-graph 'key' 'width' 'pos-key' 'max-key'
349
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').
355
356 C<multi-line> erzeugt einfach nur einen String in der gewuenschten
357 Laenge, der entsprechend der Anzahl der Abstimmungspunkte mit '|'
358 abschliesst.
359
360 =cut
361
362 sub mgraph{
363   my ($data, $value, $width, $pkey, $okey) = @_;
364   return unless $data;
365
366   my $pos = $data->getKey($pkey || 'pos');
367   my $of  = $data->getKey($okey || 'anzpunkte');
368
369   my $gfx = '';
370   
371   $gfx = ' ---'.'-' x ($of-$pos) .'+'. '|' x ($pos - 1) if ($pos && $of);
372
373   if (length($value.$gfx) < $width){
374     $value = ' ' x ($width - length($value.$gfx)) . $value . $gfx;
375
376   }elsif (length($value.$gfx) > $width){
377     my @lines = _wrap($value, $width - length($gfx));
378    
379     $value = shift(@lines) . $gfx;
380     $value = ' ' x ($width - length($value)) . $value;
381
382     # Hilfzeile erzeugen
383     $gfx = '    '.' ' x ($of-$pos) . '|' x ($pos) if ($pos && $of);
384
385     foreach my $line (@lines){
386       $value .= "\n".' ' x ($width - length($line.$gfx)) . $line . $gfx;
387     }
388   }
389
390   return $value;
391 }
392
393 sub mgline{
394   my ($data, undef, $width, $okey) = @_;
395   return unless $data;
396
397   my $of = $data->getKey($okey || 'anzpunkte') || 0;
398
399   return ' ' x ($width - $of) . '|' x $of;
400 }
401
402
403 sub _wrap{
404   my ($string, $width) = @_;
405
406   my @words = split('\s+', $string);
407
408   my @lines;
409
410   while (@words){
411     my $line .= shift(@words);
412
413     while(@words && (length($line) + length($words[0]) + 1) < $width){
414       $line .= ' ' . shift(@words);
415     }
416
417     push(@lines, $line);
418   }
419
420   return @lines;
421 }
422
423
424 #----------------------------------------------------------------------
425
426 =item quote
427
428 Stellt in einem (mehrzeiligem) String jeder Zeile den gewuenschten
429 Quotestring voran.
430
431   body := value 'body' | quote '> '
432
433 =cut
434
435 sub quote{
436   my ($data, $value, $quotechar) = @_;
437
438   $quotechar = '> ' unless defined($quotechar);
439
440   $value =~ s/^/$quotechar/mg;
441   return $value;
442 }
443
444
445 #----------------------------------------------------------------------
446
447 =item replace
448
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).
452
453   mail := value 'mail' | replace '@' '-at-'
454
455 =cut
456
457 sub replace{
458   my ($data, $value, $original, $replacement) = @_;
459
460   $original = ' ' unless defined($original);
461   $replacement = ' ' unless defined($replacement);
462
463   $value =~ s/\Q$original\E/$replacement/g;
464   return $value;
465 }
466
467
468 #----------------------------------------------------------------------
469
470 =item sprintf
471
472 Gibt Text oder Zahlen mittels der Funktion sprintf formatiert aus
473 (siehe "man 3 sprintf" oder "perldoc -f sprintf").
474
475   proportion := value 'proportion' | sprintf '%6.3f'
476
477 =cut
478
479 sub sprintf{
480   my ($data, $value, $format) = @_;
481
482   $format = '%s' unless defined($format);
483
484   return sprintf($format, $value);
485 }
486
487
488 #----------------------------------------------------------------------
489
490 =item generate_date_header
491
492 Gibt ein Datum im RFC822-Format zur Verwendung im Date:-Header einer
493 Mail aus.
494
495   date := generate_date_header
496
497 =cut
498
499 sub generate_date_header{
500   my ($data, $value, $format) = @_;
501   #return strftime('%a, %d %b %Y %H:%M:%S %z', localtime);
502   return format_date;
503 }
504
505 #----------------------------------------------------------------------
506
507 =item generate_msgid
508
509 Gibt eine Message-ID im RFC822-Format zur Verwendung im Message-ID:-Header
510 einer Mail aus.
511
512   msgid := generate_msgid
513
514 =cut
515
516 sub generate_msgid{
517   return ("<".$$.time().rand(999)."\@".$UVconfig::config{fqdn}.">");
518 }
519
520
521 #----------------------------------------------------------------------
522
523 BEGIN{
524   %UVconfig::functions = ( %UVconfig::functions,
525     value               => \&value,
526     append              => \&append,
527
528     'fill-left'         => \&fill_left,
529     'fill-right'        => \&fill_right,
530     'fill-both'         => \&fill_both,
531
532     justify             => \&justify_behind,
533     'justify-behind'    => \&justify_behind,
534     'justify-before'    => \&justify_before,
535
536     'first-words'       => \&first_words,
537     'drop-words'        => \&drop_words,
538
539     'create-lines'      => \&create_lines,
540
541     'multi-graph'       => \&mgraph,
542     'multi-line'        => \&mgline,
543
544     'quote'             => \&quote,
545     'replace'           => \&replace,
546     'sprintf'           => \&sprintf,
547
548     'generate-date-header' => \&generate_date_header,
549     'generate-msgid'    => \&generate_msgid
550   );
551 }
552
553 1;
554
555 #----------------------------------------------------------------------
556
557 =back
558
559 =head1 SEE ALSO
560
561 L<UVtemplate>
562
563 =head1 AUTHOR
564
565 Cornell Binder <cobi@dex.de>
566 Marc Langer <usevote@marclanger.de>
This page took 0.024691 seconds and 3 git commands to generate.