line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Copyright (c) 2015-2017 T.v.Dein . All |
4
|
|
|
|
|
|
|
# Rights Reserved. Std. disclaimer applies. Artistic License, same as |
5
|
|
|
|
|
|
|
# perl itself. Have fun. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Data::Interactive::Inspect; |
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
1590
|
use Carp::Heavy; |
|
1
|
|
|
|
|
181
|
|
|
1
|
|
|
|
|
36
|
|
12
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
115
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
651
|
use Term::ReadLine; |
|
1
|
|
|
|
|
3470
|
|
|
1
|
|
|
|
|
48
|
|
15
|
1
|
|
|
1
|
|
972
|
use File::Temp qw(tempfile); # required by the 'edit' command |
|
1
|
|
|
|
|
23139
|
|
|
1
|
|
|
|
|
90
|
|
16
|
1
|
|
|
1
|
|
763
|
use YAML; # config + export/import + 'edit' command |
|
1
|
|
|
|
|
10024
|
|
|
1
|
|
|
|
|
72
|
|
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
9
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
19
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
40
|
|
20
|
1
|
|
|
1
|
|
6
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
1
|
|
845
|
use Data::Dumper; |
|
1
|
|
|
|
|
7779
|
|
|
1
|
|
|
|
|
128
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$Data::Interactive::Inspect::VERSION = 0.07; |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
1
|
|
10
|
use vars qw(@ISA); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
70
|
|
27
|
|
|
|
|
|
|
|
28
|
1
|
|
|
1
|
|
6
|
use vars qw(@ISA @EXPORT @EXPORT_OK); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2413
|
|
29
|
|
|
|
|
|
|
require Exporter; |
30
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
31
|
|
|
|
|
|
|
@EXPORT = qw(); |
32
|
|
|
|
|
|
|
@EXPORT_OK = qw(); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub new { |
36
|
1
|
|
|
1
|
1
|
473
|
my ($class, @param) = @_; |
37
|
|
|
|
|
|
|
|
38
|
1
|
|
33
|
|
|
11
|
$class = ref($class) || $class; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# defaults (= valid parameters) |
41
|
|
|
|
|
|
|
my $self = { |
42
|
|
|
|
|
|
|
name => '', |
43
|
0
|
|
|
0
|
|
0
|
begin => sub { print STDERR "unsupported\n"; }, |
44
|
0
|
|
|
0
|
|
0
|
commit => sub { print STDERR "unsupported\n"; }, |
45
|
0
|
|
|
0
|
|
0
|
rollback => sub { print STDERR "unsupported\n"; }, |
46
|
0
|
|
|
0
|
|
0
|
export => sub { my ($db) = @_; return $db; }, |
|
0
|
|
|
|
|
0
|
|
47
|
0
|
|
|
0
|
|
0
|
serialize => sub { my $db = shift; return YAML::Dump($db); }, |
|
0
|
|
|
|
|
0
|
|
48
|
0
|
|
|
0
|
|
0
|
deserialize => sub { my $db = shift; return YAML::Load($db); }, |
|
0
|
|
|
|
|
0
|
|
49
|
1
|
|
|
|
|
32
|
struct => {}, |
50
|
|
|
|
|
|
|
editor => 'vi', |
51
|
|
|
|
|
|
|
more => 'more', |
52
|
|
|
|
|
|
|
silent => 0, |
53
|
|
|
|
|
|
|
}; |
54
|
|
|
|
|
|
|
|
55
|
1
|
|
|
|
|
3
|
bless $self, $class; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# by default unsupported |
58
|
1
|
|
|
|
|
11
|
$self->{transactions} = 0; |
59
|
|
|
|
|
|
|
|
60
|
1
|
50
|
|
|
|
8
|
if ($#param >= 1) { |
|
|
50
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# hash interface |
62
|
0
|
|
|
|
|
0
|
my %p = @param; |
63
|
0
|
|
|
|
|
0
|
foreach my $k (keys %{$self}) { |
|
0
|
|
|
|
|
0
|
|
64
|
0
|
0
|
|
|
|
0
|
if (exists $p{$k}) { |
65
|
0
|
|
|
|
|
0
|
$self->{$k} = $p{$k}; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
0
|
0
|
0
|
|
|
0
|
if (exists $p{begin} && $p{commit} && $p{rollback}) { |
|
|
|
0
|
|
|
|
|
69
|
|
|
|
|
|
|
# user supplied the relevant functions |
70
|
0
|
|
|
|
|
0
|
$self->{transactions} = 1; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
elsif ($#param == 0) { |
74
|
|
|
|
|
|
|
# 1 param, the struct |
75
|
1
|
|
|
|
|
3
|
$self->{struct} = $param[0]; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
# else: no params given, work with defaults |
78
|
|
|
|
|
|
|
|
79
|
1
|
50
|
|
|
|
5
|
if (! $self->{struct}) { |
80
|
0
|
|
|
|
|
0
|
croak "Sorry param 'struct' must be set to a perl data structure\n"; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# map commands+shortcuts to functions |
84
|
|
|
|
|
|
|
$self->{command} = { |
85
|
1
|
|
|
|
|
34
|
l => 'list', |
86
|
|
|
|
|
|
|
list => 'list', |
87
|
|
|
|
|
|
|
show => 'show', |
88
|
|
|
|
|
|
|
sh => 'show', |
89
|
|
|
|
|
|
|
dump => 'dump', |
90
|
|
|
|
|
|
|
d => 'dump', |
91
|
|
|
|
|
|
|
get => 'get', |
92
|
|
|
|
|
|
|
g => 'get', |
93
|
|
|
|
|
|
|
enter => 'enter', |
94
|
|
|
|
|
|
|
cd => 'enter', |
95
|
|
|
|
|
|
|
set => 'set', |
96
|
|
|
|
|
|
|
edit => 'edit', |
97
|
|
|
|
|
|
|
e => 'edit', |
98
|
|
|
|
|
|
|
append=> 'append', |
99
|
|
|
|
|
|
|
drop => 'drop', |
100
|
|
|
|
|
|
|
pop => 'mypop', |
101
|
|
|
|
|
|
|
shift => 'myshift', |
102
|
|
|
|
|
|
|
search=> 'search', |
103
|
|
|
|
|
|
|
'/' => 'search', |
104
|
|
|
|
|
|
|
help => 'help', |
105
|
|
|
|
|
|
|
h => 'help', |
106
|
|
|
|
|
|
|
'?' => 'help', |
107
|
|
|
|
|
|
|
quit => 'quit', |
108
|
|
|
|
|
|
|
q => 'quit', |
109
|
|
|
|
|
|
|
}; |
110
|
|
|
|
|
|
|
|
111
|
1
|
50
|
|
|
|
6
|
if ($self->{transactions}) { |
112
|
|
|
|
|
|
|
# map if supported |
113
|
0
|
|
|
|
|
0
|
foreach my $c (qw(begin commit rollback)) { |
114
|
0
|
|
|
|
|
0
|
$self->{command}->{$c} = $c; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
1
|
50
|
|
|
|
4
|
if (! $self->{name}) { |
119
|
1
|
|
|
|
|
9
|
$self->{name} = sprintf "data\@0x%x", $self->{struct}; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# map which commands take a key param |
123
|
1
|
|
|
|
|
5
|
$self->{commandargs} = [qw(get set edit show append pop shift drop enter cd search /)]; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# holds current level |
126
|
1
|
|
|
|
|
3
|
$self->{db} = $self->{struct}; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# path to current level |
129
|
1
|
|
|
|
|
5
|
$self->{path} = []; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# set to 1 if transactions supported and implemented |
132
|
1
|
|
|
|
|
3
|
$self->{session} = 0; |
133
|
|
|
|
|
|
|
|
134
|
1
|
|
|
|
|
4
|
$self->{quit} = 0; |
135
|
|
|
|
|
|
|
|
136
|
1
|
|
|
|
|
3
|
return $self; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub inspect { |
143
|
7
|
|
|
7
|
1
|
3306
|
my ($self, $__cmds) = @_; |
144
|
|
|
|
|
|
|
|
145
|
7
|
50
|
|
|
|
13
|
if ($__cmds) { |
146
|
|
|
|
|
|
|
# unit tests und scripts |
147
|
7
|
|
|
|
|
8
|
$self->{silent} = 1; |
148
|
7
|
|
|
|
|
20
|
foreach (split /\n/, $__cmds) { |
149
|
9
|
50
|
|
|
|
15
|
if (! $self->process($_, 1) ) { |
150
|
0
|
|
|
|
|
0
|
last; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
7
|
|
|
|
|
15
|
return $self->{struct}; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
0
|
0
|
|
|
|
0
|
if (-t STDIN) { |
157
|
|
|
|
|
|
|
# interactive with prompt and history |
158
|
0
|
|
|
|
|
0
|
$| = 1; |
159
|
0
|
|
|
|
|
0
|
my $term = new Term::ReadLine 'Data::Interactive::Inspect'; |
160
|
0
|
|
|
|
|
0
|
$term->ornaments(0); |
161
|
0
|
|
|
|
|
0
|
my $attribs = $term->Attribs; |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
0
|
$self->{term} = $term; |
164
|
0
|
0
|
|
|
|
0
|
$self->{complete_words} = [ map { if (length($_) > 2 ) {$_} } keys %{$self->{command}} ]; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
165
|
0
|
|
|
|
|
0
|
$attribs->{completion_entry_function} = $attribs->{list_completion_function}; # avoid file completion |
166
|
|
|
|
|
|
|
$attribs->{attempted_completion_function} = sub { |
167
|
0
|
|
|
0
|
|
0
|
my ($begin, $line, $start, $end, $term) = @_; |
168
|
0
|
|
|
|
|
0
|
return $self->complete($begin, $line, $start, $end, $term); |
169
|
0
|
|
|
|
|
0
|
}; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
0
|
my $prompt = $self->prompt; |
172
|
0
|
|
|
|
|
0
|
while ( defined ($_ = $term->readline($prompt)) ) { |
173
|
0
|
0
|
|
|
|
0
|
if (! $self->process($_) ) { |
174
|
0
|
|
|
|
|
0
|
print "last\n"; |
175
|
0
|
|
|
|
|
0
|
last; |
176
|
|
|
|
|
|
|
} |
177
|
0
|
|
|
|
|
0
|
$prompt = $self->prompt; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
else { |
181
|
0
|
|
|
|
|
0
|
while () { |
182
|
0
|
0
|
|
|
|
0
|
if (! $self->process($_, 1) ) { |
183
|
0
|
|
|
|
|
0
|
last; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
0
|
|
|
|
|
0
|
return $self->{struct}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub prompt { |
191
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
192
|
0
|
|
|
|
|
0
|
my $prompt = $self->{name}; |
193
|
|
|
|
|
|
|
|
194
|
0
|
0
|
|
|
|
0
|
if (@{$self->{path}}) { |
|
0
|
|
|
|
|
0
|
|
195
|
0
|
|
|
|
|
0
|
$prompt .= " " . join('->', @{$self->{path}}); |
|
0
|
|
|
|
|
0
|
|
196
|
|
|
|
|
|
|
} |
197
|
0
|
0
|
|
|
|
0
|
if ($self->{session}) { |
198
|
0
|
|
|
|
|
0
|
$prompt .= '%'; |
199
|
|
|
|
|
|
|
} |
200
|
0
|
|
|
|
|
0
|
$prompt .= '> '; |
201
|
0
|
|
|
|
|
0
|
return $prompt; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub complete { |
205
|
0
|
|
|
0
|
0
|
0
|
my ($self, $begin, $line, $start, $end, $term) = @_; |
206
|
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
0
|
my @matches = (); |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
0
|
my $cmd = $line; |
210
|
0
|
|
|
|
|
0
|
$cmd =~ s/\s\s*.*$//; |
211
|
0
|
|
|
|
|
0
|
$cmd =~ s/\s*$//; |
212
|
|
|
|
|
|
|
|
213
|
0
|
0
|
|
|
|
0
|
if ($start == 0) { |
|
|
0
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# match on a command |
215
|
|
|
|
|
|
|
@matches = $self->{term}->completion_matches ($begin, sub { |
216
|
0
|
|
|
0
|
|
0
|
my ($text, $state) = @_; |
217
|
0
|
|
|
|
|
0
|
my @name = @{$self->{complete_words}}; |
|
0
|
|
|
|
|
0
|
|
218
|
0
|
0
|
|
|
|
0
|
unless ($state) { |
219
|
0
|
|
|
|
|
0
|
$self->{complete_idx} = 0; |
220
|
|
|
|
|
|
|
} |
221
|
0
|
|
|
|
|
0
|
while ($self->{complete_idx} <= $#name) { |
222
|
0
|
|
|
|
|
0
|
$self->{complete_idx}++; |
223
|
|
|
|
|
|
|
return $name[$self->{complete_idx} - 1] |
224
|
0
|
0
|
|
|
|
0
|
if ($name[$self->{complete_idx} - 1] =~ /^$text/); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
# no match |
227
|
0
|
|
|
|
|
0
|
return undef; |
228
|
0
|
|
|
|
|
0
|
}); |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
elsif ($line =~ /[^\s]+\s+[^\s]+\s+/) { |
231
|
|
|
|
|
|
|
# command line is complete ($cmd $arg), stop with completion |
232
|
0
|
|
|
|
|
0
|
@matches = undef; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
else { |
235
|
|
|
|
|
|
|
# match on a command arg |
236
|
0
|
0
|
|
|
|
0
|
if (grep {$cmd eq $_} @{$self->{commandargs}}) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
237
|
|
|
|
|
|
|
# only match for commands which support args |
238
|
|
|
|
|
|
|
@matches = $self->{term}->completion_matches ($begin, sub { |
239
|
0
|
|
|
0
|
|
0
|
my ($text, $state) = @_; |
240
|
0
|
|
|
|
|
0
|
my @name = keys %{$self->{db}}; |
|
0
|
|
|
|
|
0
|
|
241
|
0
|
0
|
|
|
|
0
|
unless ($state) { |
242
|
0
|
|
|
|
|
0
|
$self->{complete_idxp} = 0; |
243
|
|
|
|
|
|
|
} |
244
|
0
|
|
|
|
|
0
|
while ($self->{complete_idxp} <= $#name) { |
245
|
0
|
|
|
|
|
0
|
$self->{complete_idxp}++; |
246
|
|
|
|
|
|
|
return $name[$self->{complete_idxp} - 1] |
247
|
0
|
0
|
|
|
|
0
|
if ($name[$self->{complete_idxp} - 1] =~ /^$text/); |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
# no match |
250
|
0
|
|
|
|
|
0
|
return undef; |
251
|
0
|
|
|
|
|
0
|
}); |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
else { |
254
|
|
|
|
|
|
|
# command doesn't support args |
255
|
0
|
|
|
|
|
0
|
@matches = undef; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
0
|
return @matches; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub process { |
263
|
9
|
|
|
9
|
0
|
9
|
my ($self, $line, $failonerr) = @_; |
264
|
|
|
|
|
|
|
|
265
|
9
|
50
|
|
|
|
14
|
return 1 if(!defined $line); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# special treatment to search command |
268
|
9
|
|
|
|
|
23
|
$line =~ s|^/(.+)|/ $1|; |
269
|
|
|
|
|
|
|
|
270
|
9
|
|
|
|
|
7
|
my $r; |
271
|
9
|
|
|
|
|
38
|
my ($cmd, @args) = split /\s\s*/, $line; |
272
|
|
|
|
|
|
|
|
273
|
9
|
50
|
|
|
|
16
|
return 1 if (!defined $cmd); |
274
|
9
|
50
|
|
|
|
20
|
return 1 if ($cmd =~ /^\s*$/); |
275
|
9
|
50
|
|
|
|
13
|
return 1 if ($cmd =~ /^#/); |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
|
279
|
9
|
50
|
|
|
|
12
|
if ($cmd eq '..') { |
280
|
0
|
|
|
|
|
0
|
$self->up; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
else { |
283
|
9
|
50
|
|
|
|
13
|
if (exists $self->{command}->{$cmd}) { |
284
|
9
|
|
|
|
|
12
|
my $func = $self->{command}->{$cmd}; |
285
|
9
|
50
|
|
|
|
7
|
if (! grep {$cmd eq $_} @{$self->{commandargs}}) { |
|
108
|
|
|
|
|
97
|
|
|
9
|
|
|
|
|
14
|
|
286
|
0
|
|
|
|
|
0
|
@args = (); |
287
|
|
|
|
|
|
|
} |
288
|
9
|
|
|
|
|
27
|
$r = $self->$func(@args); |
289
|
9
|
50
|
33
|
|
|
36
|
return 0 if($failonerr && !$r); # fail if not interactive |
290
|
9
|
50
|
|
|
|
14
|
return 0 if($self->{quit}); # finish |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
else { |
293
|
0
|
0
|
|
|
|
0
|
if (ref($self->{db}) =~ /hash/i) { |
294
|
0
|
0
|
|
|
|
0
|
if (exists $self->{db}->{$cmd}) { |
295
|
0
|
|
|
|
|
0
|
$r = $self->enter($cmd); |
296
|
0
|
0
|
0
|
|
|
0
|
return 0 if($failonerr && !$r); # fail if not interactive |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
else { |
299
|
0
|
|
|
|
|
0
|
print STDERR "no such command: $cmd\n"; |
300
|
0
|
0
|
|
|
|
0
|
return 0 if $failonerr; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
else { |
304
|
0
|
|
|
|
|
0
|
print STDERR "no such command: $cmd\n"; |
305
|
0
|
0
|
|
|
|
0
|
return 0 if $failonerr; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
} |
309
|
9
|
|
|
|
|
24
|
return 1; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# command implementations |
315
|
|
|
|
0
|
|
|
sub __interactive__ {}; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub _fail { |
318
|
0
|
|
|
0
|
|
0
|
my ($self, $msg) = @_; |
319
|
0
|
|
|
|
|
0
|
print STDERR $msg; |
320
|
0
|
|
|
|
|
0
|
return 0; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub _failkey { |
324
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
325
|
0
|
|
|
|
|
0
|
return $self->_fail(" parameter missing\n"); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub _failidx { |
329
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
330
|
0
|
|
|
|
|
0
|
return $self->_fail(" must be a number, since we're inside an array\n"); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub _more { |
334
|
0
|
|
|
0
|
|
0
|
my ($self, $out) = @_; |
335
|
0
|
0
|
|
|
|
0
|
if (open LESS, "|$self->{more}") { |
336
|
0
|
|
|
|
|
0
|
print LESS $out; |
337
|
0
|
|
|
|
|
0
|
close LESS; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
else { |
340
|
0
|
|
|
|
|
0
|
print $out; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub quit { |
345
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
346
|
0
|
|
|
|
|
0
|
$self->{quit} = 1; |
347
|
0
|
|
|
|
|
0
|
return 0; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub set { |
351
|
3
|
|
|
3
|
1
|
6
|
my($self, $key, @value) = @_; |
352
|
|
|
|
|
|
|
|
353
|
3
|
50
|
|
|
|
4
|
return $self->_failkey() if(! defined $key); |
354
|
|
|
|
|
|
|
|
355
|
3
|
|
|
|
|
2
|
my $var; |
356
|
3
|
|
|
|
|
7
|
my $code = "\$var = @value;"; |
357
|
|
|
|
|
|
|
{ |
358
|
1
|
|
|
1
|
|
11
|
no strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
53
|
|
|
3
|
|
|
|
|
3
|
|
359
|
1
|
|
|
1
|
|
6
|
no warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4376
|
|
360
|
3
|
|
|
|
|
150
|
eval $code; |
361
|
|
|
|
|
|
|
} |
362
|
3
|
50
|
|
|
|
9
|
if ($@) { |
363
|
0
|
|
|
|
|
0
|
return $self->_fail("failed to insert: $@\n"); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
else { |
366
|
3
|
|
|
|
|
5
|
$self->{db}->{$key} = $var; |
367
|
3
|
|
|
|
|
4
|
$self->done; |
368
|
|
|
|
|
|
|
} |
369
|
3
|
|
|
|
|
4
|
return 1; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub append { |
373
|
1
|
|
|
1
|
1
|
3
|
my($self, $key, @value) = @_; |
374
|
|
|
|
|
|
|
|
375
|
1
|
50
|
|
|
|
5
|
if (ref($self->{db}) !~ /array/i) { |
376
|
1
|
50
|
|
|
|
4
|
return $self->_failkey() if(! defined $key); |
377
|
|
|
|
|
|
|
|
378
|
1
|
50
|
|
|
|
4
|
if (exists $self->{db}->{$key}) { |
379
|
1
|
50
|
|
|
|
5
|
if (ref($self->{db}->{$key}) !~ /array/i) { |
380
|
0
|
|
|
|
|
0
|
return $self->_fail("\"$key\" already exists and is not an array\n"); |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
else { |
385
|
|
|
|
|
|
|
# inside an array, ignore $key |
386
|
0
|
|
|
|
|
0
|
@value = ($key, @value); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
1
|
|
|
|
|
1
|
my $var; |
390
|
1
|
|
|
|
|
3
|
my $code = "\$var = @value;"; |
391
|
1
|
|
|
|
|
53
|
eval $code; |
392
|
1
|
50
|
|
|
|
4
|
if ($@) { |
393
|
0
|
|
|
|
|
0
|
return $self->_fail("failed to evaluate: $@\n"); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
else { |
396
|
1
|
50
|
|
|
|
3
|
if (ref($self->{db}) =~ /array/i) { |
397
|
0
|
|
|
|
|
0
|
push @{$self->{db}}, $var; |
|
0
|
|
|
|
|
0
|
|
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
else { |
400
|
1
|
|
|
|
|
1
|
push @{$self->{db}->{$key}}, $var; |
|
1
|
|
|
|
|
3
|
|
401
|
|
|
|
|
|
|
} |
402
|
1
|
|
|
|
|
2
|
$self->done; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
1
|
|
|
|
|
2
|
return 1; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub drop { |
409
|
1
|
|
|
1
|
1
|
2
|
my($self, $key) = @_; |
410
|
|
|
|
|
|
|
|
411
|
1
|
50
|
|
|
|
4
|
if (ref($self->{db}) =~ /array/i) { |
412
|
0
|
0
|
|
|
|
0
|
return $self->_failidx if($key !~ /^\d*$/); |
413
|
0
|
0
|
|
|
|
0
|
if (scalar @{$self->{db}} -1 < $key) { |
|
0
|
|
|
|
|
0
|
|
414
|
0
|
|
|
|
|
0
|
return $self->_fail("array element $key exceeds number of elements in current array\n"); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
else { |
417
|
0
|
|
|
|
|
0
|
splice @{$self->{db}}, $key, 1; |
|
0
|
|
|
|
|
0
|
|
418
|
0
|
|
|
|
|
0
|
$self->done; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
else { |
422
|
1
|
50
|
|
|
|
4
|
return $self->_failkey() if(! defined $key); |
423
|
|
|
|
|
|
|
|
424
|
1
|
50
|
|
|
|
3
|
if (exists $self->{db}->{$key}) { |
425
|
1
|
|
|
|
|
2
|
delete $self->{db}->{$key}; |
426
|
1
|
|
|
|
|
4
|
$self->done; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
else { |
429
|
0
|
|
|
|
|
0
|
return $self->_fail("no such key: \"$key\"\n"); |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
1
|
|
|
|
|
1
|
return 1; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub mypop { |
437
|
1
|
|
|
1
|
0
|
2
|
my($self, $key) = @_; |
438
|
|
|
|
|
|
|
|
439
|
1
|
50
|
|
|
|
6
|
if (ref($self->{db}) !~ /array/i) { |
440
|
1
|
50
|
|
|
|
2
|
return $self->_failkey() if(! defined $key); |
441
|
|
|
|
|
|
|
|
442
|
1
|
50
|
|
|
|
3
|
if (exists $self->{db}->{$key}) { |
443
|
1
|
50
|
|
|
|
5
|
if (ref($self->{db}->{$key}) !~ /array/i) { |
444
|
0
|
|
|
|
|
0
|
return $self->_fail("\"$key\" is not an array\n"); |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
} |
447
|
1
|
|
|
|
|
1
|
my $ignore = pop @{$self->{db}->{$key}}; |
|
1
|
|
|
|
|
3
|
|
448
|
1
|
|
|
|
|
3
|
$self->done; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
else { |
451
|
0
|
|
|
|
|
0
|
my $ignore = pop @{$self->{db}}; |
|
0
|
|
|
|
|
0
|
|
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
1
|
|
|
|
|
2
|
return 1; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub myshift { |
458
|
1
|
|
|
1
|
0
|
3
|
my($self, $key) = @_; |
459
|
|
|
|
|
|
|
|
460
|
1
|
50
|
|
|
|
8
|
if (ref($self->{db}) !~ /array/i) { |
461
|
1
|
50
|
|
|
|
4
|
return $self->_failkey() if(! defined $key); |
462
|
|
|
|
|
|
|
|
463
|
1
|
50
|
|
|
|
2
|
if (exists $self->{db}->{$key}) { |
464
|
1
|
50
|
|
|
|
5
|
if (ref($self->{db}->{$key}) !~ /array/i) { |
465
|
0
|
|
|
|
|
0
|
return $self->_fail("\"$key\" is not an array\n"); |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
} |
468
|
1
|
|
|
|
|
1
|
my $ignore = shift @{$self->{db}->{$key}}; |
|
1
|
|
|
|
|
3
|
|
469
|
1
|
|
|
|
|
2
|
$self->done; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
else { |
472
|
0
|
|
|
|
|
0
|
my $ignore = shift @{$self->{db}}; |
|
0
|
|
|
|
|
0
|
|
473
|
|
|
|
|
|
|
} |
474
|
1
|
|
|
|
|
1
|
return 1; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub get { |
478
|
0
|
|
|
0
|
1
|
0
|
my($self, $key, $search) = @_; |
479
|
|
|
|
|
|
|
|
480
|
0
|
0
|
|
|
|
0
|
return $self->_failkey() if(! defined $key); |
481
|
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
0
|
my $out; |
483
|
|
|
|
|
|
|
my @K; |
484
|
0
|
0
|
|
|
|
0
|
if ($key =~ /^\/.*\/$/) { |
485
|
|
|
|
|
|
|
# regex |
486
|
0
|
|
|
|
|
0
|
$key =~ s#^/##; |
487
|
0
|
|
|
|
|
0
|
$key =~ s#/$##; |
488
|
0
|
|
|
|
|
0
|
foreach my $k (keys %{$self->{db}}) { |
|
0
|
|
|
|
|
0
|
|
489
|
0
|
0
|
|
|
|
0
|
if ($k =~ /$key/) { |
490
|
0
|
|
|
|
|
0
|
push @K, $k; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
else { |
495
|
0
|
0
|
|
|
|
0
|
if (ref($self->{db}) =~ /array/i) { |
|
|
0
|
|
|
|
|
|
496
|
0
|
0
|
|
|
|
0
|
return $self->_failidx if($key !~ /^\d*$/); |
497
|
0
|
0
|
|
|
|
0
|
if (scalar @{$self->{db}} -1 < $key) { |
|
0
|
|
|
|
|
0
|
|
498
|
0
|
|
|
|
|
0
|
return $self->_fail("array element $key exceeds number of elements in current array\n"); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
else { |
501
|
0
|
|
|
|
|
0
|
$out .= "[$key] =>\n" . $self->dump($self->{db}->[$key], 1) |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
elsif (exists $self->{db}->{$key}) { |
505
|
0
|
|
|
|
|
0
|
push @K, $key; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
else { |
508
|
0
|
|
|
|
|
0
|
return $self->_fail("no such key: \"$key\"\n"); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
|
512
|
0
|
|
|
|
|
0
|
foreach my $key (@K) { |
513
|
0
|
0
|
0
|
|
|
0
|
if (ref($self->{db}->{$key}) =~ /hash/i || ref($self->{db}->{$key}) =~ /array/i) { |
514
|
|
|
|
|
|
|
# FIXME: something nicer |
515
|
0
|
|
|
|
|
0
|
$out .= "$key =>\n" . $self->dump($self->{db}->{$key}, 1) |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
else { |
518
|
0
|
|
|
|
|
0
|
$out .= "$key => \"$self->{db}->{$key}\"\n"; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
} |
521
|
0
|
|
|
|
|
0
|
print $out; |
522
|
|
|
|
|
|
|
|
523
|
0
|
|
|
|
|
0
|
return 1; |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
sub dump { |
527
|
0
|
|
|
0
|
1
|
0
|
my ($self, $obj, $noprint) = @_; |
528
|
0
|
|
|
|
|
0
|
my $out; |
529
|
0
|
0
|
|
|
|
0
|
if ($obj) { |
530
|
0
|
|
|
|
|
0
|
$out = $self->{serialize}->($self->{export}->($obj)); |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
else { |
533
|
0
|
|
|
|
|
0
|
$out = $self->{serialize}->($self->{export}->($self->{db})); |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
|
536
|
0
|
0
|
|
|
|
0
|
if ($noprint) { |
537
|
0
|
|
|
|
|
0
|
return $out; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
else { |
540
|
0
|
|
|
|
|
0
|
$self->_more($out); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
0
|
|
|
|
|
0
|
return 1; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub edit { |
547
|
0
|
|
|
0
|
1
|
0
|
my ($self, $key) = @_; |
548
|
|
|
|
|
|
|
|
549
|
0
|
0
|
|
|
|
0
|
return $self->_failkey() if(! defined $key); |
550
|
|
|
|
|
|
|
|
551
|
0
|
0
|
|
|
|
0
|
if (exists $self->{db}->{$key}) { |
552
|
0
|
|
|
|
|
0
|
my $data = $self->{serialize}->($self->{export}->($self->{db}->{$key})); |
553
|
0
|
|
|
|
|
0
|
my ($fh, $filename) = tempfile(); |
554
|
0
|
|
|
|
|
0
|
print $fh $data; |
555
|
0
|
|
|
|
|
0
|
close $fh; |
556
|
0
|
|
|
|
|
0
|
system("$self->{editor}", $filename); |
557
|
0
|
|
|
|
|
0
|
open IN, "<$filename"; |
558
|
0
|
|
|
|
|
0
|
my $newdata = join '', ; |
559
|
0
|
|
|
|
|
0
|
close IN; |
560
|
0
|
0
|
|
|
|
0
|
if ($newdata eq $data) { |
561
|
|
|
|
|
|
|
# FIXME: use checksum or something else which is faster |
562
|
0
|
|
|
|
|
0
|
print "unchanged\n"; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
else { |
565
|
0
|
|
|
|
|
0
|
my $perl; |
566
|
0
|
|
|
|
|
0
|
eval { |
567
|
0
|
|
|
|
|
0
|
$perl = $self->{deserialize}->($newdata); |
568
|
|
|
|
|
|
|
}; |
569
|
0
|
0
|
|
|
|
0
|
if ($@) { |
570
|
0
|
|
|
|
|
0
|
return $self->_fail("$@\n"); |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
else { |
573
|
0
|
|
|
|
|
0
|
$self->{db}->{$key} = $perl; |
574
|
0
|
|
|
|
|
0
|
$self->done; |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
} |
577
|
0
|
|
|
|
|
0
|
unlink($filename); |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
else { |
580
|
0
|
|
|
|
|
0
|
return $self->_fail("no such key: \"$key\"\n"); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
0
|
|
|
|
|
0
|
return 1; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
sub list { |
587
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
588
|
|
|
|
|
|
|
|
589
|
0
|
0
|
|
|
|
0
|
if (ref($self->{db}) eq 'ARRAY') { |
590
|
|
|
|
|
|
|
# already implements array listing |
591
|
0
|
|
|
|
|
0
|
$self->show; |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
else { |
594
|
0
|
|
|
|
|
0
|
my $out = join("\n", sort keys %{$self->{db}}) . "\n"; |
|
0
|
|
|
|
|
0
|
|
595
|
0
|
|
|
|
|
0
|
$self->_more($out); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
0
|
|
|
|
|
0
|
return 1; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub show { |
602
|
0
|
|
|
0
|
1
|
0
|
my ($self, $indent) = @_; |
603
|
0
|
|
|
|
|
0
|
my $out; |
604
|
|
|
|
|
|
|
|
605
|
0
|
0
|
|
|
|
0
|
if (ref($self->{db}) =~ /array/i) { |
606
|
0
|
|
|
|
|
0
|
my $pos = 0; |
607
|
0
|
|
|
|
|
0
|
foreach my $item (@{$self->{db}}) { |
|
0
|
|
|
|
|
0
|
|
608
|
0
|
|
|
|
|
0
|
$out .= "$pos:\n"; |
609
|
0
|
0
|
|
|
|
0
|
if (ref($item)) { |
610
|
0
|
|
|
|
|
0
|
$out .= $self->_showhash($item, " "); |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
else { |
613
|
0
|
|
|
|
|
0
|
$out .= " $item\n"; |
614
|
|
|
|
|
|
|
} |
615
|
0
|
|
|
|
|
0
|
$pos++; |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
else { |
619
|
0
|
|
|
|
|
0
|
$out = $self->_showhash($self->{db}); |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
0
|
|
|
|
|
0
|
$self->_more($out); |
623
|
|
|
|
|
|
|
|
624
|
0
|
|
|
|
|
0
|
return 1; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
sub _showhash { |
628
|
0
|
|
|
0
|
|
0
|
my($self, $db, $indent) = @_; |
629
|
|
|
|
|
|
|
|
630
|
0
|
0
|
|
|
|
0
|
if (!defined $indent) { |
631
|
0
|
|
|
|
|
0
|
$indent = ''; |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
|
634
|
0
|
|
|
|
|
0
|
my $out; |
635
|
0
|
|
|
|
|
0
|
foreach my $key (sort keys %{$db}) { |
|
0
|
|
|
|
|
0
|
|
636
|
0
|
|
|
|
|
0
|
$out .= sprintf "%s%-30s", $indent, $key; |
637
|
0
|
0
|
|
|
|
0
|
if (ref($db->{$key}) =~ /hash/i) { |
|
|
0
|
|
|
|
|
|
638
|
0
|
|
|
|
|
0
|
$out .= "{ .. }\n"; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
elsif (ref($db->{$key}) =~ /array/i) { |
641
|
0
|
|
|
|
|
0
|
$out .= "[ .. ]\n"; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
else { |
644
|
0
|
|
|
|
|
0
|
$out .= "\"$db->{$key}\"\n"; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
|
648
|
0
|
|
|
|
|
0
|
return $out; |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
sub enter { |
652
|
2
|
|
|
2
|
1
|
4
|
my ($self, $key) = @_; |
653
|
|
|
|
|
|
|
|
654
|
2
|
50
|
|
|
|
4
|
return $self->_failkey() if(! defined $key); |
655
|
|
|
|
|
|
|
|
656
|
2
|
50
|
|
|
|
4
|
if ($key eq '..') { |
657
|
0
|
|
|
|
|
0
|
$self->up; |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
else { |
660
|
2
|
50
|
33
|
|
|
14
|
if (ref($self->{db}) =~ /array/i) { |
|
|
50
|
|
|
|
|
|
661
|
|
|
|
|
|
|
# "cd" into array element |
662
|
0
|
0
|
|
|
|
0
|
return $self->_failidx if($key !~ /^\d*$/); |
663
|
0
|
|
|
|
|
0
|
push @{$self->{path}}, "[${key}]"; |
|
0
|
|
|
|
|
0
|
|
664
|
0
|
|
|
|
|
0
|
push @{$self->{prev}}, $self->{db}; |
|
0
|
|
|
|
|
0
|
|
665
|
0
|
|
|
|
|
0
|
$self->{db} = $self->{db}->[$key]; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
elsif (ref($self->{db}->{$key}) =~ /hash/i || ref($self->{db}->{$key}) =~ /array/i) { |
668
|
|
|
|
|
|
|
# "cd" into the hash pointed at by $key |
669
|
2
|
|
|
|
|
2
|
push @{$self->{prev}}, $self->{db}; |
|
2
|
|
|
|
|
3
|
|
670
|
2
|
|
|
|
|
2
|
push @{$self->{path}}, $key; |
|
2
|
|
|
|
|
3
|
|
671
|
2
|
|
|
|
|
4
|
$self->{db} = $self->{db}->{$key}; |
672
|
2
|
|
|
|
|
235
|
print "=> $key\n"; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
else { |
675
|
0
|
|
|
|
|
0
|
return $self->_fail("not a hash: \"$key\"\n"); |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
2
|
|
|
|
|
6
|
return 1; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
sub up { |
683
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
684
|
0
|
0
|
|
|
|
0
|
if (@{$self->{prev}}) { |
|
0
|
|
|
|
|
0
|
|
685
|
0
|
|
|
|
|
0
|
$self->{db} = pop @{$self->{prev}}; |
|
0
|
|
|
|
|
0
|
|
686
|
0
|
|
|
|
|
0
|
pop @{$self->{path}}; |
|
0
|
|
|
|
|
0
|
|
687
|
0
|
|
|
|
|
0
|
print "<=\n"; |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
else { |
690
|
0
|
|
|
|
|
0
|
return $self->_fail("already on top level\n"); |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
|
693
|
0
|
|
|
|
|
0
|
return 1; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
sub search { |
697
|
0
|
|
|
0
|
1
|
0
|
my ($self, $regex) = @_; |
698
|
|
|
|
|
|
|
|
699
|
0
|
0
|
|
|
|
0
|
if (! defined $regex) { |
700
|
0
|
|
|
|
|
0
|
$self->_fail(" parameter missing\n"); |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
0
|
|
|
|
|
0
|
$self->{spath} = []; |
704
|
|
|
|
|
|
|
|
705
|
0
|
|
|
|
|
0
|
return $self->_search($self->{db}, $regex); |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
sub _search { |
709
|
0
|
|
|
0
|
|
0
|
my($self, $db, $regex) = @_; |
710
|
|
|
|
|
|
|
|
711
|
0
|
0
|
|
|
|
0
|
if (ref($db) =~ /hash/i) { |
|
|
0
|
|
|
|
|
|
712
|
0
|
|
|
|
|
0
|
foreach my $key (sort keys %{$db}) { |
|
0
|
|
|
|
|
0
|
|
713
|
0
|
|
|
|
|
0
|
$self->_searchmatch($key, $regex, 0); |
714
|
0
|
|
|
|
|
0
|
push @{$self->{spath}}, $key; |
|
0
|
|
|
|
|
0
|
|
715
|
0
|
|
|
|
|
0
|
$self->_search($db->{$key}, $regex); |
716
|
0
|
|
|
|
|
0
|
pop @{$self->{spath}}; |
|
0
|
|
|
|
|
0
|
|
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
elsif (ref($db) =~ /array/i) { |
720
|
0
|
|
|
|
|
0
|
my $pos = 0; |
721
|
0
|
|
|
|
|
0
|
foreach my $item (@{$db}) { |
|
0
|
|
|
|
|
0
|
|
722
|
0
|
|
|
|
|
0
|
push @{$self->{spath}}, "[${pos}]"; |
|
0
|
|
|
|
|
0
|
|
723
|
0
|
|
|
|
|
0
|
$self->_search($item, $regex); |
724
|
0
|
|
|
|
|
0
|
pop @{$self->{spath}}; |
|
0
|
|
|
|
|
0
|
|
725
|
0
|
|
|
|
|
0
|
$pos++; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
else { |
729
|
0
|
|
|
|
|
0
|
$self->_searchmatch($db, $regex, 1); |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
0
|
|
|
|
|
0
|
return 1; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
sub _searchmatch { |
736
|
0
|
|
|
0
|
|
0
|
my ($self, $key, $regex, $quote) = @_; |
737
|
0
|
0
|
|
|
|
0
|
$quote = $quote ? '"' : ''; |
738
|
0
|
0
|
|
|
|
0
|
if ($key =~ /$regex/) { |
739
|
0
|
|
|
|
|
0
|
print join(' => ', @{$self->{spath}}) . ": ${quote}$ {key}${quote}\n"; |
|
0
|
|
|
|
|
0
|
|
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
sub done { |
744
|
7
|
|
|
7
|
0
|
9
|
my $self = shift; |
745
|
7
|
50
|
|
|
|
15
|
if (! $self->{silent}) { |
746
|
0
|
|
|
|
|
|
print "ok\n"; |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
sub help { |
751
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
752
|
0
|
|
|
|
|
|
print qq(Display commands: |
753
|
|
|
|
|
|
|
list - list keys of current level |
754
|
|
|
|
|
|
|
show - same as list but with values |
755
|
|
|
|
|
|
|
dump - dump everything from current level |
756
|
|
|
|
|
|
|
get | /regex/ - display value of , or the value |
757
|
|
|
|
|
|
|
of all keys matching /regex/ |
758
|
|
|
|
|
|
|
search - search for |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Navigation commands: |
761
|
|
|
|
|
|
|
enter - change level into sub-hash of |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
Edit commands: |
764
|
|
|
|
|
|
|
set - set to |
765
|
|
|
|
|
|
|
edit - edit structure behind [1] |
766
|
|
|
|
|
|
|
append [] - append to array , leave |
767
|
|
|
|
|
|
|
if you are currently inside an array |
768
|
|
|
|
|
|
|
drop - delete key , use a number if inside |
769
|
|
|
|
|
|
|
an array |
770
|
|
|
|
|
|
|
pop [] - remove last element of array , |
771
|
|
|
|
|
|
|
shift [] - remove first element of array |
772
|
|
|
|
|
|
|
leave if inside an array |
773
|
|
|
|
|
|
|
); |
774
|
|
|
|
|
|
|
|
775
|
0
|
0
|
|
|
|
|
if ($self->{transactions}) { |
776
|
0
|
|
|
|
|
|
print qq( |
777
|
|
|
|
|
|
|
Transaction commands: |
778
|
|
|
|
|
|
|
begin - start a transaction session |
779
|
|
|
|
|
|
|
commit - store everything changed within session |
780
|
|
|
|
|
|
|
rollback - discard changes |
781
|
|
|
|
|
|
|
); |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
0
|
|
|
|
|
|
print qq( |
785
|
|
|
|
|
|
|
Misc commands: |
786
|
|
|
|
|
|
|
help - get help |
787
|
|
|
|
|
|
|
ctrl-d | quit - exit |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
Shortcuts: |
790
|
|
|
|
|
|
|
.. - go one level up |
791
|
|
|
|
|
|
|
l - list |
792
|
|
|
|
|
|
|
d - dump |
793
|
|
|
|
|
|
|
sh - show |
794
|
|
|
|
|
|
|
cd - enter |
795
|
|
|
|
|
|
|
- enter [2] |
796
|
|
|
|
|
|
|
/ - search |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
Hints: |
799
|
|
|
|
|
|
|
[1] can be perl code, e.g: set pw { user => 'max' } |
800
|
|
|
|
|
|
|
[2] doesn't work if correlates to a command |
801
|
|
|
|
|
|
|
); |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
1; |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=head1 NAME |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
Data::Interactive::Inspect - Inspect and manipulate perl data structures interactively |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=head1 SYNOPSIS |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
use Data::Interactive::Inspect; |
814
|
|
|
|
|
|
|
my $data = foo(); # get a hash ref from somewhere |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
# new shell object, the simple way |
817
|
|
|
|
|
|
|
my $shell = Data::Interactive::Inspect->new($data); |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
# or |
820
|
|
|
|
|
|
|
my $shell = Data::Interactive::Inspect->new( |
821
|
|
|
|
|
|
|
struct => $data, |
822
|
|
|
|
|
|
|
name => 'verkehrswege', |
823
|
|
|
|
|
|
|
begin => sub { .. }, |
824
|
|
|
|
|
|
|
commit => sub { .. }, |
825
|
|
|
|
|
|
|
rollback => sub { .. }, |
826
|
|
|
|
|
|
|
serialize => sub { .. }, |
827
|
|
|
|
|
|
|
deserialize => sub { .. }, |
828
|
|
|
|
|
|
|
editor => 'emacs', |
829
|
|
|
|
|
|
|
more => 'less' |
830
|
|
|
|
|
|
|
); |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
$data = $shell->inspect(); # opens a shell and returns modified hash ref on quit |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=head1 DESCRIPTION |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
This module provides an interactive shell which can be used to inspect and modify |
838
|
|
|
|
|
|
|
a perl data structure. |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
You can browse the structure like a directory, display the contents, add and remove |
841
|
|
|
|
|
|
|
items, whatever you like. It is possible to include complete perl data structures. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
The module works with hash and array references. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=head1 METHODS |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=head2 new |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
The B function takes either one parameter (a reference to a hash or array) |
850
|
|
|
|
|
|
|
or a hash reference with parameters. The following parameters are supported: |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=over |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=item B |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
The hash or array reference to inspect. |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=item B |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
Will be displayed on the prompt of the shell. |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=item B |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
By default L opens B if the user issues the B |
865
|
|
|
|
|
|
|
command. Use this parameter to instruct it otherwise. |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=item B |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
By default L uses B to display data which doesn't |
870
|
|
|
|
|
|
|
fit the terminal window. Use this parameter to instruct it otherwise. |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=item B, B, B |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
If your data is tied to some backend which supports transactions, you can provide |
875
|
|
|
|
|
|
|
functions to implement this. If all three are defined, the user can use transaction |
876
|
|
|
|
|
|
|
commands in the shell. |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
Look at L for an example implementation. |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=item B, B |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
By default L uses L for serialization, which |
883
|
|
|
|
|
|
|
is used in the B and B commands. You can change this by assigning |
884
|
|
|
|
|
|
|
code refs to these parameters. |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
B will be called with the structure to be serialized as its sole |
887
|
|
|
|
|
|
|
parameter and is expected to return a string. |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
B will be called with a string as parameter and is expected to |
890
|
|
|
|
|
|
|
return a structure. |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=back |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=head2 inspect |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
The B method starts the shell. Ii does return if the user leaves it, otherwise |
897
|
|
|
|
|
|
|
it runs forever. |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
The shell runs on a terminal and with STDIN. |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
The interactive shell supports command line editing, history and completion (for |
902
|
|
|
|
|
|
|
commands and hash keys), if L or L is |
903
|
|
|
|
|
|
|
installed. |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=head1 INTERACTIVE COMMANDS |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=head2 DISPLAY COMMANDS |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=over |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=item B |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
Lists the keys of the current level of the structure. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
Shortcut: B. |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=item B |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
Does nearly the same as B but also shows the content of the |
920
|
|
|
|
|
|
|
keys. If a key points to a structure (like a hash or an array), B |
921
|
|
|
|
|
|
|
whill not display anything of it, but instead indicate, that there'e |
922
|
|
|
|
|
|
|
more behind that key. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
For arrays the array indices are displayed as well. |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
Shortcut: B. |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=item B |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
Dumps out everything of the current level of the structure. |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
Shortcut: B. |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=item B key | /regex/> |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
Displays the value of B. If you specify a regex, the values of |
937
|
|
|
|
|
|
|
all matching keys will be shown. |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
If the current structure is an array you can specify the array index |
940
|
|
|
|
|
|
|
as the parameter. |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=item B regex | / |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
Search for B through the current structure. Looks for |
945
|
|
|
|
|
|
|
keys an values. |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
Beware that this make take some time depending on the size |
948
|
|
|
|
|
|
|
of the structure. |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=back |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
=head2 NAVIGATION COMMANDS |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=over |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=item B key |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
You can use this command to enter a sub hash of the current hash. |
959
|
|
|
|
|
|
|
It works like browsing a directory structure. You can only enter |
960
|
|
|
|
|
|
|
keys which point to sub hashes. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
Shortcuts: B |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
If the key you want to enter doesn't collide with a command, then |
965
|
|
|
|
|
|
|
you can also just directly enter the key without 'enter' or 'cd' in |
966
|
|
|
|
|
|
|
front of it, eg: |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
my.db> list |
969
|
|
|
|
|
|
|
subhash |
970
|
|
|
|
|
|
|
my.db> subhash |
971
|
|
|
|
|
|
|
my.db subhash> dump |
972
|
|
|
|
|
|
|
my.db subhash> .. |
973
|
|
|
|
|
|
|
my.db>^D |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
If the current structure is an array you can use the array index |
976
|
|
|
|
|
|
|
to enter a specific array item. |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
If you specify B<..> as parameter (or as its own command like in the |
979
|
|
|
|
|
|
|
example below), you go one level up and leave the current sub hash. |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
=back |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=head2 EDIT COMMANDS |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
=over |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=item B key value |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
Use the B command to add a new key or to modify the value |
990
|
|
|
|
|
|
|
of a key. B may be a valid perl structure, which you can |
991
|
|
|
|
|
|
|
use to create sub hashes or arrays. Example: |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
my.db> set users [ { name => 'max'}, { name => 'joe' } ] |
994
|
|
|
|
|
|
|
ok |
995
|
|
|
|
|
|
|
mydb> get users |
996
|
|
|
|
|
|
|
users => |
997
|
|
|
|
|
|
|
{ |
998
|
|
|
|
|
|
|
'name' => 'max' |
999
|
|
|
|
|
|
|
}, |
1000
|
|
|
|
|
|
|
{ |
1001
|
|
|
|
|
|
|
'name' => 'joe' |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
B command overwrites existing values |
1005
|
|
|
|
|
|
|
without asking>. |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
=item B key |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
You can edit a whole structure pointed at by B with the |
1010
|
|
|
|
|
|
|
B command. It opens an editor with the structure converted |
1011
|
|
|
|
|
|
|
to L. Modify whatever you wish, save, and the structure will |
1012
|
|
|
|
|
|
|
be saved to the database. |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
=item B key value |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
This command can be used to append a value to an array. As with the |
1017
|
|
|
|
|
|
|
B command, B can be any valid perl structure. |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
If you are currently inside an array, leave the B parameter. |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item B key |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
Delete a key. |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
Again, note that all commands are executed without further asking |
1026
|
|
|
|
|
|
|
or warning! |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
If you are currently inside an array, the B parameter must be |
1029
|
|
|
|
|
|
|
an array index. |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
=item B key |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
Remove the last element of the array pointed at by B. |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
If you are currently inside an array, leave the B parameter. |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
=item B key |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
Remove the first element of the array pointed at by B. |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
If you are currently inside an array, leave the B parameter. |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
=back |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=head2 TRANSACTION COMMANDS |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
B. |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=over |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=item B |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
Start a transaction. |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=item B |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
Save all changes made since the transaction began. |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
=item B |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
Discard all changes of the transaction. |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
=back |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=head2 MISC COMMANDS |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
=over |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
=item B |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
Display a short command help. |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
Shortcuts: B or B>. |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=item B |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
Quit the interactive shell |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
Shortcuts: B. |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
=back |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=head1 LIMITATIONS |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
The data structure you are inspecting with L may |
1086
|
|
|
|
|
|
|
contain code refs. That's not a problem as long as you don't touch them. |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
Sample: |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
my $c = { |
1091
|
|
|
|
|
|
|
opt => 'value', |
1092
|
|
|
|
|
|
|
hook => sub { return 1; }, |
1093
|
|
|
|
|
|
|
}; |
1094
|
|
|
|
|
|
|
my $shell = Data::Interactive::Inspect->new($c); |
1095
|
|
|
|
|
|
|
$shell->inspect(); |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
Execute: |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
data@0x80140a468> dump |
1100
|
|
|
|
|
|
|
--- |
1101
|
|
|
|
|
|
|
hook: !!perl/code '{ "DUMMY" }' |
1102
|
|
|
|
|
|
|
opt: value |
1103
|
|
|
|
|
|
|
data@0x80140a468> set hook blah |
1104
|
|
|
|
|
|
|
data@0x80140a468> edit hook |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
Both commands would destroy the code ref. The first one would just overwrite it |
1107
|
|
|
|
|
|
|
while the other one would remove the code (in fact it remains a code ref but |
1108
|
|
|
|
|
|
|
it will contain dummy code only). |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=head1 TODO |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
=over |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
=item Add some kind of select command |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
Example: |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
struct: |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
{ |
1121
|
|
|
|
|
|
|
users => [ |
1122
|
|
|
|
|
|
|
{ login => 'max', uid => 1 }, |
1123
|
|
|
|
|
|
|
{ login => 'leo', uid => 2 }, |
1124
|
|
|
|
|
|
|
] |
1125
|
|
|
|
|
|
|
} |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
> select login from users where uid = 1 |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
which should return 'max'. |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
(may require a real world parser) |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
=item Add some kind of schema support |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
Given the same structure as above: |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
> update users set uid = 4 where login = 'max' |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
=back |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
=head1 AUTHOR |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
T.v.Dein |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
=head1 BUGS |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
Report bugs to |
1148
|
|
|
|
|
|
|
http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Data::Interactive::Inspect |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
Copyright (c) 2015-2017 by T.v.Dein . All rights |
1153
|
|
|
|
|
|
|
reserved. |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
=head1 LICENSE |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
This program is free software; you can redistribute it |
1158
|
|
|
|
|
|
|
and/or modify it under the same terms as Perl itself. |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=head1 VERSION |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
This is the manual page for L Version 0.07. |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
=cut |