Commit | Line | Data |
4536f655 |
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 ; |