Commit | Line | Data |
4536f655 |
1 | # File: Stem/Console.pm |
2 | |
3 | # This file is part of Stem. |
4 | # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc. |
5 | |
6 | # Stem is free software; you can redistribute it and/or modify |
7 | # it under the terms of the GNU General Public License as published by |
8 | # the Free Software Foundation; either version 2 of the License, or |
9 | # (at your option) any later version. |
10 | |
11 | # Stem is distributed in the hope that it will be useful, |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | # GNU General Public License for more details. |
15 | |
16 | # You should have received a copy of the GNU General Public License |
17 | # along with Stem; if not, write to the Free Software |
18 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
19 | |
20 | # For a license to use the Stem under conditions other than those |
21 | # described here, to purchase support for this software, or to purchase a |
22 | # commercial warranty contract, please contact Stem Systems at: |
23 | |
24 | # Stem Systems, Inc. 781-643-7504 |
25 | # 79 Everett St. info@stemsystems.com |
26 | # Arlington, MA 02474 |
27 | # USA |
28 | |
29 | package Stem::Console ; |
30 | |
31 | use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ; |
32 | use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ; |
33 | |
34 | use strict ; |
35 | |
36 | use Data::Dumper ; |
37 | use Symbol ; |
38 | use Socket ; |
39 | |
40 | use Stem::AsyncIO ; |
41 | use Stem::Vars ; |
42 | |
43 | my $console_obj ; |
44 | my $line ; |
45 | |
46 | my( $read_fh, $write_fh, $parent_fh, $child_fh ) ; |
47 | |
48 | if ( $^O =~ /Win32/ ) { |
49 | |
50 | |
51 | $parent_fh = gensym ; |
52 | $child_fh = gensym ; |
53 | |
54 | socketpair( $parent_fh, $child_fh, AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ; |
55 | start_reader() ; |
56 | start_writer() ; |
57 | |
58 | # close $child_fh ; |
59 | |
60 | $read_fh = $parent_fh ; |
61 | $write_fh = $parent_fh ; |
62 | } |
63 | else { |
64 | |
65 | $read_fh = \*STDIN ; |
66 | $write_fh = \*STDOUT ; |
67 | } |
68 | |
69 | return init() unless $Env{'console_disable'} || $Env{'tty_disable'} ; |
70 | |
71 | |
72 | sub start_reader { |
73 | |
74 | # back to parent |
75 | |
76 | return if fork() ; |
77 | |
78 | close $parent_fh ; |
79 | |
80 | #syswrite( \*STDERR, "reader started\n" ) ; |
81 | #warn "reader started2\n" ; |
82 | |
83 | while( 1 ) { |
84 | |
85 | my $buf ; |
86 | |
87 | my $cnt = sysread( \*STDIN, $buf, 1000 ) ; |
88 | |
89 | #syswrite( \*STDERR, $buf ) ; |
90 | |
91 | syswrite( $child_fh, $buf ) ; |
92 | } |
93 | } |
94 | |
95 | sub start_writer { |
96 | |
97 | # back to parent |
98 | |
99 | return if fork() ; |
100 | |
101 | # close $parent_fh ; |
102 | |
103 | while( 1 ) { |
104 | |
105 | my $buf ; |
106 | |
107 | my $cnt = sysread( $child_fh, $buf, 1000 ) ; |
108 | |
109 | syswrite( \*STDOUT, $buf ) ; |
110 | } |
111 | } |
112 | |
113 | sub init { |
114 | |
115 | Stem::Route::register_class( __PACKAGE__, 'cons', 'console', 'tty' ) ; |
116 | |
117 | $Env{'has_console'} = 1 ; |
118 | |
119 | my $self = bless {} ; |
120 | |
121 | my $aio = Stem::AsyncIO->new( |
122 | |
123 | 'object' => $self, |
124 | 'read_fh' => $read_fh, |
125 | 'write_fh' => $write_fh, |
126 | 'read_method' => 'stdin_read', |
127 | 'closed_method' => 'stdin_closed', |
128 | ) ; |
129 | |
130 | return $aio unless ref $aio ; |
131 | |
132 | $self->{'aio'} = $aio ; |
133 | |
134 | $self->{'prompt'} = $Env{'prompt'} || "\nStem > " ; |
135 | |
136 | $console_obj = $self ; |
137 | |
138 | $self->write( "\nEnter 'help' for help\n\n" ) ; |
139 | $self->prompt() ; |
140 | |
141 | return 1 ; |
142 | } |
143 | |
144 | sub stdin_read { |
145 | |
146 | my( $self, $line_ref ) = @_ ; |
147 | |
148 | $line = ${$line_ref} ; |
149 | |
150 | chomp( $line ) ; |
151 | |
152 | if ( $line =~ /^\s*$/ ) { |
153 | |
154 | $self->prompt() ; |
155 | return ; |
156 | } |
157 | |
158 | if ( $line =~ /^quit\s*$/i ) { |
159 | |
160 | TraceStatus "quitting" ; |
161 | |
162 | exit ; |
163 | } |
164 | |
165 | if ( $line =~ /^\s*help\s*$/i ) { |
166 | |
167 | $self->help() ; |
168 | $self->prompt() ; |
169 | return ; |
170 | } |
171 | |
172 | if ( my( $key, $val ) = $line =~ /^\s*(\w+)\s*=\s*(.+)$/ ) { |
173 | |
174 | $val =~ s/\s+$// ; |
175 | |
176 | $self->echo() ; |
177 | |
178 | $self->write( "Setting Environment '$key' to '$val'\n" ) ; |
179 | $Env{ $key } = $val ; |
180 | |
181 | $self->prompt() ; |
182 | |
183 | return ; |
184 | } |
185 | |
186 | unless ( $line =~ /^\s*(\S+)\s+(.*)$/ ) { |
187 | |
188 | $self->write( <<ERR ) ; |
189 | Console commands must be in the form |
190 | <Cell Address> command [args ...] |
191 | |
192 | ERR |
193 | $self->prompt() ; |
194 | |
195 | return ; |
196 | } |
197 | |
198 | my $addr = $1 ; |
199 | |
200 | my( $cmd_name, $cmd_data ) = split( ' ', $2, 2 ) ; |
201 | |
202 | # allow a leading : on the command to make it a regular message instead |
203 | |
204 | my $msg_type = ( $cmd_name =~ s/^:// ) ? 'type' : 'cmd' ; |
205 | |
206 | my $msg = Stem::Msg->new( |
207 | 'to' => $addr, |
208 | 'from' => 'console', |
209 | $msg_type => $cmd_name, |
210 | 'data' => \$cmd_data, |
211 | ) ; |
212 | |
213 | if( ref $msg ) { |
214 | |
215 | $self->echo() ; |
216 | |
217 | $msg->dispatch() ; |
218 | } |
219 | else { |
220 | $self->write( "Bad console command message: $msg\n" ) ; |
221 | } |
222 | |
223 | $self->prompt() ; |
224 | |
225 | return ; |
226 | } |
227 | |
228 | sub stdin_closed { |
229 | |
230 | my( $self ) = @_ ; |
231 | |
232 | *STDIN->clearerr() ; |
233 | |
234 | $self->write( "EOF (ignored)\n" ) ; |
235 | |
236 | $self->prompt() ; |
237 | } |
238 | |
239 | sub data_in { |
240 | |
241 | goto &response_in ; |
242 | } |
243 | |
244 | sub response_in { |
245 | |
246 | my( $self, $msg ) = @_ ; |
247 | |
248 | $self = $console_obj unless ref $self ; |
249 | |
250 | return unless $self ; |
251 | |
252 | my $data = $msg->data() ; |
253 | |
254 | $self->write( "\n\n" ) ; |
255 | |
256 | if ( $Env{'console_from'} ) { |
257 | |
258 | my $from = $msg->from() ; |
259 | |
260 | $self->write( "[From: $from]\n" ) ; |
261 | } |
262 | |
263 | if ( ref $data eq 'SCALAR' ) { |
264 | |
265 | $self->write( ${$data} ) ; |
266 | } |
267 | elsif( ref $data ) { |
268 | |
269 | $self->write( Dumper( $data ) ) ; |
270 | } |
271 | else { |
272 | |
273 | $self->write( $data ) ; |
274 | } |
275 | |
276 | $self->prompt() ; |
277 | } |
278 | |
279 | sub write { |
280 | |
281 | my( $self, $text ) = @_ ; |
282 | |
283 | $self = $console_obj unless ref $self ; |
284 | |
285 | $self->{'aio'}->write( $text ) ; |
286 | } |
287 | |
288 | |
289 | sub prompt { |
290 | |
291 | my( $self ) = @_ ; |
292 | |
293 | return unless $self->{'prompt'} ; |
294 | |
295 | $self->write( $self->{'prompt'} ) ; |
296 | } |
297 | |
298 | sub echo { |
299 | |
300 | my( $self ) = @_ ; |
301 | |
302 | return unless $Env{'console_echo'} ; |
303 | |
304 | $self->write( "->$line\n" ) ; |
305 | } |
306 | |
307 | sub help { |
308 | |
309 | my( $self ) = @_ ; |
310 | |
311 | $self->write( <<HELP ) ; |
312 | |
313 | Stem::Console Help: |
314 | |
315 | You can enter various commands to Stem here. |
316 | |
317 | If the line is of the form: |
318 | |
319 | key=value |
320 | |
321 | then the global command args hash %Stem::Vars::Env has that key set to |
322 | the value. Stem environment variables can be used to control log filters, |
323 | set cell behavior, set default values for cell attributes and other purposes |
324 | |
325 | If the line is of the form: |
326 | |
327 | address cmd data_text |
328 | |
329 | it is parsed and a command message is created and sent. |
330 | |
331 | The address can be in one of these forms: |
332 | |
333 | cell |
334 | hub:cell |
335 | hub:cell:target |
336 | :cell:target |
337 | |
338 | The cmd token is the name of the command for the message. If it is |
339 | prefixed with a :, then this string becomes the message type instead. |
340 | |
341 | The rest of the line is sent as the data of the message. |
342 | |
343 | Examples: |
344 | |
345 | reg status |
346 | |
347 | will send a 'status' command message to the 'reg' cell which is the |
348 | Stem::Route class. A listing of all registered Cells will be returned |
349 | and printed. |
350 | |
351 | server:sw map a c d |
352 | |
353 | That will send a 'map' command message to the Cell named 'sw' in the |
354 | Hub named 'server'. The data will be the string 'a c d'. That is used |
355 | to change the mapping of target 'a' to c, d in the Switch Cell in the |
356 | chat and chat2 demos. |
357 | |
358 | HELP |
359 | |
360 | } |
361 | |
362 | 1 ; |