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;