bin/cli.pl

   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 }