better place

2025-12-16 20:21:02 +01:00 · 2017-04-05 23:29:59 +02:00
parent e4f9e2f325
commit 1e88ebd049
1 changed files with 142 additions and 0 deletions
--- a/sample/bin/inspect.pl
+++ b/sample/bin/inspect.pl
@@ -0,0 +1,142 @@
+#!/usr/bin/perl -w
+
+# Copyright  (c)  2015-2017  T.v.Dein <tlinden  |AT|  cpan.org>.   All
+# Rights Reserved. Std. disclaimer applies.  Artistic License, same as
+# perl itself. Have fun.
+
+# This  script  can   be  used  to  interactively   browse  perl  data
+# structures, which it reads from STDIN or a file. You can use it, for
+# instance, by printing some data  structure in your application using
+# Data::Dumper and piping this output into this scripts input.
+
+# However,  if the  argument is  a file  and has  a known  suffix, the
+# script  automatically converts  it into  a perl  data structure  and
+# drops  you into  an interactive  shell on  that.  That  way you  can
+# interactively browse XML or YAML files. Supported suffixes are: xml,
+# json, csv, yml, ini, conf.
+
+# If the data structure evaulates, you'll be dropped into an interactive
+# prompt. Enter '?' to get help.
+
+# The script also demonstrates how to use different serializers.
+
+use Data::Interactive::Inspect;
+use Data::Dumper;
+use YAML; # needs to be installed anyway
+use strict;
+
+
+sub usage {
+  print STDERR qq(
+Usage: $0 <file|-h>
+
+Reads a  perl data structure  from <file>. If  <file> is -,  read from
+STDIN. Evaluates  and start an  interactive Data::Interactive::Inspect
+shell, which can be used to analyze the data.
+);
+  exit 1;
+}
+
+
+my $arg  = shift;
+my $perl = 1;
+my ($code);
+
+if (! $arg) {
+  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
+}
+
+
+
+
+
+
+