view release on metacpan or  search on metacpan

sample/bin/inspect.pl  view on Meta::CPAN

  usage;
}

if ($arg ne '-' && ! -e $arg) {
  print STDERR "$arg not found or not readable!\n";
  usage;
}

if ($arg eq '-') {
   loaddumper(join '', <>);
}
else {
  if ($arg =~ /\.xml$/i) {
    eval { require XML::Simple; };
    die "Sorry, XML::Simple is not installed, XML not supported!\n" if($@);
    my $xml = new XML::Simple;
    $code = $xml->XMLin($arg);
    $perl = 0;
  }
  elsif ($arg =~ /\.(yaml|yml)$/i) {
    $code = YAML::LoadFile($arg);
    $perl = 0;
  }
  elsif ($arg =~ /\.ini$/i) {
    eval { require Config::INI::Reader; };
    die "Sorry, Config::INI is not installed, INI not supported!\n" if($@);
    $code = Config::INI::Reader->read_file($arg);
    $perl = 0;
  }
  elsif ($arg =~ /\.conf$/i) {
    eval { require Config::General; };
    die "Sorry, Config::General is not installed, CONF not supported!\n" if($@);
    %{$code} = Config::General::ParseConfig(-ConfigFile => $arg, -InterPolateVars => 1, -UTF8 => 1);
    $perl = 0;
  }
  elsif ($arg =~ /\.json$/i) {
    eval { require JSON; };
    die "Sorry, JSON is not installed, JSON not supported!\n" if($@);
    my $json = JSON->new->utf8();
    $code = $json->decode(slurp($arg));
  }
  elsif ($arg =~ /\.csv$/i) {
    eval { require Text::CSV::Slurp; };
    die "Sorry, Text::CSV::Slurp is not installed, CSV not supported!\n" if($@);
    $code = Text::CSV::Slurp->load(file => $arg);
  }
  else {
    loaddumper(slurp($arg));
  }
}

if ($@) {
  print STDERR "Parser or Eval error: $@!\n";
  exit 1;
}
else {
  if ($perl) {
    Data::Interactive::Inspect->new(struct      => $code,
                                    serialize   => sub { my $db = shift;
                                                         my $c = Dumper($db);
                                                         $c =~ s/^\s*\$[a-zA-Z0-9_]*\s*=\s*/        /;
                                                         return $c;
                                                       },
                                    deserialze  => sub { my $code = shift;
                                                         $code = "\$code = $code";
                                                         eval $code;
                                                         return $code;
                                                       },
                                   )->inspect;
  }
  else {
    # no perl struct, stay with default
    Data::Interactive::Inspect->new(struct => $code)->inspect;
  }
}


sub slurp {
  my $arg = shift;
  open CODE, "<$arg" or die "Could not open data file $arg: $!\n";
  my $code = join '', <CODE>;
  close CODE;
  return $code;
}

sub loaddumper {
  my $dump = shift;
  $dump =~ s/^\s*\$[a-zA-Z0-9_]*\s*=\s*/\$code = /;
  eval $dump; # fills global $code
}