lib/Stem/Demo/CLI.pm

   1 package Stem::Demo::CLI ;
   2
   3 print "LOAD\n" ;
   4
   5 use strict;
   6
   7 use base 'Stem::Cell' ;
   8
   9 my $attr_spec = [
  10                  {
  11                   name      => 'reg_name',
  12                   help      => <<HELP,
  13 Name this Cell was registered with.
  14 HELP
  15          },
  16                  {
  17                   name      => 'cell_attr',
  18                   class     => 'Stem::Cell',
  19                   help      => <<HELP,
  20 This value is the attributes for the included Stem::Cell which handles
  21 cloning and sequencing.
  22 HELP
  23          },
  24 ];
  25
  26 sub new {
  27
  28         my( $class ) = shift ;
  29 #print "ARGS [@_]\n" ;
  30         my $self = Stem::Class::parse_args( $attr_spec, @_ );
  31         return $self unless ref $self;
  32
  33         return $self ;
  34 }
  35
  36 sub triggered_cell {
  37
  38         my( $self ) = @_ ;
  39
  40 print "TRIGGERED\n" ;
  41
  42         $self->cell_activate;
  43
  44 #print $self->SUPER::_dump( "CLI TRIGGERED\n" ) ;
  45
  46         return;
  47 }
  48
  49 my %op_to_code = (
  50
  51         set     => \&_set,
  52         get     => \&_get,
  53         dump    => \&_dump,
  54         clear   => \&_clear,
  55         help    => \&_help,
  56 ) ;
  57
  58 sub data_in {
  59
  60         my( $self, $msg ) = @_;
  61
  62 #print $msg->dump( 'IN' ) ;
  63
  64         $self->{data_in_msg} = $msg ;
  65
  66         my $data = $msg->data() ;
  67
  68         my $op = $data->{op} ;
  69
  70         if( my $code = $op_to_code{ $op } ) {
  71
  72                 $self->$code( $data ) ;
  73         }
  74         else {
  75
  76                 $self->send_reply( "unknown CLI op '$op'" ) ;
  77         }
  78 }
  79
  80 sub send_reply {
  81
  82         my ( $self, $data ) = @_;
  83
  84         my $in_msg = delete $self->{data_in_msg} ;
  85
  86         my $reply_msg = $in_msg->reply( type => 'data', data => $data ) ;
  87
  88 #print $reply_msg->dump( 'REPLY' ) ;
  89
  90         $reply_msg->dispatch() ;
  91 }
  92
  93 sub _set {
  94
  95         my( $self, $data ) = @_;
  96
  97         my $key = $data->{key} ;
  98         if ( defined( $key ) ) {
  99
 100                 my $value = $data->{value} ;
 101
 102                 $self->{data}{$key} = $value ;
 103
 104                 $self->send_reply( "set '$key' to '$value'" ) ;
 105         }
 106         else {
 107                 $self->send_reply( "set is missing a key" ) ;
 108         }
 109 }
 110
 111 sub _get {
 112
 113         my( $self, $data ) = @_;
 114
 115         my $key = $data->{key} ;
 116         if ( defined( $key ) ) {
 117
 118                 my $value = $self->{data}{$key} ;
 119
 120                 $self->send_reply( "'$key' was set to '$value'" ) ;
 121         }
 122         else {
 123                 $self->send_reply( "get is missing a key" ) ;
 124         }
 125 }
 126
 127 sub _clear {
 128
 129         my( $self ) = @_;
 130
 131         $self->{data} = {} ;
 132         $self->send_reply( "cleared your data" ) ;
 133 }
 134
 135 sub _dump {
 136
 137         my( $self ) = @_;
 138
 139         my $text = join '', map "\t$_ => $self->{data}{$_}\n",
 140                                         sort keys %{$self->{data}} ;
 141
 142         $self->send_reply( "your data is:\n$text\n" ) ;
 143 }
 144
 145 sub _help {
 146
 147         my( $self ) = @_;
 148
 149         my $text = <<TEXT ;
 150
 151 These are the commands supported in Stem::Demo::CLI
 152
 153 set <name> <value>
 154 get <name>
 155 dump
 156 clear
 157 help
 158
 159 set sets a value in the CLI session hash
 160 get gets a value in the CLI session hash
 161 dump returns a dump of the session hash
 162 clear will empty the the session hash
 163 help prints this text
 164
 165 TEXT
 166
 167         $self->send_reply( $text ) ;
 168 }
 169
 170
 171 1 ;