diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 15:08:17 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 15:08:17 +0000 |
commit | 1a06fa7e4a300880848047118f0adba68d38348d (patch) | |
tree | e6b01d6f4feae969f9905d5245648532db254c42 /lib/MDK/Common/String.pm | |
parent | e895f6b48826f09aeaada321d03a1d10548fc9ce (diff) | |
download | perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar.gz perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar.bz2 perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar.xz perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.zip |
re-sync after the big svn loss
Diffstat (limited to 'lib/MDK/Common/String.pm')
-rw-r--r-- | lib/MDK/Common/String.pm | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/lib/MDK/Common/String.pm b/lib/MDK/Common/String.pm new file mode 100644 index 0000000..40eee1d --- /dev/null +++ b/lib/MDK/Common/String.pm @@ -0,0 +1,164 @@ +package MDK::Common::String; + +=head1 NAME + +MDK::Common::String - formatting functions + +=head1 SYNOPSIS + + use MDK::Common::String qw(:all); + +=head1 EXPORTS + +=over + +=item bestMatchSentence(STRING, LIST) + +finds in the list the best corresponding string + +=item formatList(INT, LIST) + +if the list size is bigger than INT, replace the remaining elements with "...". + +formatList(3, qw(a b c d e)) # => "a, b, c, ..." + +=item formatError(STRING) + +the string is something like "error at foo.pl line 2" that you get when +catching an exception. formatError will remove the "at ..." so that you can +nicely display the returned string to the user + +=item formatTimeRaw(TIME) + +the TIME is an epoch as returned by C<time>, the formatted time looks like "23:59:00" + +=item formatLines(STRING) + +remove "\n"s when the next line doesn't start with a space. Otherwise keep +"\n"s to keep the indentation. + +=item formatAlaTeX(STRING) + +handle carriage return just like LaTeX: merge lines that are not separated by +an empty line + +=item begins_with(STRING, STRING) + +return true if first argument begins with the second argument. Use this +instead of regexps if you don't want regexps. + +begins_with("hello world", "hello") # => 1 + +=item warp_text(STRING, INT) + +return a list of lines which do not exceed INT characters +(or a string in scalar context) + +=item warp_text(STRING) + +warp_text at a default width (80) + +=back + +=head1 SEE ALSO + +L<MDK::Common> + +=cut + + +use Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(bestMatchSentence formatList formatError formatTimeRaw formatLines formatAlaTeX begins_with warp_text); +our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +# count the number of character that match +sub bestMatchSentence { + + my $best = -1; + my $bestSentence; + my @s = split /\W+/, shift; + foreach (@_) { + my $count = 0; + foreach my $e (@s) { + $count += length($e) if /^$e$/; + $count += length($e) if /^$e$/i; + $count += length($e) if /$e/; + $count += length($e) if /$e/i; + } + $best = $count, $bestSentence = $_ if $count > $best; + } + wantarray() ? ($bestSentence, $best) : $bestSentence; +} + + +sub formatList { + my $nb = shift; + join(", ", @_ <= $nb ? @_ : (@_[0..$nb-1], '...')); +} +sub formatError { + my ($err) = @_; + if (!$::testing) { + $err =~ s/Uncaught exception from user code:\n\t//s; #- happens with "use diagnostics" + $err =~ s/ at .*?$/./s; + } + $err; +} +sub formatTimeRaw { + my ($s, $m, $h) = gmtime($_[0]); + sprintf "%d:%02d:%02d", $h, $m, $s; +} +sub formatLines { + my ($t, $tmp); + foreach (split "\n", $_[0]) { + if (/^\s/) { + $t .= "$tmp\n"; + $tmp = $_; + } else { + $tmp = ($tmp ? "$tmp " : ($t && "\n") . $tmp) . $_; + } + } + "$t$tmp\n"; +} +sub formatAlaTeX { + my ($t, $tmp) = ('', ''); + foreach (split "\n", $_[0]) { + if (/^$/) { + $t .= ($t && "\n") . $tmp; + $tmp = ''; + } else { + $tmp = ($tmp && "$tmp ") . (/^\s*(.*?)\s*$/)[0]; + } + } + $t . ($t && $tmp && "\n") . $tmp; +} + + +sub begins_with { + my ($s, $prefix) = @_; + index($s, $prefix) == 0; +} + +sub warp_text { + my ($text, $o_width) = @_; + + my @l; + foreach (split "\n", $text) { + my ($beg) = /^(\s*)/; + my $t = ''; + foreach (split /\s+/, $_) { + if (length "$beg$t $_" > ($o_width || 80)) { + push @l, "$beg$t"; + $beg = ''; + $t = $_; + } else { + $t = $t ? "$t $_" : $_; + } + } + push @l, "$beg$t"; + } + wantarray() ? @l : join("\n", @l); +} + +1; |