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;