POE/Component/Terminal.pm

#!/usr/bin/perl
##
## POE::Component::Terminal -- Terminal Component
##
## $Id: Terminal.pm,v 1.5 2002/06/15 05:19:36 cvsjoko Exp $
##
## $Log: Terminal.pm,v $
## Revision 1.5  2002/06/15 05:19:36  cvsjoko
## + modified order/way of key-handling-logic
##
## Revision 1.4  2002/06/15 04:28:10  cvsjoko
## immediate polling, no delay
##
## Revision 1.3  2002/06/15 04:24:15  cvsjoko
## + added modifier for running in linux or win32
## + modified order of some commands in core key-polling
##
## Revision 1.2  2002/06/15 03:45:21  cvsjoko
## + cvs id & log
## + clearing inputbuffer just after getting the "enter"-key
##
##
package POE::Component::Terminal;

use strict;
#use strict qw ( vars refs );
use warnings;


use Carp qw( croak carp );

use POE;

use Term::ReadKey;
use Data::Dumper;

$POE::Component::Terminal::VERSION = 0.01;

my @args_needed = qw (
        Alias
        Caption
        PromptPrefix
        PromptPostfix
        RequestSession
        RequestState
        ResponseSession
        ResponseState
        PromptChangeState
);

my $states = {
              _start       => 'start',
              _stop        => 'stop',
              _signal      => 'signal',
              _default     => 'default',
          pollForKey => 'pollForKey',
          recievePrompt => 'recievePrompt',
          recieveResponse => 'recieveResponse',
             };

sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }

sub new {
  my $class = shift;
  $class = ref( $class ) || $class;
  #my( %args ) = ( %default_args, @_ );
  my $args = shift;

  # bless class into object ($self)
  my $self = bless {}, $class;

  ## Check args
  foreach my $arg_needed (@args_needed) {
    croak "Need $arg_needed argument." 
      unless exists $args->{ $arg_needed };
  }

  # store entries from args to object ($self)
  map { $self->{$_} = $args->{$_}; } keys %{$args};

  if ( RUNNING_IN_HELL () ) {
    $self->{conf}{EnterKey} = "\r";
  } else {
    $self->{conf}{EnterKey} = "\n";
  }

  ## Make our session.  See $states defined up above . . .
  POE::Session->create( object_states => [ $self => $states, ], );

  return $self;
}

##
## start -- Startup state
##
sub start {
  my( $self, $kernel, $heap, $session, $sender ) =
    @_[ OBJECT, KERNEL, HEAP, SESSION, SENDER ];

  ## Pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::start\r\n" if $self->{Debug};

  ## Set the alias requested so we can be post'd to
  $kernel->alias_set( $self->{Alias} );

  ## Remember session that created us for posting DispatchEvent
  $self->{ _target } = $sender;

  $heap->{state}{InputBuffer} = '';
  $heap->{state}{Startup} = 1;
  $heap->{state}{Caption} = $self->{Caption};
  $heap->{state}{KeyPressed} = 0;
  $heap->{state}{RequestPending} = 0;
  
  # initially call worker-state
  ReadMode 4;
  $kernel->post($session, "pollForKey");

  return;
}

