File Coverage

blib/lib/Data/VarPrint.pm

Criterion	Covered	Total	%
statement	6	46	13.0
branch	0	26	0.0
condition	0	6	0.0
subroutine	2	6	33.3
pod	0	2	0.0
total	8	86	9.3

package Data::VarPrint;

require 5.000;
require Exporter;
require AutoLoader;
use strict;
use vars qw(@ISA @EXPORT $VERSION);

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(&VarPrint &VarPrintAsString);

$VERSION = "1.01";  # $Date: 2002/08/15 2:08:15 $

sub VarPrint {
  print _VarPrintAsString(@_, ""), "\n";
}

sub VarPrintAsString {
  return _VarPrintAsString(@_, "")."\n";
}

sub _SimpleVarPrintAsString {
  my $var = shift;
  my $quot = (($var =~ /^[0-9]*(\.[0-9]*)?$/) && !($var =~ /^\.?$/) ? "" : "'");
  return $quot.$var.$quot;
}

sub _VarPrintAsString {
  my $result = "";
  my $spaces = pop;

#  return _VarPrintAsString(\@_, $spaces) if @_ > 1;

  my $value = shift;
  unless (defined $value) {
    return "undef";
  }

  if (@_ > 1 || ref($value) eq "ARRAY") {
    if (@_ > 1) {
      $result .= "(";
      $value = \@_;
    } else {
      $result .= "[";
    }
    my $separator = "";
    my $nl = ((grep { ref($_) =~ /^(HASH|ARRAY)$/ } @$value) == 0);
    unless ($nl) {
      $spaces .= "  ";
      $result .= "\n$spaces"
    };
    foreach my $item (@$value) {
      $result .= $separator._VarPrintAsString($item, $spaces);
      $separator = ",".($nl ? " " : "\n$spaces");
    }
    $spaces =~ s/  (.*)$/$1/;
    $result .= "\n$spaces" unless $nl;
    $result .= (@_ > 1 ? ")" : "]");
  } elsif (ref($value) eq "HASH") {
    if (keys %$value > 0) {
      $result .= "{\n";
      my $separator = "";
      foreach my $key (sort keys %$value) {
        $result .= $separator.$spaces."  "._SimpleVarPrintAsString($key)." => "._VarPrintAsString($value->{$key}, "$spaces  ");
        $separator = ",\n";
      }
      $result .= "\n$spaces}";
    } else {
      $result .= "{}";
    }
  } elsif (ref($value) eq "") {
    $result .= _SimpleVarPrintAsString($value);
  } elsif (ref($value) eq "SCALAR") {
    $result .= '\\'._SimpleVarPrintAsString($$value);
  } elsif (ref($value) eq "CODE") {
    $result .= "Subroutine";
  } else {
    $result .= "Object of class ".ref($value);
  }
  return $result;
}

1;

__END__