libs/Pitonyak/StringUtil.pm

package Pitonyak::StringUtil;

#************************************************************

=head1 NAME

Pitonyak::StringUtil - File and directory scanning based on regular expressions.

=head1 SYNOPSIS

use Pitonyak::StringUtil

=head1 DESCRIPTION

=cut

#************************************************************

require Exporter;
$VERSION = '1.01';

@ISA    = qw(Exporter);
@EXPORT = qw(
);

@EXPORT_OK = qw(
  array_width
  center_fmt
  compact_space
  hash_key_width
  hash_val_width
  left_fmt
  num_int_digits
  num_with_leading_zeros
  trans_blank
  trim_fmt
  trim_space
  right_fmt
  smart_printer
  smart_printer_default
);

use Carp;
use strict;

#************************************************************

=pod

=head2 array_width

=over 4

=item array_width([arg1], [arg2], ... [argn])

=back

Find the maximum width of a list of elements.
Each element should either be a scalar or a reference to an array.

=cut

#************************************************************

sub array_width {
    my $width = 0;
    my $this_width;
    foreach (@_) {
        $this_width = ( ref($_) ne 'ARRAY' ) ? length($_) : array_width(@$_);
        $width = $this_width if $this_width > $width;
    }
    return $width;
}

#************************************************************

=pod

=head2 center_fmt

=over 4

=item center_fmt($width_to_use, @strings_to_format)

=back

Center the strings in the specified width.
the strings are left and right padded to use the entire width.
The strings are truncated to fit into the space.

=cut

#************************************************************

sub center_fmt {

    # No parameter, return undef
    if ( $#_ < 1 ) {
        carp("Usage: center_fmt(<len> <strings to format>)");
        return undef;
    }

    my $len     = $_[0];
    my @strings = trim_fmt(@_);
    my @rc;
    foreach my $str (@strings) {
        my $slop        = $len - length($str);
        my $left_space  = int( $slop / 2 );
        my $right_space = $slop - $left_space;
        $str = " " x $left_space . $str . " " x $right_space if $slop > 0;
        push ( @rc, $str );
    }
    return wantarray ? @strings : $strings[0];
}

#************************************************************

=pod

=head2 compact_space

=over 4

=item compact_space(@list_of_strings)

=back

Removes the spaces from the strings.

Each string is potentially modified.
Leading and trailing white space is removed.
Runs of white space is turned to one space.
This modifies the calling parameters.

=cut

#************************************************************

sub compact_space {

    # No parameter, return undef
    if ( $#_ < 0 ) {
        carp("Usage: compact_space(<strings to compact>");
        return undef;
    }

    for (@_) {

        #
        # This new method is about four times faster
        # than the split and join
        # $_ = join ' ', split /\s+/, $_;     # split then join
        #
        tr/ //s;

        #
        # Save a call to trim_space() at the end!
        #
        s/^\s*//;    # Remove spaces from front
        s/\s*$//;    # Remove spaces from end
    }
    return wantarray ? @_ : $_[0];
}

#************************************************************

=pod

=head2 hash_key_width

=over 4

=item hash_key_width($hash_reference)

=back

Determine the maximum width of the keys in this hash

=cut

#************************************************************

sub hash_key_width(\%) {

    # No parameter, return 0
    if ( $#_ < 0 || !UNIVERSAL::isa( $_[0], 'HASH' ) ) {
        carp("Usage: hash_key_width(<hash_reference>)");
        return 0;
    }

    my $hash_ref = shift;
    my $ref_type = ref($hash_ref);
    my $width    = 0;
    foreach my $key ( keys %$hash_ref ) {
        $width = length($key) if length($key) > $width;
    }
    return $width;
}

#************************************************************

=pod

=head2 hash_val_width

=over 4

=item hash_val_width($hash_reference)

=back

Determine the maximum width of the values in this hash

=cut

#************************************************************

sub hash_val_width(\%) {

    # No parameter, return 0
    if ( $#_ < 0 || !UNIVERSAL::isa( $_[0], 'HASH' ) ) {
        carp("Usage: hash_val_width(<hash_reference>)");
        return 0;
    }

    my $hash_ref = shift;
    my $ref_type = ref($hash_ref);
    my $width    = 0;
    foreach my $key ( keys %$hash_ref ) {
        $width = length( $hash_ref->{$key} )
          if length( $hash_ref->{$key} ) > $width;
    }
    return $width;
}

#************************************************************

=pod

=head2 left_fmt

=over 4

=item left_fmt($width_to_use, @strings_to_format)

=back

Each string has enough spaces appended end so that the
total length is C<$width_to_use>.
The strings are not truncated to fit into the space.

=cut

