package Pitonyak::StringUtil; #************************************************************ =head1 NAME Pitonyak::StringUtil - General string utilities. String module created by Andrew Pitonyak for his personal use to format strings for pretty output. =head1 SYNOPSIS The subroutines in this module are intended to be used as methods, not as calls on an object. Therefore, you should call all methods directly. Many of the subroutines modify the arguments. For example, when you trim space from a string, the argument is modified. Methods are not available unless they are specifically imported. So, to use the C<< smart_printer_default >> routine, you must first import it. For example, =begin html


use Pitonyak::StringUtil qw(smart_printer_default);        

my %hash2 = ('a' => 'A', 'b' => 'B');                      

my @strings = ('123456789', '123', \%hash2);               

my %hash1 = ('one' => 1, 'two' => 2, 'ary' => \@strings);  

print smart_printer_default(\%hash1);

=end html =head1 DESCRIPTION =cut #************************************************************ require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); $VERSION = '1.04'; @ISA = qw(Exporter); @EXPORT = qw( ); @EXPORT_OK = qw( array_width center_fmt compact_space delimited_values substr_no_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 Return the length of the longest string in an array. Arguments are not modified. =over 4 =item C<< array_width([arg1], [arg2], ... [argn]) >> Each argument or array element should be a scalar or a reference to an array. The primary usage is to print a group of strings in a fixed width field. For example: =begin html


use Pitonyak::StringUtil qw(array_width right_fmt);    

                                                          

my @strings = ('one', 'two', 'three', 'four');            

foreach (right_fmt(array_width(@strings), @strings)) {    

   print "$_\n";                                     

}

=end html produces: =begin html



  one  

  two  

three            

 four

=end html =back =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 Modify the arguments to be strings centered in the specified width. A string that is longer than the specified width is truncated. In array context, return the entire array. In scalar context, return only the first string. =over 4 =item C<< center_fmt($width_to_use, @strings_to_format) >> Modify the arguments to be strings centered in the specified width. =begin html

Modify the arguments to be strings centered in C<< $width_to_use >>.
The strings are left and right padded to use the entire width.
The strings are truncated to fit into the space if they are too long.


use Pitonyak::StringUtil qw(center_fmt);         

                                                    

my $long_str = 'I am really long';                  

my @strings = ('one', 'two', 'three', 'four');      

foreach (center_fmt(8, @strings, $long_str)) {      

  print "$_\n";                           

}

=end html produces: =begin html



  one  

  two  

 three      

  four 

I am rea

=end html =back =cut #************************************************************ sub center_fmt { # No parameter, return undef if ( $#_ < 1 ) { carp("Usage: center_fmt(, )"); 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 Modify each argument to change runs of white space to a single space. =over 4 =item C<< compact_space(@list_of_strings) >> Modify each argument to change runs of white space to a single space. =begin html

Arguments are modified.
Continuous spaces are changed to a single space.
Leading and trailing spaces are removed.


use Pitonyak::StringUtil qw(compact_space); 

                                               

my $test_str = '  one  two  ';                 

compact_space($test_str);                      

print "($test_str)\n";

