POE/Component/Terminal.pm

#!/usr/bin/perl
##
## POE::Component::Terminal -- Terminal Component
##
## $Id: Terminal.pm,v 1.8 2002/06/15 08:08:51 cvsjoko Exp $
##
## $Log: Terminal.pm,v $
## Revision 1.8  2002/06/15 08:08:51  cvsjoko
## + modifications in Term::ReadKey behaviour
##
## Revision 1.7  2002/06/15 07:56:40  cvsjoko
## + bugfixes for win32 (additional keys)
##
## Revision 1.6  2002/06/15 07:46:11  cvsjoko
## + bugfixes for linux
##
## 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}{KeyEnter} = 13;
    $self->{conf}{KeyBackspace} = 8;
    $self->{conf}{KeyCTRLC} = 3;
  } else {
    $self->{conf}{KeyEnter} = 10;
    $self->{conf}{KeyBackspace} = 127;
    $self->{conf}{KeyCTRLC} = 3;
  }

  ## 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) == $self->{conf}{KeyCTRLC}) {
      ReadMode 1;
      print "\n";
      exit;
    }

    # enter pressed?
    if (ord($key) == $self->{conf}{KeyEnter}) {

      # 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) == $self->{conf}{KeyBackspace}) {
      $heap->{state}{InputBuffer} = substr($heap->{state}{InputBuffer}, 0, -1);
    }

    # unknown key?
    elsif (ord($key) == 0) {
    }

    # 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->post($session, "pollForKey");
  #$kernel->run_one_timeslice();
  #$kernel->post($session, "pollForKey");
  #$kernel->yield($session, "pollForKey");
  #$kernel->delay("pollForKey", 0.1);
  #$kernel->delay("pollForKey", 0.001);

}


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