lib/Stem/Console.pm

   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 ;