"); 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 delimited_values =over 4 =item C<< delimited_values($delimiter, @values) >> For each string in C<< @values >>, split it based on the delimiter. White space is trimmed from the front and rear. An array of values is returned. C<< delimited_values(',', '1, 2, 3, 4'); >> =back =cut #************************************************************ sub delimited_values { my @values; my $delimiter = shift if ($#_ >= 0); foreach my $arg (@_) { push @values, map {trim_space($_)} split($delimiter, $arg); } return @values; } #************************************************************ =pod =head2 substr_no_space =over 4 =item C<< substr_no_space($line, $start, $len) >> Extract text from C<< $line >> starting at the zero based location C<< $start >>, with length C<< $len >>. Leading and trailing spaces are removed. Bounds are checked to avoid errors. =back =cut #************************************************************ sub substr_no_space { if ( $#_ != 2 ) { carp("Usage: substr_no_space(, , "); return undef; } my $llen = length($_[0]); return '' if ($llen <= $_[1]); my $rc = ($llen <= ($_[1] + $_[2])) ? substr($_[0], $_[1]) : substr($_[0], $_[1], $_[2]); return trim_space($rc); } #************************************************************ =pod =head2 hash_key_width =over 4 =item C<< hash_key_width($hash_reference) >> Determine the maximum width of the keys in a hash reference. Usually used to right justify hash keys. For example: =begin html


use Pitonyak::StringUtil qw(hash_key_width right_fmt); 

my %map = ('one'=>1, 'two'=> 2, 'three'=>3, 'four'=>4);   

my $width = hash_key_width(%map);                         

while ( my ($key, $value) = each(%map) ) {                

  print right_fmt($width, $key)." => $value\n"; 

}

=end html produces =begin html


three => 3            

  one => 1  

  two => 2  

 four => 4

=end html The function is defined as C<< sub hash_key_width(\%) >>, so Perl automatically uses a hash reference for the call; in the example above, C<< %map >> is used rather than C<< \%map >>. =back =cut #************************************************************ sub hash_key_width(\%) { # No parameter, return 0 if ( $#_ < 0 || !UNIVERSAL::isa( $_[0], 'HASH' ) ) { carp("Usage: hash_key_width()"); 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 C<< hash_val_width($hash_reference) >> Determine the maximum width of the values in a hash. The usage is the same as C<< hash_key_width >>. =back =cut #************************************************************ sub hash_val_width(\%) { # No parameter, return 0 if ( $#_ < 0 || !UNIVERSAL::isa( $_[0], 'HASH' ) ) { carp("Usage: hash_val_width()"); 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 Modify the arguments by appending space to force them to be the specified length. =over 4 =item left_fmt($width_to_use, @strings_to_format) Modify the arguments by appending space to force them to be the specified length. =begin html

Arguments are modified.
Append spaces so that each argument is the requested width.
Do not truncate arguments even if they are too long.


use Pitonyak::StringUtil qw(hash_key_width left_fmt);  

my %map = ('one'=>1, 'two'=> 2, 'three'=>3, 'four'=>4);   

my $width = hash_key_width(%map);                         

while ( my ($key, $value) = each(%map) ) {                

  print left_fmt($width, $key)." => $value\n"; 

}

=end html produces =begin html


three => 3            

one   => 1  

two   => 2  

four  => 4

=end html =back =cut #************************************************************ sub left_fmt { # No parameter, return undef if ( $#_ < 1 ) { carp("Usage: left_fmt(, )"); 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 C<< num_int_digits($integer_number) >> Return the number of digits in this integer. This method fails if the number is not an integer. For example, consider the following example: =back =begin html


use Pitonyak::StringUtil qw(num_int_digits right_fmt);              

my @numbers = (7, '00554', '+32', '-677', '123.456', 3.1415, 1.9e23);  

foreach my $num (@numbers) {                                           

  print right_fmt(9, $num)." = ".num_int_digits($num)." = ".right_fmt(9, 0+$num)." = ".right_fmt(4, sprintf( "%d", $num ))."\n"; 

}

=end html produces =begin html


        7 = 1 =         7 =    7 

    00554 = 3 =       554 =  554 

      +32 = 2 =        32 =   32 

     -677 = 4 =      -677 = -677           

  123.456 = 3 =   123.456 =  123 

   3.1415 = 1 =    3.1415 =    3 

 1.9e+023 = 2 =  1.9e+023 =   -1

=end html Make special note of the results for numbers with decimals, and especially for numbers that are very large in magnitude (as in much larger than an integer). =cut #************************************************************ sub num_int_digits { # No parameter, return undef if ( $#_ < 0 ) { carp("Usage: num_int_digits("); return undef; } return length( sprintf( "%d", $_[0] ) ); } #************************************************************ =pod =head2 num_with_leading_zeros Format numbers to contain leading zeros. =over 4 =item num_with_leading_zeros(($width_to_use, @numbers_to_format) Return N-digit strings representing the number with leading zeros. =begin html

Arguments are NOT modified.
Negative signs are not returned unless the width is negative.
Prepend the number with leading zeros to force the string to the specified length.
Numbers are printed as integers, and really large numbers are a problem (see example).


use Pitonyak::StringUtil qw(num_with_leading_zeros);                

my @numbers = (7, '00554', '+32', '-677', '123.456', 3.1415, 1.9e23);  

foreach my $num (@numbers) {                                           

  print num_with_leading_zeros(-5, $num)." <= $num\n";       

}

=end html produces =begin html


00007 <= 7          

00554 <= 00554      

00032 <= +32        

-0677 <= -677       

00123 <= 123.456    

00003 <= 3.1415     

-0001 <= 1.9e+023

=end html =back =cut #************************************************************ sub num_with_leading_zeros { # No parameter, return undef if ( $#_ < 1 ) { carp("Usage: num_with_leading_zeros(, "); return undef; } my $desired_digits = shift; my @rc; my $negative = 0; if ($desired_digits < 0) { $desired_digits = -$desired_digits; $negative = 1; } foreach (@_) { my $num_digits = $desired_digits; my $num = sprintf "%d", $_; my $rvalue = ""; if ( $num < 0 ) { $num = -$num; if ($negative) { --$num_digits; $rvalue = '-'; } } if ( $num_digits != 0 ) { my $tmp = $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 C<< trans_blank($value) >> Return C<< $value >> if it is defined, and an empty string if it is not. The C<< trans_blank >> method is roughly equivalent to: C<< return defined($value) ? $value : ''; >> The primary purpose is to avoid warnings such as "Use of uninitialized value in concatenation (.) or string at...". =begin html


use Pitonyak::StringUtil qw(trans_blank); 

my $x;                                       

my $y = '7';                                 

                                             

print "($x)\n";                  #Casues a warning message.   

print '('.trans_blank($x).")\n"; #No warning message.  

print '('.trans_blank($y).")\n"; #No warning message.

=end html =item C<< trans_blank($value, $default) >> Returns $value if it is defined with length greater than zero and C<< $default >> if it is not. In other words, a string of length zero is treated the same as an undefined value. A typical value for C<< $default >> is the empty string, which means C<< trans_blank >> is rarely called with two arguments. Return C<< $value >> if it is defined, and C<< $default >> if it is not. The C<< trans_blank >> method is roughly equivalent to: C<< return defined($value) ? $value : $default; >> The primary purpose is to avoid warnings such as "Use of uninitialized value in concatenation (.) or string at...". =begin html


use Pitonyak::StringUtil qw(trans_blank);  

my $x;                                        

my $y = '7';                                  

                                              

print '('.trans_blank($x, '<empty>').")\n"; # Print (<empty>)  

print '('.trans_blank($y, '<empty>').")\n"; # Print (7)

=end html =back =cut #************************************************************ sub trans_blank { # No parameter, return undef if ( $#_ < 0 ) { carp("Usage: trans_blank(, [])"); 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 C<< trim_fmt($width_to_use, @strings_to_format) >> Trim all strings so that their length is not greater than C<< $width_to_use >>. Strings that are too long are truncated. The string arguments are modified. =begin html


use Pitonyak::StringUtil qw(trim_fmt); 

my @strings = ('123456789', '123');       

trim_fmt(5, @strings);                    

print '('.join('), (', @strings).")\n";

=end html produces =begin html


(12345), (123)

=end html =back =cut #************************************************************ sub trim_fmt { # No parameter, return undef if ( $#_ < 1 ) { carp("Usage: trim_fmt(, )"); 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 C<< trim_space(@strings_to_format) >> Remove leading and trailing white space. The parameters are modified. =back =cut #************************************************************ sub trim_space { # No parameter, return undef if ( $#_ < 0 ) { carp("Usage: trim_space("); 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 Modify the arguments by prepending space to force them to be the specified length. =over 4 =item C<< right_fmt($width_to_use, @strings_to_format) >> Modify the arguments by prepending space to force them to be the specified length. =begin html

Arguments are modified.
Prepend spaces so that each argument is the requested width.
Do not truncate arguments even if they are too long.


use Pitonyak::StringUtil qw(hash_key_width right_fmt); 

my %map = ('one'=>1, 'two'=> 2, 'three'=>3, 'four'=>4);   

my $width = hash_key_width(%map);                         

while ( my ($key, $value) = each(%map) ) {                

  print right_fmt($width, $key)." => $value\n"; 

}

=end html produces =begin html


three => 3            

  one => 1  

  two => 2  

 four => 4

=end html =back =cut #************************************************************ sub right_fmt { # No parameter, return undef if ( $#_ < 1 ) { carp("Usage: right_fmt(, )"); 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 only the text REF rather than simply ** #** recursing the references which would not be ** #** that difficult. ** #** ** #************************************************************ #************************************************************ =pod =head2 smart_printer =over 4 =item C<< smart_printer($left, $left_grow, $separator, @Things_to_print) >> Print the argument in a pleasing way depending on the type. The arguments are not modified. The first three arguments direct how items are printed. =begin html

Left margin when an item is printed.
How to grow the left indent for recursive printing.
Separator used for items.

=end html An item is printed based on its type. =begin html

Left margin when an item is printed.
How to grow the left indent for recursive printing.
Separator used for items.
A scalar is printed directly.
A Hash is printed as { key => value ... }. Each key value pair is separated by the item separator (usually a new line).
An Array is printed as ( value ... ). Each value is separated by the item separator (usually a new line).
Keys and values can also be references.

=end html See C<< smart_printer_default >> to see a typical example. =back =cut #************************************************************ sub smart_printer { if ( $#_ < 3 ) { carp("usage: smart_printer(, , , )"); 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) Simple wrapper to call C<< smart_printer >>. =begin html

Items are printed with no initial left indent.
Recursive indents using two extra spaces.
A new line is the item separator.


use Pitonyak::StringUtil qw(smart_printer_default);     

my %hash2 = ('a' => 'A', 'b' => 'B');                      

my @strings = ('123456789', '123', \%hash2);               

my %hash1 = ('one' => 1, 'two' => 2, 'ary' => \@strings);  

print smart_printer_default(\%hash1);                      

}

=end html produces =begin html

=end html =back =cut #************************************************************ sub smart_printer_default { return smart_printer( '', ' ', "\n", @_ ); } #************************************************************ =pod =head1 COPYRIGHT Copyright 1998-2008, Andrew Pitonyak (andrew@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 =head2 January 24, 2007 Version 1.02 Updated POD and package name for use in CEFM project. Fixed a bug where each negative number caused the width to become smaller for the next iteration if multiple numbers were passed at the same time. =head2 September 16, 2008 Version 1.03 Updated POD for minor corrections. =cut #************************************************************ 1;