scip/Data-Interactive-Inspect
1
0
Fork 0
mirror of https://codeberg.org/scip/Data-Interactive-Inspect.git synced 2025-12-17 04:31:00 +01:00
Code Issues Packages Projects Releases Wiki Activity

fixed list array

Browse Source
This commit is contained in:
Thomas von Dein
2017-04-04 23:26:57 +02:00
parent 395ac4f678
commit bec7d2b572
3 changed files with 121 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
Changelog
View File

@@ -1,4 +1,9 @@
NEXT 0.06
fixed crash, which happened when one executed the
'list' command if inside an array. now we divert
to 'show' in such a case.
0.05
signal value matches in search with quotes signal value matches in search with quotes
0.04 0.04

219
Inspect.pm
View File

@@ -1,8 +1,8 @@
#!/usr/bin/perl #!/usr/bin/perl
# #
# Copyright (c) 2015 T.v.Dein <tlinden |AT| cpan.org>. # Copyright (c) 2015-2017 T.v.Dein <tlinden |AT| cpan.org>. All
# All Rights Reserved. Std. disclaimer applies. # Rights Reserved. Std. disclaimer applies. Artistic License, same as
# Artistic License, same as perl itself. Have fun. # perl itself. Have fun.
# #
@@ -21,7 +21,7 @@ no strict 'refs';
use Data::Dumper; use Data::Dumper;
$Data::Interactive::Inspect::VERSION = 0.05; $Data::Interactive::Inspect::VERSION = 0.06;
use vars qw(@ISA); use vars qw(@ISA);
@@ -39,18 +39,18 @@ sub new {
# defaults (= valid parameters) # defaults (= valid parameters)
my $self = { my $self = {
name => '', name => '',
begin => sub { print STDERR "unsupported\n"; }, begin => sub { print STDERR "unsupported\n"; },
commit => sub { print STDERR "unsupported\n"; }, commit => sub { print STDERR "unsupported\n"; },
rollback => sub { print STDERR "unsupported\n"; }, rollback => sub { print STDERR "unsupported\n"; },
export => sub { my ($db) = @_; return $db; }, export => sub { my ($db) = @_; return $db; },
serialize => sub { my $db = shift; return YAML::Dump($db); }, serialize => sub { my $db = shift; return YAML::Dump($db); },
deserialize => sub { my $db = shift; return YAML::Load($db); }, deserialize => sub { my $db = shift; return YAML::Load($db); },
struct => {}, struct => {},
editor => 'vi', editor => 'vi',
more => 'more', more => 'more',
silent => 0, silent => 0,
}; };
bless $self, $class; bless $self, $class;
@@ -62,7 +62,7 @@ sub new {
my %p = @param; my %p = @param;
foreach my $k (keys %{$self}) { foreach my $k (keys %{$self}) {
if (exists $p{$k}) { if (exists $p{$k}) {
$self->{$k} = $p{$k}; $self->{$k} = $p{$k};
} }
} }
if (exists $p{begin} && $p{commit} && $p{rollback}) { if (exists $p{begin} && $p{commit} && $p{rollback}) {
@@ -82,35 +82,35 @@ sub new {
# map commands+shortcuts to functions # map commands+shortcuts to functions
$self->{command} = { $self->{command} = {
l => 'list', l => 'list',
list => 'list', list => 'list',
show => 'show', show => 'show',
sh => 'show', sh => 'show',
dump => 'dump', dump => 'dump',
d => 'dump', d => 'dump',
get => 'get', get => 'get',
g => 'get', g => 'get',
enter => 'enter', enter => 'enter',
cd => 'enter', cd => 'enter',
set => 'set', set => 'set',
edit => 'edit', edit => 'edit',
e => 'edit', e => 'edit',
append=> 'append', append=> 'append',
drop => 'drop', drop => 'drop',
pop => 'mypop', pop => 'mypop',
shift => 'myshift', shift => 'myshift',
search=> 'search', search=> 'search',
'/' => 'search', '/' => 'search',
help => 'help', help => 'help',
h => 'help', h => 'help',
'?' => 'help', '?' => 'help',
quit => 'quit', quit => 'quit',
q => 'quit', q => 'quit',
}; };
if ($self->{transactions}) { if ($self->{transactions}) {
# map if supported # map if supported
foreach my $c(qw(begin commit rollback)) { foreach my $c (qw(begin commit rollback)) {
$self->{command}->{$c} = $c; $self->{command}->{$c} = $c;
} }
} }
@@ -147,7 +147,7 @@ sub inspect {
$self->{silent} = 1; $self->{silent} = 1;
foreach (split /\n/, $__cmds) { foreach (split /\n/, $__cmds) {
if (! $self->process($_, 1) ) { if (! $self->process($_, 1) ) {
last; last;
} }
} }
return $self->{struct}; return $self->{struct};
@@ -171,8 +171,8 @@ sub inspect {
my $prompt = $self->prompt; my $prompt = $self->prompt;
while ( defined ($_ = $term->readline($prompt)) ) { while ( defined ($_ = $term->readline($prompt)) ) {
if (! $self->process($_) ) { if (! $self->process($_) ) {
print "last\n"; print "last\n";
last; last;
} }
$prompt = $self->prompt; $prompt = $self->prompt;
} }
@@ -180,7 +180,7 @@ sub inspect {
else { else {
while (<STDIN>) { while (<STDIN>) {
if (! $self->process($_, 1) ) { if (! $self->process($_, 1) ) {
last; last;
} }
} }
} }
@@ -213,19 +213,19 @@ sub complete {
if ($start == 0) { if ($start == 0) {
# match on a command # match on a command
@matches = $self->{term}->completion_matches ($begin, sub { @matches = $self->{term}->completion_matches ($begin, sub {
my ($text, $state) = @_; my ($text, $state) = @_;
my @name = @{$self->{complete_words}}; my @name = @{$self->{complete_words}};
unless ($state) { unless ($state) {
$self->{complete_idx} = 0; $self->{complete_idx} = 0;
} }
while ($self->{complete_idx} <= $#name) { while ($self->{complete_idx} <= $#name) {
$self->{complete_idx}++; $self->{complete_idx}++;
return $name[$self->{complete_idx} - 1] return $name[$self->{complete_idx} - 1]
if ($name[$self->{complete_idx} - 1] =~ /^$text/); if ($name[$self->{complete_idx} - 1] =~ /^$text/);
} }
# no match # no match
return undef; return undef;
}); });
} }
elsif ($line =~ /[^\s]+\s+[^\s]+\s+/) { elsif ($line =~ /[^\s]+\s+[^\s]+\s+/) {
# command line is complete ($cmd $arg), stop with completion # command line is complete ($cmd $arg), stop with completion
@@ -236,19 +236,19 @@ sub complete {
if (grep {$cmd eq $_} @{$self->{commandargs}}) { if (grep {$cmd eq $_} @{$self->{commandargs}}) {
# only match for commands which support args # only match for commands which support args
@matches = $self->{term}->completion_matches ($begin, sub { @matches = $self->{term}->completion_matches ($begin, sub {
my ($text, $state) = @_; my ($text, $state) = @_;
my @name = keys %{$self->{db}}; my @name = keys %{$self->{db}};
unless ($state) { unless ($state) {
$self->{complete_idxp} = 0; $self->{complete_idxp} = 0;
} }
while ($self->{complete_idxp} <= $#name) { while ($self->{complete_idxp} <= $#name) {
$self->{complete_idxp}++; $self->{complete_idxp}++;
return $name[$self->{complete_idxp} - 1] return $name[$self->{complete_idxp} - 1]
if ($name[$self->{complete_idxp} - 1] =~ /^$text/); if ($name[$self->{complete_idxp} - 1] =~ /^$text/);
} }
# no match # no match
return undef; return undef;
}); });
} }
else { else {
# command doesn't support args # command doesn't support args
@@ -283,26 +283,26 @@ sub process {
if (exists $self->{command}->{$cmd}) { if (exists $self->{command}->{$cmd}) {
my $func = $self->{command}->{$cmd}; my $func = $self->{command}->{$cmd};
if (! grep {$cmd eq $_} @{$self->{commandargs}}) { if (! grep {$cmd eq $_} @{$self->{commandargs}}) {
@args = (); @args = ();
} }
$r = $self->$func(@args); $r = $self->$func(@args);
return 0 if($failonerr && !$r); # fail if not interactive return 0 if($failonerr && !$r); # fail if not interactive
return 0 if($self->{quit}); # finish return 0 if($self->{quit}); # finish
} }
else { else {
if (ref($self->{db}) =~ /hash/i) { if (ref($self->{db}) =~ /hash/i) {
if (exists $self->{db}->{$cmd}) { if (exists $self->{db}->{$cmd}) {
$r = $self->enter($cmd); $r = $self->enter($cmd);
return 0 if($failonerr && !$r); # fail if not interactive return 0 if($failonerr && !$r); # fail if not interactive
} }
else { else {
print STDERR "no such command: $cmd\n"; print STDERR "no such command: $cmd\n";
return 0 if $failonerr; return 0 if $failonerr;
} }
} }
else { else {
print STDERR "no such command: $cmd\n"; print STDERR "no such command: $cmd\n";
return 0 if $failonerr; return 0 if $failonerr;
} }
} }
} }
@@ -366,7 +366,7 @@ sub append {
if (exists $self->{db}->{$key}) { if (exists $self->{db}->{$key}) {
if (ref($self->{db}->{$key}) !~ /array/i) { if (ref($self->{db}->{$key}) !~ /array/i) {
return $self->_fail("\"$key\" already exists and is not an array\n"); return $self->_fail("\"$key\" already exists and is not an array\n");
} }
} }
} }
@@ -430,7 +430,7 @@ sub mypop {
if (exists $self->{db}->{$key}) { if (exists $self->{db}->{$key}) {
if (ref($self->{db}->{$key}) !~ /array/i) { if (ref($self->{db}->{$key}) !~ /array/i) {
return $self->_fail("\"$key\" is not an array\n"); return $self->_fail("\"$key\" is not an array\n");
} }
} }
my $ignore = pop @{$self->{db}->{$key}}; my $ignore = pop @{$self->{db}->{$key}};
@@ -451,7 +451,7 @@ sub myshift {
if (exists $self->{db}->{$key}) { if (exists $self->{db}->{$key}) {
if (ref($self->{db}->{$key}) !~ /array/i) { if (ref($self->{db}->{$key}) !~ /array/i) {
return $self->_fail("\"$key\" is not an array\n"); return $self->_fail("\"$key\" is not an array\n");
} }
} }
my $ignore = shift @{$self->{db}->{$key}}; my $ignore = shift @{$self->{db}->{$key}};
@@ -476,7 +476,7 @@ sub get {
$key =~ s#/$##; $key =~ s#/$##;
foreach my $k (keys %{$self->{db}}) { foreach my $k (keys %{$self->{db}}) {
if ($k =~ /$key/) { if ($k =~ /$key/) {
push @K, $k; push @K, $k;
} }
} }
} }
@@ -484,10 +484,10 @@ sub get {
if (ref($self->{db}) =~ /array/i) { if (ref($self->{db}) =~ /array/i) {
return $self->_failidx if($key !~ /^\d*$/); return $self->_failidx if($key !~ /^\d*$/);
if (scalar @{$self->{db}} -1 < $key) { if (scalar @{$self->{db}} -1 < $key) {
return $self->_fail("array element $key exceeds number of elements in current array\n"); return $self->_fail("array element $key exceeds number of elements in current array\n");
} }
else { else {
$out .= "[$key] =>\n" . $self->dump($self->{db}->[$key], 1) $out .= "[$key] =>\n" . $self->dump($self->{db}->[$key], 1)
} }
} }
elsif (exists $self->{db}->{$key}) { elsif (exists $self->{db}->{$key}) {
@@ -559,14 +559,14 @@ sub edit {
else { else {
my $perl; my $perl;
eval { eval {
$perl = $self->{deserialize}->($newdata); $perl = $self->{deserialize}->($newdata);
}; };
if ($@) { if ($@) {
return $self->_fail("$@\n"); return $self->_fail("$@\n");
} }
else { else {
$self->{db}->{$key} = $perl; $self->{db}->{$key} = $perl;
$self->done; $self->done;
} }
} }
unlink($filename); unlink($filename);
@@ -580,8 +580,15 @@ sub edit {
sub list { sub list {
my $self = shift; my $self = shift;
print join "\n", sort keys %{$self->{db}};
print "\n"; if (ref($self->{db}) eq 'ARRAY') {
# already implements array listing
$self->show;
}
else {
print join "\n", sort keys %{$self->{db}};
print "\n";
}
return 1; return 1;
} }
@@ -589,17 +596,15 @@ sub list {
sub show { sub show {
my ($self, $indent) = @_; my ($self, $indent) = @_;
if (ref($self->{db}) =~ /array/i) { if (ref($self->{db}) =~ /array/i) {
my $pos = 0; my $pos = 0;
foreach my $item (@{$self->{db}}) { foreach my $item (@{$self->{db}}) {
print "$pos:\n"; print "$pos:\n";
if (ref($item)) { if (ref($item)) {
$self->_showhash($item, " "); $self->_showhash($item, " ");
} }
else { else {
print " $item\n"; print " $item\n";
} }
$pos++; $pos++;
} }
@@ -1072,9 +1077,9 @@ contain code refs. That's not a problem as long as you don't touch them.
Sample: Sample:
my $c = { my $c = {
opt => 'value', opt => 'value',
hook => sub { return 1; }, hook => sub { return 1; },
}; };
my $shell = Data::Interactive::Inspect->new($c); my $shell = Data::Interactive::Inspect->new($c);
$shell->inspect(); $shell->inspect();
@@ -1133,8 +1138,8 @@ http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Data::Interactive::Inspect
=head1 COPYRIGHT =head1 COPYRIGHT
Copyright (c) 2015 by T.v.Dein <tlinden@cpan.org>. Copyright (c) 2015-2017 by T.v.Dein <tlinden@cpan.org>. All rights
All rights reserved. reserved.
=head1 LICENSE =head1 LICENSE
@@ -1143,6 +1148,6 @@ and/or modify it under the same terms as Perl itself.
=head1 VERSION =head1 VERSION
This is the manual page for L<Data::Interactive::Inspect> Version 0.05. This is the manual page for L<Data::Interactive::Inspect> Version 0.06.
=cut =cut

4
README
View File

@@ -44,7 +44,7 @@ BUGS
http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Data::Interactive::Inspect http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Data::Interactive::Inspect
COPYRIGHT COPYRIGHT
Copyright (c) 2015 by T.v.Dein <tlinden@cpan.org>. All rights Copyright (c) 2015-2017 by T.v.Dein <tlinden@cpan.org>. All rights
reserved. reserved.
LICENSE LICENSE
@@ -52,4 +52,4 @@ LICENSE
under the same terms as Perl itself. under the same terms as Perl itself.
VERSION VERSION
This is the manual page for Data::Interactive::Inspect Version 0.01. This is the manual page for Data::Interactive::Inspect Version 0.06.