##
## stop -- Shutdown state
##
sub stop {
  my( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::stop\r\n" if $self->{_debug};

  return
}

##
## signal -- Handle any signals received
##
sub signal {
  my( $self, $heap, $signal ) = @_[ OBJECT, HEAP, ARG0 ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::signal $signal\n" if $self->{_debug};

  ## shut things down on TERM, QUIT, or INT
  if( $signal =~ /^TERM|QUIT|INT/ ) {
    delete $heap->{wheel};      # toss our listening wheel reference

    ## Check for child wheels
    my $live_wheels = scalar keys %{$heap->{wheels}};
    if( $live_wheels ) {
      print STDERR "Exiting with $live_wheels clients still active\n"
        if $self->{_debug};
      delete $heap->{wheels};
    }
  }

  return
}

##
## default -- Catch any unhandled events for debugging
##
sub default {
  my( $self, $heap, $event ) = @_[ OBJECT, HEAP, ARG0 ];

  ## Just pipe up if we're debugging
  print STDERR "## ", __PACKAGE__, "::default got $event\n"
    if $self->{_debug};

  return
}


# ================ POE stuff

sub pollForKey {

  my ($self, $kernel, $heap, $session) = @_[OBJECT, KERNEL, HEAP, SESSION ];

  my $prompt_inlay = $heap->{state}{PromptInlay};
  if ($prompt_inlay) { $prompt_inlay .= ' '; } else { $prompt_inlay = ''; }

  my $prompt = "#> ";
  $prompt = $self->{PromptPrefix} . ' ' . $prompt_inlay . $self->{PromptPostfix};

  if ( ( 
        ( $heap->{state}{KeyPressed} == 1 ) && 
        ( $heap->{state}{RequestPending} == 0 )
       ) ||
        ( $heap->{state}{Startup} ) 
      ) {
    $heap->{state}{Startup} = 0;
    $heap->{state}{KeyPressed} = 0;
    my $outputline = $prompt . $heap->{state}{InputBuffer};
    my $s = ' ' x (length($outputline) + 1);
    print "\r", $s;
    print "\r", $outputline;
    #print $outputline;
  }

  my $key = ReadKey(-1);
  if ( defined $key ) {

#print "key: ", ord($key), "\n";
    
    # CTRL+C pressed?
    if (ord($key) == 3) {
      ReadMode 1;
      print "\n";
      exit;
    }

    # enter pressed?
    if (ord($key) == 10) {

      # if enter was pressed while request was pending,
      # we should stop waiting for output and come back to prompt again,
      if ($heap->{state}{RequestPending}) {
        $kernel->post( $self->{ResponseSession} => $self->{ResponseState} => '  < stopped waiting for response');
      }

      # send command, if buffer is filled
      my $buf = $heap->{state}{InputBuffer};
      if ($buf) {
        $heap->{state}{InputBuffer} = '';
        $heap->{state}{RequestPending} = 1;
        my $response_target = {
          ResponseSession => $self->{ResponseSession},
          ResponseState => $self->{ResponseState},
        };
        $kernel->post( $self->{RequestSession} => $self->{RequestState} => $buf, $response_target);
      }

      # prepare new loop for fresh prompt
      print "\n";

    }

    # backspace pressed?
    elsif (ord($key) == 127) {
      $heap->{state}{InputBuffer} = substr($heap->{state}{InputBuffer}, 0, -1);
    }

    # normal key?
    #elsif ($key =~ m/[a-zA-Z? ]/) {
    else {
      $heap->{state}{InputBuffer} .= $key;
      #print $key;
    }

    # mark "KeyPressed" for next poll
    $heap->{state}{KeyPressed} = 1;

  }

  #$kernel->run_one_timeslice();
  $kernel->post($session, "pollForKey");
  #$kernel->yield($session, "pollForKey");
  #$kernel->delay("pollForKey", 0.1);
  #$kernel->delay("pollForKey", 0.01);

}


sub recieveResponse {
  my ($kernel, $heap, $session, $response) = @_[KERNEL, HEAP, SESSION, ARG0];
  if ($response) { 
    print $response, "\n";
    $heap->{state}{RequestPending} = 0;
  }
}
sub recievePrompt {
  my ($kernel, $heap, $session, $prompt_inlay) = @_[KERNEL, HEAP, SESSION, ARG0];
  $heap->{state}{PromptInlay} = $prompt_inlay;
}


1;
1	#!/usr/bin/perl
2	##
3	## POE::Component::Terminal -- Terminal Component
4	##
5	## $Id: Terminal.pm,v 1.5 2002/06/15 05:19:36 cvsjoko Exp $
6	##
7	## $Log: Terminal.pm,v $
8	## Revision 1.5 2002/06/15 05:19:36 cvsjoko
9	## + modified order/way of key-handling-logic
10	##
11	## Revision 1.4 2002/06/15 04:28:10 cvsjoko
12	## immediate polling, no delay
13	##
14	## Revision 1.3 2002/06/15 04:24:15 cvsjoko
15	## + added modifier for running in linux or win32
16	## + modified order of some commands in core key-polling
17	##
18	## Revision 1.2 2002/06/15 03:45:21 cvsjoko
19	## + cvs id & log
20	## + clearing inputbuffer just after getting the "enter"-key
21	##
22	##
23	package POE::Component::Terminal;
24
25	use strict;
26	#use strict qw ( vars refs );
27	use warnings;
28
29
30	use Carp qw( croak carp );
31
32	use POE;
33
34	use Term::ReadKey;
35	use Data::Dumper;
36
37	$POE::Component::Terminal::VERSION = 0.01;
38
39	my @args_needed = qw (
40	Alias
41	Caption
42	PromptPrefix
43	PromptPostfix
44	RequestSession
45	RequestState
46	ResponseSession
47	ResponseState
48	PromptChangeState
49	);
50
51	my $states = {
52	_start => 'start',
53	_stop => 'stop',
54	_signal => 'signal',
55	_default => 'default',
56	pollForKey => 'pollForKey',
57	recievePrompt => 'recievePrompt',
58	recieveResponse => 'recieveResponse',
59	};
60
61	sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
62
63	sub new {
64	my $class = shift;
65	$class = ref( $class ) \|\| $class;
66	#my( %args ) = ( %default_args, @_ );
67	my $args = shift;
68
69	# bless class into object ($self)
70	my $self = bless {}, $class;
71
72	## Check args
73	foreach my $arg_needed (@args_needed) {
74	croak "Need $arg_needed argument."
75	unless exists $args->{ $arg_needed };
76	}
77
78	# store entries from args to object ($self)
79	map { $self->{$_} = $args->{$_}; } keys %{$args};
80
81	if ( RUNNING_IN_HELL () ) {
82	$self->{conf}{EnterKey} = "\r";
83	} else {
84	$self->{conf}{EnterKey} = "\n";
85	}
86
87	## Make our session. See $states defined up above . . .
88	POE::Session->create( object_states => [ $self => $states, ], );
89
90	return $self;
91	}
92
93	##
94	## start -- Startup state
95	##
96	sub start {
97	my( $self, $kernel, $heap, $session, $sender ) =
98	@_[ OBJECT, KERNEL, HEAP, SESSION, SENDER ];
99
100	## Pipe up if we're debugging
101	print STDERR "## ", __PACKAGE__, "::start\r\n" if $self->{Debug};
102
103	## Set the alias requested so we can be post'd to
104	$kernel->alias_set( $self->{Alias} );
105
106	## Remember session that created us for posting DispatchEvent
107	$self->{ _target } = $sender;
108
109	$heap->{state}{InputBuffer} = '';
110	$heap->{state}{Startup} = 1;
111	$heap->{state}{Caption} = $self->{Caption};
112	$heap->{state}{KeyPressed} = 0;
113	$heap->{state}{RequestPending} = 0;
114
115	# initially call worker-state
116	ReadMode 4;
117	$kernel->post($session, "pollForKey");
118
119	return;
120	}
121
122	##
123	## stop -- Shutdown state
124	##
125	sub stop {
126	my( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ];
127
128	## Just pipe up if we're debugging
129	print STDERR "## ", __PACKAGE__, "::stop\r\n" if $self->{_debug};
130
131	return
132	}
133
134	##
135	## signal -- Handle any signals received
136	##
137	sub signal {
138	my( $self, $heap, $signal ) = @_[ OBJECT, HEAP, ARG0 ];
139
140	## Just pipe up if we're debugging
141	print STDERR "## ", __PACKAGE__, "::signal $signal\n" if $self->{_debug};
142
143	## shut things down on TERM, QUIT, or INT
144	if( $signal =~ /^TERM\|QUIT\|INT/ ) {
145	delete $heap->{wheel}; # toss our listening wheel reference
146
147	## Check for child wheels
148	my $live_wheels = scalar keys %{$heap->{wheels}};
149	if( $live_wheels ) {
150	print STDERR "Exiting with $live_wheels clients still active\n"
151	if $self->{_debug};
152	delete $heap->{wheels};
153	}
154	}
155
156	return
157	}
158
159	##
160	## default -- Catch any unhandled events for debugging
161	##
162	sub default {
163	my( $self, $heap, $event ) = @_[ OBJECT, HEAP, ARG0 ];
164
165	## Just pipe up if we're debugging
166	print STDERR "## ", __PACKAGE__, "::default got $event\n"
167	if $self->{_debug};
168
169	return
170	}
171
172
173
174
175
176
177
178	# ================ POE stuff
179
180	sub pollForKey {
181
182	my ($self, $kernel, $heap, $session) = @_[OBJECT, KERNEL, HEAP, SESSION ];
183
184	my $prompt_inlay = $heap->{state}{PromptInlay};
185	if ($prompt_inlay) { $prompt_inlay .= ' '; } else { $prompt_inlay = ''; }
186
187	my $prompt = "#> ";
188	$prompt = $self->{PromptPrefix} . ' ' . $prompt_inlay . $self->{PromptPostfix};
189
190	if ( (
191	( $heap->{state}{KeyPressed} == 1 ) &&
192	( $heap->{state}{RequestPending} == 0 )
193	) \|\|
194	( $heap->{state}{Startup} )
195	) {
196	$heap->{state}{Startup} = 0;
197	$heap->{state}{KeyPressed} = 0;
198	my $outputline = $prompt . $heap->{state}{InputBuffer};
199	my $s = ' ' x (length($outputline) + 1);
200	print "\r", $s;
201	print "\r", $outputline;
202	#print $outputline;
203	}
204
205	my $key = ReadKey(-1);
206	if ( defined $key ) {
207
208	#print "key: ", ord($key), "\n";
209
210	# CTRL+C pressed?
211	if (ord($key) == 3) {
212	ReadMode 1;
213	print "\n";
214	exit;
215	}
216
217	# enter pressed?
218	if (ord($key) == 10) {
219
220	# if enter was pressed while request was pending,
221	# we should stop waiting for output and come back to prompt again,
222	if ($heap->{state}{RequestPending}) {
223	$kernel->post( $self->{ResponseSession} => $self->{ResponseState} => ' < stopped waiting for response');
224	}
225
226	# send command, if buffer is filled
227	my $buf = $heap->{state}{InputBuffer};
228	if ($buf) {
229	$heap->{state}{InputBuffer} = '';
230	$heap->{state}{RequestPending} = 1;
231	my $response_target = {
232	ResponseSession => $self->{ResponseSession},
233	ResponseState => $self->{ResponseState},
234	};
235	$kernel->post( $self->{RequestSession} => $self->{RequestState} => $buf, $response_target);
236	}
237
238	# prepare new loop for fresh prompt
239	print "\n";
240
241	}
242
243	# backspace pressed?
244	elsif (ord($key) == 127) {
245	$heap->{state}{InputBuffer} = substr($heap->{state}{InputBuffer}, 0, -1);
246	}
247
248	# normal key?
249	#elsif ($key =~ m/[a-zA-Z? ]/) {
250	else {
251	$heap->{state}{InputBuffer} .= $key;
252	#print $key;
253	}
254
255	# mark "KeyPressed" for next poll
256	$heap->{state}{KeyPressed} = 1;
257
258	}
259
260	#$kernel->run_one_timeslice();
261	$kernel->post($session, "pollForKey");
262	#$kernel->yield($session, "pollForKey");
263	#$kernel->delay("pollForKey", 0.1);
264	#$kernel->delay("pollForKey", 0.01);
265
266	}
267
268
269
270
271	sub recieveResponse {
272	my ($kernel, $heap, $session, $response) = @_[KERNEL, HEAP, SESSION, ARG0];
273	if ($response) {
274	print $response, "\n";
275	$heap->{state}{RequestPending} = 0;
276	}
277	}
278	sub recievePrompt {
279	my ($kernel, $heap, $session, $prompt_inlay) = @_[KERNEL, HEAP, SESSION, ARG0];
280	$heap->{state}{PromptInlay} = $prompt_inlay;
281	}
282
283
284	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26