#---------------------------------------------------------------------- package UVformats; #---------------------------------------------------------------------- =head1 NAME UVformats - Methoden zur Stringformatierung =head1 SYNOPSIS value append fill-left fill-right fill-center justify justify-before justify-behind first-words drop-words create-lines multi-graph multi-line quote replace sprintf generate_date_header =head1 DESCRIPTION Dieses Modul stellt verschiedenste Methoden bereit, um die Strings in den Templates auf die unterschiedlichste Art zu formatieren. Dieses Modul beschraenkt sich auf die Beschreibung der Funktionen. Ihre Einbindung wird in UVtemplates beschrieben. =head1 FUNCTIONS =over 3 =cut #---------------------------------------------------------------------- use strict; use vars qw(@ISA @EXPORT $VERSION $functions); use Exporter; $VERSION = 0.01; @ISA = qw(Exporter); @EXPORT = qw( getFunctions ); use Text::Wrap; #use POSIX qw(strftime); use Email::Date; #---------------------------------------------------------------------- sub getFunctions{ return $functions; } #---------------------------------------------------------------------- =item value Gibt den Wert eines Schluessel zurueck. new-key := value 'old-key' | ... Diese Funktion sollte dann eingesetzt werden, wenn man einen virtuellen Schluessel erzeugen will. D.h. der Bezeichner nicht im Template als Schluessel vorhanden ist. Durch den Einsatz von value wird der Wert eines anderen Schluessel kopiert und kann dann weiter formatiert werden. =cut sub value{ my ($data, $value, $key) = @_; return $data->getKey($key); } #---------------------------------------------------------------------- =item append Den Wert eines anderen Schluessels an den bisherigen String anhaengen. ... | append 'other-key' | ... Per default wird als Trenner der beiden String ein Leerzeichen verwendet. Soll dieses entfallen oder ein anderes Zeichen benutzt werden, so kann ein dementsprechender drittere Parameter angegeben werden. ... | append 'other-key' '' | ... ... | append 'other-key' '_' | ... Im ersten Beispiel wird der Wert von C nahtlos hinzugefuegt. Im zweiten statt des Leerzeichens '_' benutzt. =cut sub append{ my ($data, $value, $key, $sep) = @_; $sep = ' ' unless defined($sep); return $value. $sep. $data->getConvKey($key); } #---------------------------------------------------------------------- =item fill-left, fill-right, fill-center Fuellt den String entsprechend mit Zeichen auf bis die gewuenschte Laenge erreicht ist. Bei C werden die Zeichen vorranggestellt, bei C angehaengt. C verteilt die Zeichen gleichmaessig vor und nach dem String. ... | fill-left 72 '.' | ... Wird kein zweiter Parameter angegeben, wird automatisch das Leerzeichen benutzt. ... | fill-right 60 | ... Ist der String bereits laenger als gewuenscht, wird er nicht weiter veraendert und auch nicht verkuerzt. =cut sub fill_left{ my ($data, $value, $width, $char) = @_; $width ||= 72; $char = ' ' unless (defined($char) && length($char) == 1); my $fill = $width - length($value); $value = $char x $fill . $value if ($fill > 0); return $value; } sub fill_right{ my ($data, $value, $width, $char) = @_; $width ||= 72; $char ||= ' '; my $fill = $width - length($value); $value .= $char x $fill if ($fill > 0); return $value; } sub fill_both{ my ($data, $value, $width, $char) = @_; $width ||= 72; $char ||= ' '; my $fill = $width - length($value); if ($fill > 0){ my $left = int($fill / 2); my $right = $fill - $left; $value = $char x $left . $value . $char x $right; } return $value; } #---------------------------------------------------------------------- =item justify, justify-before, justify-behind Fuegt zwischen den existierenden String und dem Wert des angegebenen Schluessel genau so viele Leerzeichen ein, damit die gewuenschte Stringlaenge erreicht wird. ... | justify-behind 'key' 72 | ... C haengt den Wert des Schluessel an das Ende des Strings, C stellt es davor. justify-behind: existing-string.........value-of-key justify-before: value-of-key.........existing-string C ist lediglich ein Alias auf C. Sind die beiden Strings zusammen länger als die gewuenschte Zeilenlaenge, wird automatisch einen Zeilenbruch eingefuegt und beide Zeilen entsprechend mit Leerzeichen gefuellt. very-very-very-long-existing-string.........\n ...................and-a-too-long-new-string =cut sub justify_behind{ my ($data, $value, $key, $width) = @_; return _justify( $value, $data->getConvKey($key), $width); } sub justify_before{ my ($data, $value, $key, $width) = @_; return _justify( $data->getConvKey($key), $value, $width); } sub _justify{ my ($lval, $rval, $width) = @_; my $sep = ' '; if (length($lval.$rval) >= $width ){ # wir basteln zwei zeilen $lval .= $sep x ($width - length($lval)); $rval = $sep x ($width - length($rval)) . $rval; return $lval."\n".$rval; }else{ my $fill = $width - length($lval) - length($rval); return $lval . $sep x $fill . $rval; } } #---------------------------------------------------------------------- =item first-words Gibt nur die ersten Worte eines Strings zurueck, die vollstaendig innerhalb der angegebenen Laenge liegen. =cut sub first_words{ my ($data, $value, $width) = @_; my @words = split('\s+', $value); my $string; $string .= shift(@words); while(@words && (length($string) + length($words[0]) + 1) < $width){ $string .= ' ' . shift(@words); } return $string; } =item drop-words Alle Woerter am Anfang des Strings entfernen, die komplett innerhalb der angegebenen Laenge liegen. =cut sub drop_words{ my ($data, $value, $width) = @_; my @words = split('\s+', $value); # das erste "Wort" immer verwerfen, egal wie lang es ist my $first = shift(@words); my $length = length($first); while (@words && ( $length + length($words[0]) + 1 ) < $width ){ $length += length($words[0]) + 1; shift(@words); } return join(' ', @words); } =item create-lines Zerlegt einen String in einen Array, in dem die einzelnen Zeilen nicht laenger als die gewuenschte Anzahl Zeichen sind. absatz := value 'key' | create-lines 72 Mit Hilfe dieser Funktion ist es moeglich, ueberlange Zeilen zu Absatzen umzuformatieren. Die Funktion erzeugt intern eine Liste, die jeweils den Schluessel C mit dem entsprechenden String als Wert enthaelt. Im Template wird der so Absatz dann mit Hilfe des Schleifen-Syntax eingebunden: [@absatz|[line]\n] Achtung! Da die Funktion keinen String zurueckgibt, sollte sie am Ende der Kette stehen, da die normalen Formatierungsfunktionen einen String als Input erwartern! =cut sub create_lines{ my ($data, $value, $width) = @_; my @words = split('\s+', $value); my @lines; while (@words){ my $string .= shift(@words); while(@words && (length($string) + length($words[0]) + 1) < $width){ $string .= ' ' . shift(@words); } my $new = $data->new( line => $string ); push(@lines, $new); } return \@lines; } #---------------------------------------------------------------------- =item multi-graph, multi-line Spezielle Funktionen, um eine bestimmte graphische Ausgabe fuer Votings mit mehreren Abstimmungspunkten zu erzeugen: Punkt 1 --------------------------+ Punkt 2a ------------------------+| Punkt 2b -----------------------+|| Punkt 3 -----------------------+||| |||| Name of Voter 1 jjnn Name of Voter 2 nnjj C ist hierbei für die Formatierung der einzelnen Abstimmungspunkte zustaendig. multi-graph 'key' 'width' 'pos-key' 'max-key' Der erste Parameter gibt den Schluessel an, dessen Wert als Abstimmungspunkt ausgegeben werden soll. C die Laenge des zu erzeugenden Strings. C und C sind die Namen der Schluessel, in denen stehen muss, um den wievielten Abstimmungspunkt es sich handelt (per default 'pos') und wieviele Abstimmungspunkte es insgesamt gibt ('anzpunkte'). C erzeugt einfach nur einen String in der gewuenschten Laenge, der entsprechend der Anzahl der Abstimmungspunkte mit '|' abschliesst. =cut sub mgraph{ my ($data, $value, $width, $pkey, $okey) = @_; return unless $data; my $pos = $data->getKey($pkey || 'pos'); my $of = $data->getKey($okey || 'anzpunkte'); my $gfx = ''; $gfx = ' ---'.'-' x ($of-$pos) .'+'. '|' x ($pos - 1) if ($pos && $of); if (length($value.$gfx) < $width){ $value = ' ' x ($width - length($value.$gfx)) . $value . $gfx; }elsif (length($value.$gfx) > $width){ my @lines = _wrap($value, $width - length($gfx)); $value = shift(@lines) . $gfx; $value = ' ' x ($width - length($value)) . $value; # Hilfzeile erzeugen $gfx = ' '.' ' x ($of-$pos) . '|' x ($pos) if ($pos && $of); foreach my $line (@lines){ $value .= "\n".' ' x ($width - length($line.$gfx)) . $line . $gfx; } } return $value; } sub mgline{ my ($data, undef, $width, $okey) = @_; return unless $data; my $of = $data->getKey($okey || 'anzpunkte') || 0; return ' ' x ($width - $of) . '|' x $of; } sub _wrap{ my ($string, $width) = @_; my @words = split('\s+', $string); my @lines; while (@words){ my $line .= shift(@words); while(@words && (length($line) + length($words[0]) + 1) < $width){ $line .= ' ' . shift(@words); } push(@lines, $line); } return @lines; } #---------------------------------------------------------------------- =item quote Stellt in einem (mehrzeiligem) String jeder Zeile den gewuenschten Quotestring voran. body := value 'body' | quote '> ' =cut sub quote{ my ($data, $value, $quotechar) = @_; $quotechar = '> ' unless defined($quotechar); $value =~ s/^/$quotechar/mg; return $value; } #---------------------------------------------------------------------- =item replace Ersetzt in einem String ein oder mehrere Zeichen durch eine beliebige Anzahl anderer Zeichen. Diese Funktion kann z.B. genutzt werden, um beim Result die Mailadressen zu verfremden (Schutz vor Adress-Spidern). mail := value 'mail' | replace '@' '-at-' =cut sub replace{ my ($data, $value, $original, $replacement) = @_; $original = ' ' unless defined($original); $replacement = ' ' unless defined($replacement); $value =~ s/\Q$original\E/$replacement/g; return $value; } #---------------------------------------------------------------------- =item sprintf Gibt Text oder Zahlen mittels der Funktion sprintf formatiert aus (siehe "man 3 sprintf" oder "perldoc -f sprintf"). proportion := value 'proportion' | sprintf '%6.3f' =cut sub sprintf{ my ($data, $value, $format) = @_; $format = '%s' unless defined($format); return sprintf($format, $value); } #---------------------------------------------------------------------- =item generate_date_header Gibt ein Datum im RFC822-Format zur Verwendung im Date:-Header einer Mail aus. date := generate_date_header =cut sub generate_date_header{ my ($data, $value, $format) = @_; #return strftime('%a, %d %b %Y %H:%M:%S %z', localtime); return format_date; } #---------------------------------------------------------------------- =item generate_msgid Gibt eine Message-ID im RFC822-Format zur Verwendung im Message-ID:-Header einer Mail aus. msgid := generate_msgid =cut sub generate_msgid{ return ("<".$$.time().rand(999)."\@".$UVconfig::config{fqdn}.">"); } #---------------------------------------------------------------------- BEGIN{ %UVconfig::functions = ( %UVconfig::functions, value => \&value, append => \&append, 'fill-left' => \&fill_left, 'fill-right' => \&fill_right, 'fill-both' => \&fill_both, justify => \&justify_behind, 'justify-behind' => \&justify_behind, 'justify-before' => \&justify_before, 'first-words' => \&first_words, 'drop-words' => \&drop_words, 'create-lines' => \&create_lines, 'multi-graph' => \&mgraph, 'multi-line' => \&mgline, 'quote' => \"e, 'replace' => \&replace, 'sprintf' => \&sprintf, 'generate-date-header' => \&generate_date_header, 'generate-msgid' => \&generate_msgid ); } 1; #---------------------------------------------------------------------- =back =head1 SEE ALSO L =head1 AUTHOR Cornell Binder Marc Langer