#************************************************************

sub left_fmt {

    # No parameter, return undef
    if ( $#_ < 1 ) {
        carp("Usage: left_fmt(<len> <strings to format>)");
        return undef;
    }

    my $len = shift;
    my @rc;
    foreach my $str (@_) {
        my $slop = $len - length($str);
        $str = $str . " " x $slop if $slop > 0;
        push ( @rc, $str );
    }
    return wantarray ? @rc : $rc[0];
}

#************************************************************

=pod

=head2 num_int_digits

=over 4

=item num_int_digits($number)

=back

This returns the length of a number

=cut

#************************************************************

sub num_int_digits {

    # No parameter, return undef
    if ( $#_ < 0 ) {
        carp("Usage: num_int_digits(<number>");
        return undef;
    }
    return length( sprintf( "%d", $_[0] ) );
}

#************************************************************

=pod

=head2 num_with_leading_zeros

=over 4

=item num_with_leading_zeros(($width_to_use, @numbers_to_format)

=back

Returns N-digit strings representing the number with leading zeros.

Modulo is used to chop the number.

If C<numDigits E<lt> 0>, then leading negative signs are included.

=cut

#************************************************************

sub num_with_leading_zeros($$) {

    # No parameter, return undef
    if ( $#_ < 1 ) {
        carp("Usage: num_with_leading_zeros(<length> <list of numbers>");
        return undef;
    }

    my $num_digits = shift;
    my @rc;
    foreach (@_) {
        my $num    = $_;
        my $rvalue = "";
        if ( $num_digits != 0 ) {
            if ( $num_digits < 0 ) {
                $num_digits = -$num_digits;
                if ( $num < 0 ) {
                    --$num_digits;
                    $rvalue = "-";
                }
            }
            $num = -$num if $num < 0;
            my $tmp = sprintf "%d", $num;
            my $lead_zero = $num_digits - length($tmp);
            if ( $lead_zero > 0 ) {
                $rvalue .= "0" x $lead_zero . $tmp;
            }
            else {
                $rvalue .= substr $tmp, $[ - $lead_zero;
            }
        }
        push ( @rc, $rvalue );
    }
    return wantarray ? @rc : $rc[0];
}

#************************************************************

=pod

=head2 trans_blank

=over 4

=item trans_blank($value, [$default])

=back

Returns $value if it is defined with length greater than zero and C<$default> if it is not.

If $default is not included, then an empty string is used for C<$default>.

=cut

#************************************************************

sub trans_blank {

    # No parameter, return undef
    if ( $#_ < 0 ) {
        carp("Usage: trans_blank(<string> [<return if undef>])");
        return undef;
    }

    my $default_value = "";
    $default_value = $_[1] if $#_ > 0;
    $default_value = $_[0] if defined( $_[0] ) && length( $_[0] ) > 0;
    return $default_value;
}

#************************************************************

=pod

=head2 trim_fmt

=over 4

=item trim_fmt($width_to_use, @strings_to_format)

=back

Trim all strings so that their length is not greater than
C<$width_to_use>.

=cut

#************************************************************

sub trim_fmt {

    # No parameter, return undef
    if ( $#_ < 1 ) {
        carp("Usage: trim_fmt(<len> <strings to format>)");
        return undef;
    }

    my $len = shift;
    my @rc;
    foreach my $str (@_) {
        my $slop = $len - length($str);
        $str = substr( $str, $[, $len ) if $slop < 0;
        push ( @rc, $str );
    }
    return wantarray ? @rc : $rc[0];
}

#************************************************************

=pod

=head2 trim_space

=over 4

=item trim_space(@strings_to_format)

=back

Remove leading and trailing white space.
The parameters are modified.

=cut

#************************************************************

sub trim_space {

    # No parameter, return undef
    if ( $#_ < 0 ) {
        carp("Usage: trim_space(<strings to compact>");
        return undef;
    }

    for (@_) {
        s/^\s*//;    # Remove spaces from front
        s/\s*$//;    # Remove spaces from end
                     #
                     # The following takes longer:
                     #
                     #($_) = ($_ =~ /^\s*(.*?)\s*$/);
    }
    return wantarray ? @_ : $_[0];
}

#************************************************************

=pod

=head2 right_fmt

=over 4

=item right_fmt($width_to_use, @strings_to_format)

=back

Each string has enough spaces prepended end so that the
total length is C<$width_to_use>.
The strings are not truncated to fit into the space.

=cut

#************************************************************

sub right_fmt {

    # No parameter, return undef
    if ( $#_ < 1 ) {
        carp("Usage: right_fmt(<len> <strings to format>)");
        return undef;
    }

    my $len = shift;
    my @rc;
    foreach my $str (@_) {
        my $slop = $len - length($str);
        $str = " " x $slop . $str if $slop > 0;
        push ( @rc, $str );
    }
    return wantarray ? @rc : $rc[0];
}

#************************************************************
#**                                                        **
#**  Input: left indent to print                           **
#**         how to grow left indent for recursive printing **
#**         Separator for items (generally "\n")           **
#**         list of things to print                        **
#**                                                        **
#**  Output: String you desire to print                    **
#**                                                        **
#**  Notes:                                                **
#**  Apart from being stuck with the output format,        **
#**  this has problems with references to references       **
#**  printing ony the text REF rather than simply          **
#**  recursing the references which would not be           **
#**  that difficult.                                       **
#**                                                        **
#************************************************************

#************************************************************

=pod

=head2 smart_printer

=over 4

=item smart_printer($left, $left_grow, $separator, @Things_to_print)

=back

Attempts to print almost any object in a pretty fashion.
The C<$left> parameter determines what is printed before each thing printed.
The C<$left_grow> parameter determines the new C<$left> if smart_printer() is recursively called.
the C<$separator> is printed between each item.


A Scalar is printed.

A Hash is printed as C<{ key =E<gt> value key =E<gt> value }>

An Array is printed as C<( value value )>

Keys and values can also be references.

=cut

#************************************************************

sub smart_printer {
    if ( $#_ < 3 ) {
        carp(
"usage: smart_printer(<left> <left_grow> <item_seperator> <things to print>)"
        );
        return undef;
    }

    my $indent         = shift;
    my $indent_grow    = shift;
    my $item_separator = shift;
    my $txt            = '';
    foreach my $thing_to_print (@_) {
        if ( !defined($thing_to_print) ) {
            $txt .= $indent . 'undef' . $item_separator;
        }
        else {
            my $ref_type = ref $thing_to_print;
            if ( !$ref_type ) {
                $txt .= "$indent$thing_to_print$item_separator";
            }
            elsif ( $ref_type eq 'SCALAR' ) {
                $txt .= smart_printer( $indent, $indent_grow, $item_separator,
                    $$thing_to_print );
            }
            elsif ( $ref_type eq 'ARRAY' ) {
                $txt .= "$indent($item_separator";
                foreach my $array_thing (@$thing_to_print) {
                    $txt .= smart_printer(
                        $indent . $indent_grow, $indent_grow,
                        $item_separator,        $array_thing
                    );
                }
                $txt .= "$indent)$item_separator";
            }
            elsif ( UNIVERSAL::isa( $thing_to_print, 'HASH' ) ) {
                my $width = hash_key_width(%$thing_to_print);

                #
                # Remember that each hash has one universal iterator
                # recursive nesting will therefore cause stranger
                # results than a simple infinite loop.
                #
                $txt .= "$indent\{$item_separator";
                my ( $key, $value );
                while ( ( $key, $value ) = each %$thing_to_print ) {
                    $txt .= $indent
                      . $indent_grow
                      . left_fmt( $width, $key ) . ' => ';
                    $value = '' if !defined($value);
                    if ( !ref($value) ) {
                        $txt .= "$value$item_separator";
                    }
                    elsif ( ref($value) eq 'SCALAR' ) {
                        $txt .=
                          smart_printer( '', $indent_grow, $item_separator,
                            $value );
                    }
                    else {
                        $txt .= $item_separator;
                        $txt .=
                          smart_printer( $indent . $indent_grow . $indent_grow,
                            $indent_grow, $item_separator, $value );
                    }
                }
                $txt .= "$indent}$item_separator";
            }
            else {
                $txt .= "$indent$ref_type$item_separator";

                $txt .= "$indent<$item_separator";
                $txt .= smart_printer(
                    $indent . $indent_grow, $indent_grow,
                    $item_separator,        $$thing_to_print
                );
                $txt .= "$indent>$item_separator";
            }
        }
    }
    return $txt;
}

#************************************************************

=pod

=head2 smart_printer_default

=over 4

=item smart_printer_default(Things to print)

=back

Each parameter is printed using smart_printer() using default parameters.
the items are printed with no initial left indent,
recursive indents using two extra spaces, and a new line for the
item separator.

=cut

#************************************************************

sub smart_printer_default {
    return smart_printer( '', '  ', "\n", @_ );
}

#************************************************************

=pod

=head1 COPYRIGHT

Copyright 1998-2002, Andrew Pitonyak (perlboy@pitonyak.org)

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 Modification History

=head2 March 13, 1998

Version 1.00 First release

=head2 September 10, 2002

Version 1.01 Changed internal documentation to POD

=cut

#************************************************************

1;

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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26