line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::Shorten; |
2
|
|
|
|
|
|
|
|
3
|
16
|
|
|
16
|
|
76
|
use warnings; |
|
16
|
|
|
|
|
23
|
|
|
16
|
|
|
|
|
364
|
|
4
|
16
|
|
|
16
|
|
52
|
use strict; |
|
16
|
|
|
|
|
25
|
|
|
16
|
|
|
|
|
207
|
|
5
|
16
|
|
|
16
|
|
51
|
use Hash::SafeKeys; |
|
16
|
|
|
|
|
26
|
|
|
16
|
|
|
|
|
626
|
|
6
|
16
|
|
|
16
|
|
65
|
use Exporter; |
|
16
|
|
|
|
|
20
|
|
|
16
|
|
|
|
|
4392
|
|
7
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
8
|
|
|
|
|
|
|
our @EXPORT = qw(); |
9
|
|
|
|
|
|
|
our @EXPORT_OK = qw(shorten_scalar shorten_array shorten_hash); |
10
|
|
|
|
|
|
|
our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); |
11
|
|
|
|
|
|
|
our $VERSION = '0.08'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $DOTDOTDOT = '...'; |
14
|
|
|
|
|
|
|
our $DOTDOTDOT_LENGTH = length($DOTDOTDOT); |
15
|
|
|
|
|
|
|
our $DEFAULT_ARRAY_ELEM_SEPARATOR_LENGTH = 1; |
16
|
|
|
|
|
|
|
our $DEFAULT_HASH_ELEM_SEPARATOR_LENGTH = 1; |
17
|
|
|
|
|
|
|
our $DEFAULT_HASH_KEYVALUE_SEPARATOR_LENGTH = 2; |
18
|
|
|
|
|
|
|
our $HASHREPR_SORTKEYS; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub shorten_scalar { |
21
|
0
|
|
|
0
|
1
|
|
my ($scalar, $maxlen) = @_; |
22
|
|
|
|
|
|
|
|
23
|
0
|
0
|
|
|
|
|
return $scalar if length($scalar) < $maxlen; |
24
|
|
|
|
|
|
|
|
25
|
0
|
0
|
0
|
|
|
|
if ($scalar =~ /^['"]./ # "']/ |
26
|
|
|
|
|
|
|
&& substr($scalar,0,1) eq substr($scalar,-1)) { |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
return substr($scalar,0,$maxlen-$DOTDOTDOT_LENGTH-1) |
29
|
|
|
|
|
|
|
. $DOTDOTDOT . substr($scalar,-1); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
0
|
|
|
|
|
|
my ($sign,$d1,$d,$d2,$e,$exp) = |
34
|
|
|
|
|
|
|
$scalar =~ /^\s* ([+-]?) |
35
|
|
|
|
|
|
|
(\d*) |
36
|
|
|
|
|
|
|
(\.?) |
37
|
|
|
|
|
|
|
(\d*) |
38
|
|
|
|
|
|
|
([Ee]?) |
39
|
|
|
|
|
|
|
([+-]?\d+)? \s*$/x; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
{ |
42
|
16
|
|
|
16
|
|
96
|
no warnings 'uninitialized'; |
|
16
|
|
|
|
|
23
|
|
|
16
|
|
|
|
|
20378
|
|
|
0
|
|
|
|
|
|
|
43
|
0
|
0
|
|
|
|
|
if ("$d1$d2" eq "") { |
44
|
|
|
|
|
|
|
# not a number. |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
return substr($scalar, 0, $maxlen-$DOTDOTDOT_LENGTH) . $DOTDOTDOT; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# the rest of this function is strategies for making a number shorter. |
51
|
|
|
|
|
|
|
# We may lose precision but we won't need to use $DOTDOTDOT |
52
|
|
|
|
|
|
|
|
53
|
0
|
|
0
|
|
|
|
$sign ||= ''; |
54
|
0
|
|
0
|
|
|
|
$d1 ||= '0'; |
55
|
0
|
0
|
|
|
|
|
$d2 = '' if not defined $d2; |
56
|
0
|
|
0
|
|
|
|
$e ||= ''; |
57
|
0
|
0
|
|
|
|
|
$exp = '' if not defined $exp; |
58
|
0
|
|
0
|
|
|
|
my $E = $e || 'e'; |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
$exp =~ s/^\+// if length("$sign$d1$d$d2$e$exp") > $maxlen; |
61
|
0
|
0
|
|
|
|
|
$d1 =~ s/^0+(.)/$1/ if length("$sign$d1$d$d2$e$exp") > $maxlen; |
62
|
0
|
0
|
|
|
|
|
$d2 =~ s/(.)0+$/$1/ if length("$sign$d1$d2$e$exp") > $maxlen; |
63
|
0
|
0
|
|
|
|
|
$exp =~ s/^(\-?)0+(.)/$1$2/ if length("$sign$d1$d$d2$exp") > $maxlen; |
64
|
0
|
0
|
|
|
|
|
$sign =~ s/^\+// if length("$sign$d1$d$d2$e$exp") > $maxlen; |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
|
my $lastc = 0; |
67
|
0
|
|
|
|
|
|
while (length("$sign$d1$d$d2$e$exp") > $maxlen) { |
68
|
|
|
|
|
|
|
|
69
|
0
|
0
|
0
|
|
|
|
if ($d && $d2 eq '') { # 1.E23 => 1E23 |
70
|
0
|
|
|
|
|
|
$d = ''; |
71
|
0
|
|
0
|
|
|
|
$d1 ||= '0'; |
72
|
0
|
|
|
|
|
|
next; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
0
|
0
|
0
|
|
|
|
if ($e && ($exp eq '' || $exp==0)) { # 4.567E0 => 4.567 |
|
|
|
0
|
|
|
|
|
76
|
0
|
|
|
|
|
|
$e = $exp = ''; |
77
|
0
|
|
|
|
|
|
next; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
0
|
0
|
0
|
|
|
|
if (($d1 eq '' || $d1 == 0) && $d2 ne '') { |
|
|
|
0
|
|
|
|
|
81
|
0
|
|
|
|
|
|
$d1=0; |
82
|
0
|
|
0
|
|
|
|
while ($d1 == 0 && $d2 ne '') { # 0.123 => 1.23, |
83
|
|
|
|
|
|
|
# 0.0004E-5 => 0.004E-6 |
84
|
0
|
|
|
|
|
|
$d1 = substr($d2,0,1); |
85
|
0
|
|
|
|
|
|
$d2 = substr($d2,1); |
86
|
0
|
|
0
|
|
|
|
$e ||= $E; |
87
|
0
|
|
|
|
|
|
$exp--; |
88
|
|
|
|
|
|
|
} |
89
|
0
|
|
|
|
|
|
next; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
0
|
0
|
0
|
|
|
|
if ($e eq '' && $d2 ne '') { |
93
|
|
|
|
|
|
|
# start truncating digits |
94
|
0
|
|
|
|
|
|
my $c = chop $d2; |
95
|
0
|
0
|
0
|
|
|
|
if ($c > 5 || ($c == 5 && $lastc)) { |
|
|
|
0
|
|
|
|
|
96
|
0
|
|
|
|
|
|
my $new_d2 = $d2; |
97
|
0
|
|
|
|
|
|
$lastc = 0; |
98
|
0
|
0
|
|
|
|
|
if (length($new_d2) > length($d2)) { |
99
|
0
|
|
|
|
|
|
$d1++; |
100
|
0
|
|
|
|
|
|
$d2 = substr($new_d2,1); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
} else { |
103
|
0
|
|
|
|
|
|
$lastc = 1; |
104
|
|
|
|
|
|
|
} |
105
|
0
|
|
|
|
|
|
next; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
0
|
0
|
0
|
|
|
|
if ($d eq '' && $d2 eq '') { |
109
|
|
|
|
|
|
|
# start truncating digits and increment exp |
110
|
0
|
|
|
|
|
|
my $c = chop $d1; |
111
|
0
|
0
|
0
|
|
|
|
if ($c > 5 || ($c==5 && $lastc)) { |
|
|
|
0
|
|
|
|
|
112
|
0
|
|
|
|
|
|
$lastc = 0; |
113
|
0
|
|
|
|
|
|
$d1++; |
114
|
|
|
|
|
|
|
} else { |
115
|
0
|
|
|
|
|
|
$lastc = 1; |
116
|
|
|
|
|
|
|
} |
117
|
0
|
|
0
|
|
|
|
$e ||= $E; |
118
|
0
|
|
|
|
|
|
$exp++; |
119
|
0
|
|
|
|
|
|
next; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
|
if ($d2 ne '') { |
123
|
|
|
|
|
|
|
# start truncating digits |
124
|
0
|
|
|
|
|
|
my $c = chop $d2; |
125
|
0
|
0
|
0
|
|
|
|
if ($c > 5 || ($c == 5 && $lastc)) { |
|
|
|
0
|
|
|
|
|
126
|
0
|
|
|
|
|
|
my $new_d2 = $d2; |
127
|
0
|
|
|
|
|
|
$lastc = 0; |
128
|
0
|
0
|
|
|
|
|
if (length($new_d2) > length($d2)) { |
129
|
0
|
|
|
|
|
|
$d1++; |
130
|
0
|
|
|
|
|
|
$d2 = substr($new_d2,1); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} else { |
133
|
0
|
|
|
|
|
|
$lastc = 1; |
134
|
|
|
|
|
|
|
} |
135
|
0
|
|
|
|
|
|
next; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
0
|
0
|
|
|
|
|
$d = '' if $d2 eq ''; |
140
|
0
|
|
0
|
|
|
|
while ($e && $d && $d1 ne '' && $d1 > 9) { # 98.7E6 => 9.87E7 |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
141
|
0
|
|
|
|
|
|
$d2 = chop($d1) . $d2; |
142
|
0
|
|
|
|
|
|
$d = '.'; |
143
|
0
|
|
|
|
|
|
$exp++; |
144
|
|
|
|
|
|
|
} |
145
|
0
|
0
|
|
|
|
|
$d = '' if $d2 eq ''; |
146
|
0
|
|
|
|
|
|
return "$sign$d1$d$d2$e$exp"; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# XXX - do we want to make it configurable whether shorten_array |
150
|
|
|
|
|
|
|
# always returns at least one full element? |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub shorten_array { |
153
|
0
|
|
|
0
|
1
|
|
my ($array, $maxlen, $seplen, @key) = @_; |
154
|
0
|
0
|
|
|
|
|
if (!defined($seplen)) { |
|
|
0
|
|
|
|
|
|
155
|
0
|
|
|
|
|
|
$seplen = $DEFAULT_ARRAY_ELEM_SEPARATOR_LENGTH; |
156
|
|
|
|
|
|
|
} elsif ($seplen =~ /\D/) { |
157
|
0
|
|
|
|
|
|
$seplen = length($seplen); |
158
|
|
|
|
|
|
|
} |
159
|
0
|
|
|
|
|
|
my $dotslen = $seplen + $DOTDOTDOT_LENGTH; |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
|
my $n = $#{$array} + 1; |
|
0
|
|
|
|
|
|
|
162
|
0
|
0
|
|
|
|
|
@key = (0) if @key == 0; |
163
|
0
|
0
|
|
|
|
|
@key = sort {$a <=> $b} grep { $_ >= 0 && $_ < $n } @key; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
my @inc = (0) x $n; |
165
|
|
|
|
|
|
|
|
166
|
0
|
0
|
|
|
|
|
my $len = $n > 0 ? $dotslen - 1 : 0; |
167
|
0
|
0
|
0
|
|
|
|
if (@key > 1 || (@key == 1 && $key[0] != 0)) { |
|
|
|
0
|
|
|
|
|
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
|
my @prio = (0) x $n; |
170
|
|
|
|
|
|
|
# "prioritize" elements for display, giving preference to |
171
|
|
|
|
|
|
|
# key items |
172
|
|
|
|
|
|
|
# items between key items |
173
|
|
|
|
|
|
|
# the first item |
174
|
|
|
|
|
|
|
# the last item |
175
|
0
|
0
|
|
|
|
|
if ($n > 0) { |
176
|
0
|
|
|
|
|
|
$prio[$_] = 8 for @key; |
177
|
0
|
|
|
|
|
|
$prio[$_] += 4 for $key[0]..$key[-1]; |
178
|
|
|
|
|
|
|
} |
179
|
0
|
|
|
|
|
|
$prio[0] += 2; |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
my $insert_fails = 0; |
182
|
0
|
0
|
|
|
|
|
for my $i ( sort { $prio[$b] <=> $prio[$a] || $a <=> $b } 0..$n-1) { |
|
0
|
|
|
|
|
|
|
183
|
0
|
0
|
0
|
|
|
|
last if $prio[$i] < 8 && $len > $maxlen; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# what are the consequences of including $array->[$i] in the output? |
186
|
|
|
|
|
|
|
# |
187
|
|
|
|
|
|
|
# if none of $array->[$i]'s neighbors are excluded: |
188
|
|
|
|
|
|
|
# then we lose $dotslen and add length of $array->[$i] |
189
|
|
|
|
|
|
|
# [ a , ... , c ] ==> [ a , b , c ] |
190
|
|
|
|
|
|
|
# |
191
|
|
|
|
|
|
|
# if one of $array->[$i]'s neighbors are excluded: |
192
|
|
|
|
|
|
|
# then we add $array->[$i] |
193
|
|
|
|
|
|
|
# [ a , ... ] => [ a , b , ... ] |
194
|
|
|
|
|
|
|
# [ ... , c ] => [ ... , b , c ] |
195
|
|
|
|
|
|
|
# [ edge ... ] => [ edge a , ... ] |
196
|
|
|
|
|
|
|
# |
197
|
|
|
|
|
|
|
# if two of $array->[$i]'s neighbors are excluded |
198
|
|
|
|
|
|
|
# then we gain $dotslen + $array->[$i] |
199
|
|
|
|
|
|
|
# [ ... ] => [ ... , a , ... ] |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
0
|
|
|
|
my $excl = ($i>0 && !$inc[$i-1]) + ($i<$n-1 && !$inc[$i+1]) + 0; |
|
|
|
0
|
|
|
|
|
202
|
0
|
|
0
|
|
|
|
my $dlen = defined($array->[$i])&&length($array->[$i]) |
203
|
|
|
|
|
|
|
+ $seplen + $dotslen * ($excl - 1); |
204
|
0
|
0
|
0
|
|
|
|
if ($prio[$i] >= 8 || $len + $dlen <= $maxlen) { |
205
|
0
|
|
|
|
|
|
$inc[$i] = 1; |
206
|
0
|
|
|
|
|
|
$len += $dlen; |
207
|
0
|
|
|
|
|
|
$insert_fails = 0; |
208
|
|
|
|
|
|
|
} else { |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# for very large arrays, don't keep trying to squeeze |
211
|
|
|
|
|
|
|
# that last element in when there is a low probability |
212
|
|
|
|
|
|
|
# that it will work ... |
213
|
|
|
|
|
|
|
|
214
|
0
|
0
|
|
|
|
|
last if ++$insert_fails > 20; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
} else { |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# don't need to sort, don't need to check $prio[$i] |
221
|
0
|
|
|
|
|
|
my $insert_fails = 0; |
222
|
0
|
|
|
|
|
|
for my $i (0 .. $n-1) { |
223
|
0
|
0
|
|
|
|
|
last if $len > $maxlen; |
224
|
0
|
|
0
|
|
|
|
my $excl = ($i>0 && !$inc[$i-1]) + ($i<$n-1 && !$inc[$i+1]) + 0; |
|
|
|
0
|
|
|
|
|
225
|
0
|
|
0
|
|
|
|
my $dlen = defined($array->[$i]) && length($array->[$i]) |
226
|
|
|
|
|
|
|
+ $seplen + $dotslen * ($excl - 1); |
227
|
0
|
0
|
|
|
|
|
if ($len + $dlen <= $maxlen) { |
228
|
0
|
|
|
|
|
|
$inc[$i] = 1; |
229
|
0
|
|
|
|
|
|
$len += $dlen; |
230
|
|
|
|
|
|
|
} else { |
231
|
0
|
0
|
|
|
|
|
last if ++$insert_fails > 100; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# construct array, including elements in @inc |
237
|
0
|
|
|
|
|
|
my @result = (); |
238
|
0
|
|
|
|
|
|
my @explicit = grep $inc[$_], 0..$#inc; |
239
|
0
|
|
|
|
|
|
my $i = 0; |
240
|
0
|
|
|
|
|
|
while (@explicit) { |
241
|
0
|
0
|
|
|
|
|
if ($i < $explicit[0]) { |
242
|
0
|
|
|
|
|
|
push @result, $DOTDOTDOT; |
243
|
|
|
|
|
|
|
} |
244
|
0
|
|
|
|
|
|
$i = shift @explicit; |
245
|
0
|
|
|
|
|
|
push @result, $array->[$i]; |
246
|
0
|
|
|
|
|
|
$i++; |
247
|
|
|
|
|
|
|
} |
248
|
0
|
0
|
|
|
|
|
if ($i < $n) { |
249
|
0
|
|
|
|
|
|
push @result, $DOTDOTDOT; |
250
|
|
|
|
|
|
|
} |
251
|
0
|
|
|
|
|
|
return @result; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub shorten_hash { |
255
|
0
|
|
|
0
|
1
|
|
my ($hash, $maxlen, $sep1, $sep2, @key) = @_; |
256
|
|
|
|
|
|
|
|
257
|
0
|
0
|
|
|
|
|
if (!defined($sep1)) { |
|
|
0
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$sep1 = $DEFAULT_HASH_ELEM_SEPARATOR_LENGTH; |
259
|
|
|
|
|
|
|
} elsif ($sep1 =~ /\D/) { |
260
|
0
|
|
|
|
|
|
$sep1 = length($sep1); |
261
|
|
|
|
|
|
|
} |
262
|
0
|
0
|
|
|
|
|
if (!defined($sep2)) { |
|
|
0
|
|
|
|
|
|
263
|
0
|
|
|
|
|
|
$sep2 = $DEFAULT_HASH_KEYVALUE_SEPARATOR_LENGTH; |
264
|
|
|
|
|
|
|
} elsif ($sep2 =~ /\D/) { |
265
|
0
|
|
|
|
|
|
$sep2 = length($sep2); |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# save iterator in case we are already inside each %$hash |
269
|
0
|
|
|
|
|
|
my $it = Hash::SafeKeys::save_iterator_state($hash); |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# performance is greatly improved in v0.07 as we avoid calling |
272
|
|
|
|
|
|
|
# keys %$hash in list context on a possibly large hash |
273
|
|
|
|
|
|
|
|
274
|
0
|
|
|
|
|
|
my $total_len = -$sep1 + ($sep1+$sep2) * keys %$hash; |
275
|
0
|
|
|
|
|
|
while (my ($k,$v) = each %$hash) { |
276
|
0
|
|
|
|
|
|
$total_len += length($k) + length($v); |
277
|
0
|
0
|
|
|
|
|
last if $total_len > $maxlen; |
278
|
|
|
|
|
|
|
} |
279
|
0
|
0
|
|
|
|
|
if ($total_len <= $maxlen) { |
280
|
|
|
|
|
|
|
# ok to include all elements |
281
|
0
|
|
|
|
|
|
my @all_elements = map { [ $_ , $hash->{$_} ] } keys %$hash; |
|
0
|
|
|
|
|
|
|
282
|
0
|
|
|
|
|
|
Hash::SafeKeys::restore_iterator_state($hash,$it); |
283
|
0
|
|
|
|
|
|
return @all_elements; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
my @hashkeys = (); |
287
|
0
|
|
|
|
|
|
my $hk1 = {}; |
288
|
0
|
|
|
|
|
|
my $hk1_skip_key = 0; |
289
|
0
|
|
|
|
|
|
my %key; |
290
|
0
|
0
|
0
|
|
|
|
if (@key > 0) { |
|
|
0
|
|
|
|
|
|
291
|
0
|
|
|
|
|
|
%key = map { $_ => 1 } @key; |
|
0
|
|
|
|
|
|
|
292
|
0
|
0
|
|
|
|
|
if (100 > keys %$hash) { |
293
|
|
|
|
|
|
|
@hashkeys = sort { |
294
|
0
|
0
|
0
|
|
|
|
($key{$b}||0) <=> ($key{$a}||0) || $a cmp $b |
|
0
|
|
0
|
|
|
|
|
295
|
|
|
|
|
|
|
} keys %$hash; |
296
|
|
|
|
|
|
|
} else { |
297
|
0
|
|
|
|
|
|
@hashkeys = grep { defined $key{$_} } @key; |
|
0
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
$hk1 = $hash; |
299
|
0
|
|
|
|
|
|
$hk1_skip_key = 1; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
} elsif (100 > keys %$hash || $HASHREPR_SORTKEYS) { |
302
|
0
|
|
|
|
|
|
@hashkeys = sort keys %$hash; |
303
|
|
|
|
|
|
|
} else { |
304
|
0
|
|
|
|
|
|
$hk1 = $hash; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
0
|
|
|
|
|
|
my $len = 3; |
308
|
0
|
|
|
|
|
|
my @r; |
309
|
0
|
|
|
|
|
|
foreach my $key (@hashkeys) { |
310
|
0
|
|
|
|
|
|
my $dlen = $sep1 + $sep2 + length($key) + length($hash->{$key}); |
311
|
0
|
0
|
0
|
|
|
|
last if @r > 0 && $len + $dlen > $maxlen; |
312
|
0
|
|
|
|
|
|
push @r, [ $key, $hash->{$key} ]; |
313
|
0
|
|
|
|
|
|
$len += $dlen; |
314
|
|
|
|
|
|
|
} |
315
|
0
|
|
|
|
|
|
while (my ($key,$val) = each %$hk1) { |
316
|
0
|
0
|
0
|
|
|
|
next if $hk1_skip_key && defined($key{$key}); |
317
|
0
|
|
|
|
|
|
my $dlen = $sep1 + $sep2 + length($key) + length($val); |
318
|
0
|
0
|
0
|
|
|
|
last if @r > 0 && $len + $dlen > $maxlen; |
319
|
0
|
|
|
|
|
|
push @r, [ $key, $val ]; |
320
|
0
|
|
|
|
|
|
$len += $dlen; |
321
|
|
|
|
|
|
|
} |
322
|
0
|
|
|
|
|
|
Hash::SafeKeys::restore_iterator_state($hash, $it); |
323
|
0
|
|
|
|
|
|
return @r, [ $DOTDOTDOT ]; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
1; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
__END__ |