File Coverage

blib/lib/MDK/Common/String.pm
Criterion Covered Total %
statement 3 53 5.6
branch 0 28 0.0
condition 0 11 0.0
subroutine 1 9 11.1
pod 8 8 100.0
total 12 109 11.0


line stmt bran cond sub pod time code
1             package MDK::Common::String;
2              
3             =head1 NAME
4              
5             MDK::Common::String - formatting functions
6              
7             =head1 SYNOPSIS
8              
9             use MDK::Common::String qw(:all);
10              
11             =head1 EXPORTS
12              
13             =over
14              
15             =item bestMatchSentence(STRING, LIST)
16              
17             finds in the list the best corresponding string
18              
19             =item formatList(INT, LIST)
20              
21             if the list size is bigger than INT, replace the remaining elements with "...".
22              
23             formatList(3, qw(a b c d e)) # => "a, b, c, ..."
24              
25             =item formatError(STRING)
26              
27             the string is something like "error at foo.pl line 2" that you get when
28             catching an exception. formatError will remove the "at ..." so that you can
29             nicely display the returned string to the user
30              
31             =item formatTimeRaw(TIME)
32              
33             the TIME is an epoch as returned by C
34              
35             =item formatLines(STRING)
36              
37             remove "\n"s when the next line doesn't start with a space. Otherwise keep
38             "\n"s to keep the indentation.
39              
40             =item formatAlaTeX(STRING)
41              
42             handle carriage return just like LaTeX: merge lines that are not separated by
43             an empty line
44              
45             =item begins_with(STRING, STRING)
46              
47             return true if first argument begins with the second argument. Use this
48             instead of regexps if you don't want regexps.
49              
50             begins_with("hello world", "hello") # => 1
51              
52             =item warp_text(STRING, INT)
53              
54             return a list of lines which do not exceed INT characters
55             (or a string in scalar context)
56              
57             =item warp_text(STRING)
58              
59             warp_text at a default width (80)
60              
61             =back
62              
63             =head1 SEE ALSO
64              
65             L
66              
67             =cut
68              
69              
70 1     1   5 use Exporter;
  1         2  
  1         732  
71             our @ISA = qw(Exporter);
72             our @EXPORT_OK = qw(bestMatchSentence formatList formatError formatTimeRaw formatLines formatAlaTeX begins_with warp_text);
73             our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
74              
75              
76             # count the number of character that match
77             sub bestMatchSentence {
78              
79 0     0 1   my $best = -1;
80 0           my $bestSentence;
81 0           my @s = split /\W+/, shift;
82 0           foreach (@_) {
83 0           my $count = 0;
84 0           foreach my $e (@s) {
85 0 0         $count += length($e) if /^$e$/;
86 0 0         $count += length($e) if /^$e$/i;
87 0 0         $count += length($e) if /$e/;
88 0 0         $count += length($e) if /$e/i;
89             }
90 0 0         $best = $count, $bestSentence = $_ if $count > $best;
91             }
92 0 0         wantarray() ? ($bestSentence, $best) : $bestSentence;
93             }
94              
95              
96             sub formatList {
97 0     0 1   my $nb = shift;
98 0 0         join(", ", @_ <= $nb ? @_ : (@_[0..$nb-1], '...'));
99             }
100             sub formatError {
101 0     0 1   my ($err) = @_;
102 0 0         if (!$::testing) {
103 0           $err =~ s/Uncaught exception from user code:\n\t//s; #- happens with "use diagnostics"
104 0           $err =~ s/ at \S+ line .*?\.$/./s;
105             }
106 0           $err;
107             }
108             sub formatTimeRaw {
109 0     0 1   my ($s, $m, $h) = gmtime($_[0]);
110 0           sprintf "%d:%02d:%02d", $h, $m, $s;
111             }
112             sub formatLines {
113 0     0 1   my ($t, $tmp);
114 0           foreach (split "\n", $_[0]) {
115 0 0         if (/^\s/) {
116 0           $t .= "$tmp\n";
117 0           $tmp = $_;
118             } else {
119 0 0 0       $tmp = ($tmp ? "$tmp " : ($t && "\n") . $tmp) . $_;
120             }
121             }
122 0           "$t$tmp\n";
123             }
124             sub formatAlaTeX {
125 0     0 1   my ($t, $tmp) = ('', '');
126 0           foreach (split "\n", $_[0]) {
127 0 0         if (/^$/) {
128 0   0       $t .= ($t && "\n") . $tmp;
129 0           $tmp = '';
130             } else {
131 0   0       $tmp = ($tmp && "$tmp ") . (/^\s*(.*?)\s*$/)[0];
132             }
133             }
134 0   0       $t . ($t && $tmp && "\n") . $tmp;
135             }
136              
137              
138             sub begins_with {
139 0     0 1   my ($s, $prefix) = @_;
140 0           index($s, $prefix) == 0;
141             }
142              
143             sub warp_text {
144 0     0 1   my ($text, $o_width) = @_;
145              
146 0           my @l;
147 0           foreach (split "\n", $text) {
148 0           my ($beg) = /^(\s*)/;
149 0           my $t = '';
150 0           foreach (split /\s+/, $_) {
151 0 0 0       if (length "$beg$t $_" > ($o_width || 80)) {
152 0           push @l, "$beg$t";
153 0           $beg = '';
154 0           $t = $_;
155             } else {
156 0 0         $t = $t ? "$t $_" : $_;
157             }
158             }
159 0           push @l, "$beg$t";
160             }
161 0 0         wantarray() ? @l : join("\n", @l);
162             }
163              
164             1;