/[cvs]/nfo/perl/libs/Pitonyak/StringUtil.pm
ViewVC logotype

Contents of /nfo/perl/libs/Pitonyak/StringUtil.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Thu Feb 20 21:19:15 2003 UTC (21 years, 2 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
+ initial commit - cloned

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

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed