| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
use strict; |
| 4 |
use warnings; |
| 5 |
|
| 6 |
use lib 'lib'; |
| 7 |
|
| 8 |
use Term::Shelly; |
| 9 |
use CWMP::Store; |
| 10 |
use CWMP::Tree; |
| 11 |
use DBM::Deep; |
| 12 |
use Data::Dump qw/dump/; |
| 13 |
use Getopt::Long; |
| 14 |
use Carp qw/confess/; |
| 15 |
|
| 16 |
my $debug = 0; |
| 17 |
my $store_path = 'state.db'; |
| 18 |
|
| 19 |
GetOptions( |
| 20 |
'debug+' => \$debug, |
| 21 |
'store-path=s' => \$store_path, |
| 22 |
); |
| 23 |
|
| 24 |
my $sh = Term::Shelly->new(); |
| 25 |
my $tree = CWMP::Tree->new({ debug => $debug }); |
| 26 |
|
| 27 |
our $store = CWMP::Store->new({ |
| 28 |
debug => $debug, |
| 29 |
path => $store_path, |
| 30 |
}); |
| 31 |
|
| 32 |
$sh->out( |
| 33 |
"You can issue commenads in form using tab-complete: |
| 34 |
|
| 35 |
CPE_Serial ( parametar [ [=] value ] | command ) |
| 36 |
" |
| 37 |
); |
| 38 |
|
| 39 |
$sh->{"completion_function"} = \&completer; |
| 40 |
$sh->{"readline_callback"} = \&command; |
| 41 |
|
| 42 |
my @history = ( 'exit' ); |
| 43 |
my $pos = $#history; |
| 44 |
$sh->{'mappings'}->{'up-history'} = [ sub { |
| 45 |
my $self = shift; |
| 46 |
if ( $pos >= 0 ) { |
| 47 |
$self->{'input_line'} = $history[ $pos ]; |
| 48 |
$pos--; |
| 49 |
$self->{'input_position'} = length( $self->{'input_line'} ); |
| 50 |
$self->fix_inputline; |
| 51 |
} |
| 52 |
} ]; |
| 53 |
$sh->{'mappings'}->{'down-history'} = [ sub { |
| 54 |
my $self = shift; |
| 55 |
my $line = ''; |
| 56 |
if ( $pos < $#history ) { |
| 57 |
$pos++; |
| 58 |
$line = $history[ $pos ]; |
| 59 |
} |
| 60 |
$self->{'input_line'} = $line; |
| 61 |
$self->{'input_position'} = length( $self->{'input_line'} ); |
| 62 |
$self->fix_inputline; |
| 63 |
} ]; |
| 64 |
|
| 65 |
$sh->prompt( '> ' ); |
| 66 |
|
| 67 |
while (1) { |
| 68 |
$sh->do_one_loop(); |
| 69 |
} |
| 70 |
|
| 71 |
sub completer { |
| 72 |
my ($line, $bword, $pos, $curword) = @_; |
| 73 |
|
| 74 |
$sh->out( "line: '$line' [ $bword - $pos ] -> '$curword'" ); |
| 75 |
|
| 76 |
my @matches; |
| 77 |
|
| 78 |
# do we have list (part) of CPE? |
| 79 |
if ( $line =~ /^(\S*)\s*$/ ) { |
| 80 |
@matches = sort grep { /^\Q$curword\E/ } $store->known_CPE; |
| 81 |
$sh->out( "CPE available: ", join(",", @matches ) ); |
| 82 |
} elsif ( $line =~ /^(\w+)\s+(\S+)$/ ) { |
| 83 |
$sh->out("finding completes for '$2'"); |
| 84 |
my ( $cpe_uid, $name ) = ( $1, $2 ); |
| 85 |
|
| 86 |
my $beginning = $name; |
| 87 |
my $part = ''; |
| 88 |
if ( $beginning =~ s/\.([^\.]+)$// ) { |
| 89 |
$part = $1; |
| 90 |
} elsif ( $beginning =~ s/^(\S+)$// ) { |
| 91 |
$part = $1; |
| 92 |
} else { |
| 93 |
confess "can't extract suffix"; |
| 94 |
} |
| 95 |
|
| 96 |
$sh->out( "## $cpe_uid ## beginning: $beginning -- part: $part" ); |
| 97 |
my $perl = "\$store->db->{state}->{'$cpe_uid'}->{ParameterInfo}"; |
| 98 |
$perl .= '->' . $tree->name2perl( $beginning ) if ( defined( $beginning ) && $beginning ne '' ); |
| 99 |
$sh->out( "## $cpe_uid ## $perl" ); |
| 100 |
|
| 101 |
@matches = eval "keys %{ $perl }"; |
| 102 |
|
| 103 |
} |
| 104 |
|
| 105 |
return @matches; |
| 106 |
} |
| 107 |
|
| 108 |
sub command { |
| 109 |
my ( $line ) = @_; |
| 110 |
|
| 111 |
return unless ( $line && $line ne '' ); |
| 112 |
|
| 113 |
# just CPE uid |
| 114 |
if ( $line =~ /^(\w+)\s*$/ ) { |
| 115 |
if ( main->can( $1 ) ) { |
| 116 |
$sh->out( "# execute command $1" ); |
| 117 |
eval " \&$1( \$line ) "; |
| 118 |
} elsif ( defined ( $store->db->{state}->{$1} ) ) { |
| 119 |
$sh->out( |
| 120 |
join(" ", keys %{ $store->db->{state}->{$1}->{ParameterInfo} }) |
| 121 |
); |
| 122 |
push @history, $line; |
| 123 |
$pos = $#history; |
| 124 |
} else { |
| 125 |
$sh->out( "$line: CPE not found" ); |
| 126 |
} |
| 127 |
} else { |
| 128 |
$sh->out( "$line: command not recognized" ); |
| 129 |
} |
| 130 |
} |
| 131 |
|
| 132 |
sub history { |
| 133 |
$sh->out( "history: ", dump ( @history ) ); |
| 134 |
} |
| 135 |
|
| 136 |
sub exit { |
| 137 |
CORE::exit(); |
| 138 |
} |
Parent Directory
| 
Revision Log