summaryrefslogtreecommitdiffstats
path: root/lib/MDK/Common/String.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2007-04-25 15:08:17 +0000
committerPascal Rigaux <pixel@mandriva.com>2007-04-25 15:08:17 +0000
commit1a06fa7e4a300880848047118f0adba68d38348d (patch)
treee6b01d6f4feae969f9905d5245648532db254c42 /lib/MDK/Common/String.pm
parente895f6b48826f09aeaada321d03a1d10548fc9ce (diff)
downloadperl-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.pm164
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;