1 |
joko |
1.1 |
package Pitonyak::StringUtil; |
2 |
|
|
|
3 |
|
|
#************************************************************ |
4 |
|
|
|
5 |
|
|
=head1 NAME |
6 |
|
|
|
7 |
|
|
Pitonyak::StringUtil - File and directory scanning based on regular expressions. |
8 |
|
|
|
9 |
|
|
=head1 SYNOPSIS |
10 |
|
|
|
11 |
|
|
use Pitonyak::StringUtil |
12 |
|
|
|
13 |
|
|
=head1 DESCRIPTION |
14 |
|
|
|
15 |
|
|
=cut |
16 |
|
|
|
17 |
|
|
#************************************************************ |
18 |
|
|
|
19 |
|
|
require Exporter; |
20 |
|
|
$VERSION = '1.01'; |
21 |
|
|
|
22 |
|
|
@ISA = qw(Exporter); |
23 |
|
|
@EXPORT = qw( |
24 |
|
|
); |
25 |
|
|
|
26 |
|
|
@EXPORT_OK = qw( |
27 |
|
|
array_width |
28 |
|
|
center_fmt |
29 |
|
|
compact_space |
30 |
|
|
hash_key_width |
31 |
|
|
hash_val_width |
32 |
|
|
left_fmt |
33 |
|
|
num_int_digits |
34 |
|
|
num_with_leading_zeros |
35 |
|
|
trans_blank |
36 |
|
|
trim_fmt |
37 |
|
|
trim_space |
38 |
|
|
right_fmt |
39 |
|
|
smart_printer |
40 |
|
|
smart_printer_default |
41 |
|
|
); |
42 |
|
|
|
43 |
|
|
use Carp; |
44 |
|
|
use strict; |
45 |
|
|
|
46 |
|
|
#************************************************************ |
47 |
|
|
|
48 |
|
|
=pod |
49 |
|
|
|
50 |
|
|
=head2 array_width |
51 |
|
|
|
52 |
|
|
=over 4 |
53 |
|
|
|
54 |
|
|
=item array_width([arg1], [arg2], ... [argn]) |
55 |
|
|
|
56 |
|
|
=back |
57 |
|
|
|
58 |
|
|
Find the maximum width of a list of elements. |
59 |
|
|
Each element should either be a scalar or a reference to an array. |
60 |
|
|
|
61 |
|
|
=cut |
62 |
|
|
|
63 |
|
|
#************************************************************ |
64 |
|
|
|
65 |
|
|
sub array_width { |
66 |
|
|
my $width = 0; |
67 |
|
|
my $this_width; |
68 |
|
|
foreach (@_) { |
69 |
|
|
$this_width = ( ref($_) ne 'ARRAY' ) ? length($_) : array_width(@$_); |
70 |
|
|
$width = $this_width if $this_width > $width; |
71 |
|
|
} |
72 |
|
|
return $width; |
73 |
|
|
} |
74 |
|
|
|
75 |
|
|
#************************************************************ |
76 |
|
|
|
77 |
|
|
=pod |
78 |
|
|
|
79 |
|
|
=head2 center_fmt |
80 |
|
|
|
81 |
|
|
=over 4 |
82 |
|
|
|
83 |
|
|
=item center_fmt($width_to_use, @strings_to_format) |
84 |
|
|
|
85 |
|
|
=back |
86 |
|
|
|
87 |
|
|
Center the strings in the specified width. |
88 |
|
|
the strings are left and right padded to use the entire width. |
89 |
|
|
The strings are truncated to fit into the space. |
90 |
|
|
|
91 |
|
|
=cut |
92 |
|
|
|
93 |
|
|
#************************************************************ |
94 |
|
|
|
95 |
|
|
sub center_fmt { |
96 |
|
|
|
97 |
|
|
# No parameter, return undef |
98 |
|
|
if ( $#_ < 1 ) { |
99 |
|
|
carp("Usage: center_fmt(<len> <strings to format>)"); |
100 |
|
|
return undef; |
101 |
|
|
} |
102 |
|
|
|
103 |
|
|
my $len = $_[0]; |
104 |
|
|
my @strings = trim_fmt(@_); |
105 |
|
|
my @rc; |
106 |
|
|
foreach my $str (@strings) { |
107 |
|
|
my $slop = $len - length($str); |
108 |
|
|
my $left_space = int( $slop / 2 ); |
109 |
|
|
my $right_space = $slop - $left_space; |
110 |
|
|
$str = " " x $left_space . $str . " " x $right_space if $slop > 0; |
111 |
|
|
push ( @rc, $str ); |
112 |
|
|
} |
113 |
|
|
return wantarray ? @strings : $strings[0]; |
114 |
|
|
} |
115 |
|
|
|
116 |
|
|
#************************************************************ |
117 |
|
|
|
118 |
|
|
=pod |
119 |
|
|
|
120 |
|
|
=head2 compact_space |
121 |
|
|
|
122 |
|
|
=over 4 |
123 |
|
|
|
124 |
|
|
=item compact_space(@list_of_strings) |
125 |
|
|
|
126 |
|
|
=back |
127 |
|
|
|
128 |
|
|
Removes the spaces from the strings. |
129 |
|
|
|
130 |
|
|
Each string is potentially modified. |
131 |
|
|
Leading and trailing white space is removed. |
132 |
|
|
Runs of white space is turned to one space. |
133 |
|
|
This modifies the calling parameters. |
134 |
|
|
|
135 |
|
|
=cut |
136 |
|
|
|
137 |
|
|
#************************************************************ |
138 |
|
|
|
139 |
|
|
sub compact_space { |
140 |
|
|
|
141 |
|
|
# No parameter, return undef |
142 |
|
|
if ( $#_ < 0 ) { |
143 |
|
|
carp("Usage: compact_space(<strings to compact>"); |
144 |
|
|
return undef; |
145 |
|
|
} |
146 |
|
|
|
147 |
|
|
for (@_) { |
148 |
|
|
|
149 |
|
|
# |
150 |
|
|
# This new method is about four times faster |
151 |
|
|
# than the split and join |
152 |
|
|
# $_ = join ' ', split /\s+/, $_; # split then join |
153 |
|
|
# |
154 |
|
|
tr/ //s; |
155 |
|
|
|
156 |
|
|
# |
157 |
|
|
# Save a call to trim_space() at the end! |
158 |
|
|
# |
159 |
|
|
s/^\s*//; # Remove spaces from front |
160 |
|
|
s/\s*$//; # Remove spaces from end |
161 |
|
|
} |
162 |
|
|
return wantarray ? @_ : $_[0]; |
163 |
|
|
} |
164 |
|
|
|
165 |
|
|
#************************************************************ |
166 |
|
|
|
167 |
|
|
=pod |
168 |
|
|
|
169 |
|
|
=head2 hash_key_width |
170 |
|
|
|
171 |
|
|
=over 4 |
172 |
|
|
|
173 |
|
|
=item hash_key_width($hash_reference) |
174 |
|
|
|
175 |
|
|
=back |
176 |
|
|
|
177 |
|
|
Determine the maximum width of the keys in this hash |
178 |
|
|
|
179 |
|
|
=cut |
180 |
|
|
|
181 |
|
|
#************************************************************ |
182 |
|
|
|
183 |
|
|
sub hash_key_width(\%) { |
184 |
|
|
|
185 |
|
|
# No parameter, return 0 |
186 |
|
|
if ( $#_ < 0 || !UNIVERSAL::isa( $_[0], 'HASH' ) ) { |
187 |
|
|
carp("Usage: hash_key_width(<hash_reference>)"); |
188 |
|
|
return 0; |
189 |
|
|
} |
190 |
|
|
|
191 |
|
|
my $hash_ref = shift; |
192 |
|
|
my $ref_type = ref($hash_ref); |
193 |
|
|
my $width = 0; |
194 |
|
|
foreach my $key ( keys %$hash_ref ) { |
195 |
|
|
$width = length($key) if length($key) > $width; |
196 |
|
|
} |
197 |
|
|
return $width; |
198 |
|
|
} |
199 |
|
|
|
200 |
|
|
#************************************************************ |
201 |
|
|
|
202 |
|
|
=pod |
203 |
|
|
|
204 |
|
|
=head2 hash_val_width |
205 |
|
|
|
206 |
|
|
=over 4 |
207 |
|
|
|
208 |
|
|
=item hash_val_width($hash_reference) |
209 |
|
|
|
210 |
|
|
=back |
211 |
|
|
|
212 |
|
|
Determine the maximum width of the values in this hash |
213 |
|
|
|
214 |
|
|
=cut |
215 |
|
|
|
216 |
|
|
#************************************************************ |
217 |
|
|
|
218 |
|
|
sub hash_val_width(\%) { |
219 |
|
|
|
220 |
|
|
# No parameter, return 0 |
221 |
|
|
if ( $#_ < 0 || !UNIVERSAL::isa( $_[0], 'HASH' ) ) { |
222 |
|
|
carp("Usage: hash_val_width(<hash_reference>)"); |
223 |
|
|
return 0; |
224 |
|
|
} |
225 |
|
|
|
226 |
|
|
my $hash_ref = shift; |
227 |
|
|
my $ref_type = ref($hash_ref); |
228 |
|
|
my $width = 0; |
229 |
|
|
foreach my $key ( keys %$hash_ref ) { |
230 |
|
|
$width = length( $hash_ref->{$key} ) |
231 |
|
|
if length( $hash_ref->{$key} ) > $width; |
232 |
|
|
} |
233 |
|
|
return $width; |
234 |
|
|
} |
235 |
|
|
|
236 |
|
|
#************************************************************ |
237 |
|
|
|
238 |
|
|
=pod |
239 |
|
|
|
240 |
|
|
=head2 left_fmt |
241 |
|
|
|
242 |
|
|
=over 4 |
243 |
|
|
|
244 |
|
|
=item left_fmt($width_to_use, @strings_to_format) |
245 |
|
|
|
246 |
|
|
=back |
247 |
|
|
|
248 |
|
|
Each string has enough spaces appended end so that the |
249 |
|
|
total length is C<$width_to_use>. |
250 |
|
|
The strings are not truncated to fit into the space. |
251 |
|
|
|
252 |
|
|
=cut |
253 |
|
|
|
254 |
|
|
#************************************************************ |
255 |
|
|
|
256 |
|
|
sub left_fmt { |
257 |
|
|
|
258 |
|
|
# No parameter, return undef |
259 |
|
|
if ( $#_ < 1 ) { |
260 |
|
|
carp("Usage: left_fmt(<len> <strings to format>)"); |
261 |
|
|
return undef; |
262 |
|
|
} |
263 |
|
|
|
264 |
|
|
my $len = shift; |
265 |
|
|
my @rc; |
266 |
|
|
foreach my $str (@_) { |
267 |
|
|
my $slop = $len - length($str); |
268 |
|
|
$str = $str . " " x $slop if $slop > 0; |
269 |
|
|
push ( @rc, $str ); |
270 |
|
|
} |
271 |
|
|
return wantarray ? @rc : $rc[0]; |
272 |
|
|
} |
273 |
|
|
|
274 |
|
|
#************************************************************ |
275 |
|
|
|
276 |
|
|
=pod |
277 |
|
|
|
278 |
|
|
=head2 num_int_digits |
279 |
|
|
|
280 |
|
|
=over 4 |
281 |
|
|
|
282 |
|
|
=item num_int_digits($number) |
283 |
|
|
|
284 |
|
|
=back |
285 |
|
|
|
286 |
|
|
This returns the length of a number |
287 |
|
|
|
288 |
|
|
=cut |
289 |
|
|
|
290 |
|
|
#************************************************************ |
291 |
|
|
|
292 |
|
|
sub num_int_digits { |
293 |
|
|
|
294 |
|
|
# No parameter, return undef |
295 |
|
|
if ( $#_ < 0 ) { |
296 |
|
|
carp("Usage: num_int_digits(<number>"); |
297 |
|
|
return undef; |
298 |
|
|
} |
299 |
|
|
return length( sprintf( "%d", $_[0] ) ); |
300 |
|
|
} |
301 |
|
|
|
302 |
|
|
#************************************************************ |
303 |
|
|
|
304 |
|
|
=pod |
305 |
|
|
|
306 |
|
|
=head2 num_with_leading_zeros |
307 |
|
|
|
308 |
|
|
=over 4 |
309 |
|
|
|
310 |
|
|
=item num_with_leading_zeros(($width_to_use, @numbers_to_format) |
311 |
|
|
|
312 |
|
|
=back |
313 |
|
|
|
314 |
|
|
Returns N-digit strings representing the number with leading zeros. |
315 |
|
|
|
316 |
|
|
Modulo is used to chop the number. |
317 |
|
|
|
318 |
|
|
If C<numDigits E<lt> 0>, then leading negative signs are included. |
319 |
|
|
|
320 |
|
|
=cut |
321 |
|
|
|
322 |
|
|
#************************************************************ |
323 |
|
|
|
324 |
|
|
sub num_with_leading_zeros($$) { |
325 |
|
|
|
326 |
|
|
# No parameter, return undef |
327 |
|
|
if ( $#_ < 1 ) { |
328 |
|
|
carp("Usage: num_with_leading_zeros(<length> <list of numbers>"); |
329 |
|
|
return undef; |
330 |
|
|
} |
331 |
|
|
|
332 |
|
|
my $num_digits = shift; |
333 |
|
|
my @rc; |
334 |
|
|
foreach (@_) { |
335 |
|
|
my $num = $_; |
336 |
|
|
my $rvalue = ""; |
337 |
|
|
if ( $num_digits != 0 ) { |
338 |
|
|
if ( $num_digits < 0 ) { |
339 |
|
|
$num_digits = -$num_digits; |
340 |
|
|
if ( $num < 0 ) { |
341 |
|
|
--$num_digits; |
342 |
|
|
$rvalue = "-"; |
343 |
|
|
} |
344 |
|
|
} |
345 |
|
|
$num = -$num if $num < 0; |
346 |
|
|
my $tmp = sprintf "%d", $num; |
347 |
|
|
my $lead_zero = $num_digits - length($tmp); |
348 |
|
|
if ( $lead_zero > 0 ) { |
349 |
|
|
$rvalue .= "0" x $lead_zero . $tmp; |
350 |
|
|
} |
351 |
|
|
else { |
352 |
|
|
$rvalue .= substr $tmp, $[ - $lead_zero; |
353 |
|
|
} |
354 |
|
|
} |
355 |
|
|
push ( @rc, $rvalue ); |
356 |
|
|
} |
357 |
|
|
return wantarray ? @rc : $rc[0]; |
358 |
|
|
} |
359 |
|
|
|
360 |
|
|
#************************************************************ |
361 |
|
|
|
362 |
|
|
=pod |
363 |
|
|
|
364 |
|
|
=head2 trans_blank |
365 |
|
|
|
366 |
|
|
=over 4 |
367 |
|
|
|
368 |
|
|
=item trans_blank($value, [$default]) |
369 |
|
|
|
370 |
|
|
=back |
371 |
|
|
|
372 |
|
|
Returns $value if it is defined with length greater than zero and C<$default> if it is not. |
373 |
|
|
|
374 |
|
|
If $default is not included, then an empty string is used for C<$default>. |
375 |
|
|
|
376 |
|
|
=cut |
377 |
|
|
|
378 |
|
|
#************************************************************ |
379 |
|
|
|
380 |
|
|
sub trans_blank { |
381 |
|
|
|
382 |
|
|
# No parameter, return undef |
383 |
|
|
if ( $#_ < 0 ) { |
384 |
|
|
carp("Usage: trans_blank(<string> [<return if undef>])"); |
385 |
|
|
return undef; |
386 |
|
|
} |
387 |
|
|
|
388 |
|
|
my $default_value = ""; |
389 |
|
|
$default_value = $_[1] if $#_ > 0; |
390 |
|
|
$default_value = $_[0] if defined( $_[0] ) && length( $_[0] ) > 0; |
391 |
|
|
return $default_value; |
392 |
|
|
} |
393 |
|
|
|
394 |
|
|
#************************************************************ |
395 |
|
|
|
396 |
|
|
=pod |
397 |
|
|
|
398 |
|
|
=head2 trim_fmt |
399 |
|
|
|
400 |
|
|
=over 4 |
401 |
|
|
|
402 |
|
|
=item trim_fmt($width_to_use, @strings_to_format) |
403 |
|
|
|
404 |
|
|
=back |
405 |
|
|
|
406 |
|
|
Trim all strings so that their length is not greater than |
407 |
|
|
C<$width_to_use>. |
408 |
|
|
|
409 |
|
|
=cut |
410 |
|
|
|
411 |
|
|
#************************************************************ |
412 |
|
|
|
413 |
|
|
sub trim_fmt { |
414 |
|
|
|
415 |
|
|
# No parameter, return undef |
416 |
|
|
if ( $#_ < 1 ) { |
417 |
|
|
carp("Usage: trim_fmt(<len> <strings to format>)"); |
418 |
|
|
return undef; |
419 |
|
|
} |
420 |
|
|
|
421 |
|
|
my $len = shift; |
422 |
|
|
my @rc; |
423 |
|
|
foreach my $str (@_) { |
424 |
|
|
my $slop = $len - length($str); |
425 |
|
|
$str = substr( $str, $[, $len ) if $slop < 0; |
426 |
|
|
push ( @rc, $str ); |
427 |
|
|
} |
428 |
|
|
return wantarray ? @rc : $rc[0]; |
429 |
|
|
} |
430 |
|
|
|
431 |
|
|
#************************************************************ |
432 |
|
|
|
433 |
|
|
=pod |
434 |
|
|
|
435 |
|
|
=head2 trim_space |
436 |
|
|
|
437 |
|
|
=over 4 |
438 |
|
|
|
439 |
|
|
=item trim_space(@strings_to_format) |
440 |
|
|
|
441 |
|
|
=back |
442 |
|
|
|
443 |
|
|
Remove leading and trailing white space. |
444 |
|
|
The parameters are modified. |
445 |
|
|
|
446 |
|
|
=cut |
447 |
|
|
|
448 |
|
|
#************************************************************ |
449 |
|
|
|
450 |
|
|
sub trim_space { |
451 |
|
|
|
452 |
|
|
# No parameter, return undef |
453 |
|
|
if ( $#_ < 0 ) { |
454 |
|
|
carp("Usage: trim_space(<strings to compact>"); |
455 |
|
|
return undef; |
456 |
|
|
} |
457 |
|
|
|
458 |
|
|
for (@_) { |
459 |
|
|
s/^\s*//; # Remove spaces from front |
460 |
|
|
s/\s*$//; # Remove spaces from end |
461 |
|
|
# |
462 |
|
|
# The following takes longer: |
463 |
|
|
# |
464 |
|
|
#($_) = ($_ =~ /^\s*(.*?)\s*$/); |
465 |
|
|
} |
466 |
|
|
return wantarray ? @_ : $_[0]; |
467 |
|
|
} |
468 |
|
|
|
469 |
|
|
#************************************************************ |
470 |
|
|
|
471 |
|
|
=pod |
472 |
|
|
|
473 |
|
|
=head2 right_fmt |
474 |
|
|
|
475 |
|
|
=over 4 |
476 |
|
|
|
477 |
|
|
=item right_fmt($width_to_use, @strings_to_format) |
478 |
|
|
|
479 |
|
|
=back |
480 |
|
|
|
481 |
|
|
Each string has enough spaces prepended end so that the |
482 |
|
|
total length is C<$width_to_use>. |
483 |
|
|
The strings are not truncated to fit into the space. |
484 |
|
|
|
485 |
|
|
=cut |
486 |
|
|
|
487 |
|
|
#************************************************************ |
488 |
|
|
|
489 |
|
|
sub right_fmt { |
490 |
|
|
|
491 |
|
|
# No parameter, return undef |
492 |
|
|
if ( $#_ < 1 ) { |
493 |
|
|
carp("Usage: right_fmt(<len> <strings to format>)"); |
494 |
|
|
return undef; |
495 |
|
|
} |
496 |
|
|
|
497 |
|
|
my $len = shift; |
498 |
|
|
my @rc; |
499 |
|
|
foreach my $str (@_) { |
500 |
|
|
my $slop = $len - length($str); |
501 |
|
|
$str = " " x $slop . $str if $slop > 0; |
502 |
|
|
push ( @rc, $str ); |
503 |
|
|
} |
504 |
|
|
return wantarray ? @rc : $rc[0]; |
505 |
|
|
} |
506 |
|
|
|
507 |
|
|
#************************************************************ |
508 |
|
|
#** ** |
509 |
|
|
#** Input: left indent to print ** |
510 |
|
|
#** how to grow left indent for recursive printing ** |
511 |
|
|
#** Separator for items (generally "\n") ** |
512 |
|
|
#** list of things to print ** |
513 |
|
|
#** ** |
514 |
|
|
#** Output: String you desire to print ** |
515 |
|
|
#** ** |
516 |
|
|
#** Notes: ** |
517 |
|
|
#** Apart from being stuck with the output format, ** |
518 |
|
|
#** this has problems with references to references ** |
519 |
|
|
#** printing ony the text REF rather than simply ** |
520 |
|
|
#** recursing the references which would not be ** |
521 |
|
|
#** that difficult. ** |
522 |
|
|
#** ** |
523 |
|
|
#************************************************************ |
524 |
|
|
|
525 |
|
|
#************************************************************ |
526 |
|
|
|
527 |
|
|
=pod |
528 |
|
|
|
529 |
|
|
=head2 smart_printer |
530 |
|
|
|
531 |
|
|
=over 4 |
532 |
|
|
|
533 |
|
|
=item smart_printer($left, $left_grow, $separator, @Things_to_print) |
534 |
|
|
|
535 |
|
|
=back |
536 |
|
|
|
537 |
|
|
Attempts to print almost any object in a pretty fashion. |
538 |
|
|
The C<$left> parameter determines what is printed before each thing printed. |
539 |
|
|
The C<$left_grow> parameter determines the new C<$left> if smart_printer() is recursively called. |
540 |
|
|
the C<$separator> is printed between each item. |
541 |
|
|
|
542 |
|
|
|
543 |
|
|
A Scalar is printed. |
544 |
|
|
|
545 |
|
|
A Hash is printed as C<{ key =E<gt> value key =E<gt> value }> |
546 |
|
|
|
547 |
|
|
An Array is printed as C<( value value )> |
548 |
|
|
|
549 |
|
|
Keys and values can also be references. |
550 |
|
|
|
551 |
|
|
=cut |
552 |
|
|
|
553 |
|
|
#************************************************************ |
554 |
|
|
|
555 |
|
|
sub smart_printer { |
556 |
|
|
if ( $#_ < 3 ) { |
557 |
|
|
carp( |
558 |
|
|
"usage: smart_printer(<left> <left_grow> <item_seperator> <things to print>)" |
559 |
|
|
); |
560 |
|
|
return undef; |
561 |
|
|
} |
562 |
|
|
|
563 |
|
|
my $indent = shift; |
564 |
|
|
my $indent_grow = shift; |
565 |
|
|
my $item_separator = shift; |
566 |
|
|
my $txt = ''; |
567 |
|
|
foreach my $thing_to_print (@_) { |
568 |
|
|
if ( !defined($thing_to_print) ) { |
569 |
|
|
$txt .= $indent . 'undef' . $item_separator; |
570 |
|
|
} |
571 |
|
|
else { |
572 |
|
|
my $ref_type = ref $thing_to_print; |
573 |
|
|
if ( !$ref_type ) { |
574 |
|
|
$txt .= "$indent$thing_to_print$item_separator"; |
575 |
|
|
} |
576 |
|
|
elsif ( $ref_type eq 'SCALAR' ) { |
577 |
|
|
$txt .= smart_printer( $indent, $indent_grow, $item_separator, |
578 |
|
|
$$thing_to_print ); |
579 |
|
|
} |
580 |
|
|
elsif ( $ref_type eq 'ARRAY' ) { |
581 |
|
|
$txt .= "$indent($item_separator"; |
582 |
|
|
foreach my $array_thing (@$thing_to_print) { |
583 |
|
|
$txt .= smart_printer( |
584 |
|
|
$indent . $indent_grow, $indent_grow, |
585 |
|
|
$item_separator, $array_thing |
586 |
|
|
); |
587 |
|
|
} |
588 |
|
|
$txt .= "$indent)$item_separator"; |
589 |
|
|
} |
590 |
|
|
elsif ( UNIVERSAL::isa( $thing_to_print, 'HASH' ) ) { |
591 |
|
|
my $width = hash_key_width(%$thing_to_print); |
592 |
|
|
|
593 |
|
|
# |
594 |
|
|
# Remember that each hash has one universal iterator |
595 |
|
|
# recursive nesting will therefore cause stranger |
596 |
|
|
# results than a simple infinite loop. |
597 |
|
|
# |
598 |
|
|
$txt .= "$indent\{$item_separator"; |
599 |
|
|
my ( $key, $value ); |
600 |
|
|
while ( ( $key, $value ) = each %$thing_to_print ) { |
601 |
|
|
$txt .= $indent |
602 |
|
|
. $indent_grow |
603 |
|
|
. left_fmt( $width, $key ) . ' => '; |
604 |
|
|
$value = '' if !defined($value); |
605 |
|
|
if ( !ref($value) ) { |
606 |
|
|
$txt .= "$value$item_separator"; |
607 |
|
|
} |
608 |
|
|
elsif ( ref($value) eq 'SCALAR' ) { |
609 |
|
|
$txt .= |
610 |
|
|
smart_printer( '', $indent_grow, $item_separator, |
611 |
|
|
$value ); |
612 |
|
|
} |
613 |
|
|
else { |
614 |
|
|
$txt .= $item_separator; |
615 |
|
|
$txt .= |
616 |
|
|
smart_printer( $indent . $indent_grow . $indent_grow, |
617 |
|
|
$indent_grow, $item_separator, $value ); |
618 |
|
|
} |
619 |
|
|
} |
620 |
|
|
$txt .= "$indent}$item_separator"; |
621 |
|
|
} |
622 |
|
|
else { |
623 |
|
|
$txt .= "$indent$ref_type$item_separator"; |
624 |
|
|
|
625 |
|
|
$txt .= "$indent<$item_separator"; |
626 |
|
|
$txt .= smart_printer( |
627 |
|
|
$indent . $indent_grow, $indent_grow, |
628 |
|
|
$item_separator, $$thing_to_print |
629 |
|
|
); |
630 |
|
|
$txt .= "$indent>$item_separator"; |
631 |
|
|
} |
632 |
|
|
} |
633 |
|
|
} |
634 |
|
|
return $txt; |
635 |
|
|
} |
636 |
|
|
|
637 |
|
|
#************************************************************ |
638 |
|
|
|
639 |
|
|
=pod |
640 |
|
|
|
641 |
|
|
=head2 smart_printer_default |
642 |
|
|
|
643 |
|
|
=over 4 |
644 |
|
|
|
645 |
|
|
=item smart_printer_default(Things to print) |
646 |
|
|
|
647 |
|
|
=back |
648 |
|
|
|
649 |
|
|
Each parameter is printed using smart_printer() using default parameters. |
650 |
|
|
the items are printed with no initial left indent, |
651 |
|
|
recursive indents using two extra spaces, and a new line for the |
652 |
|
|
item separator. |
653 |
|
|
|
654 |
|
|
=cut |
655 |
|
|
|
656 |
|
|
#************************************************************ |
657 |
|
|
|
658 |
|
|
sub smart_printer_default { |
659 |
|
|
return smart_printer( '', ' ', "\n", @_ ); |
660 |
|
|
} |
661 |
|
|
|
662 |
|
|
#************************************************************ |
663 |
|
|
|
664 |
|
|
=pod |
665 |
|
|
|
666 |
|
|
=head1 COPYRIGHT |
667 |
|
|
|
668 |
|
|
Copyright 1998-2002, Andrew Pitonyak (perlboy@pitonyak.org) |
669 |
|
|
|
670 |
|
|
This library is free software; you can redistribute it and/or |
671 |
|
|
modify it under the same terms as Perl itself. |
672 |
|
|
|
673 |
|
|
=head1 Modification History |
674 |
|
|
|
675 |
|
|
=head2 March 13, 1998 |
676 |
|
|
|
677 |
|
|
Version 1.00 First release |
678 |
|
|
|
679 |
|
|
=head2 September 10, 2002 |
680 |
|
|
|
681 |
|
|
Version 1.01 Changed internal documentation to POD |
682 |
|
|
|
683 |
|
|
=cut |
684 |
|
|
|
685 |
|
|
#************************************************************ |
686 |
|
|
|
687 |
|
|
1; |
688 |
|
|
|