POE/Component/Terminal.pm

#!/usr/bin/perl
##
## POE::Component::Terminal -- Terminal Component
##
## $Id: Terminal.pm,v 1.4 2002/06/15 04:28:10 cvsjoko Exp $
##
## $Log: Terminal.pm,v $
## 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};
  
  # initially call worker-state
  $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} && !$heap->{state}{RequestPending}) || ($heap->{state}{Startup}) ) {
    $heap->{state}{Startup} = 0;
    $heap->{state}{KeyPressed} = 0;
    #ReadMode 4; # Turn off controls keys
    #ReadMode 1;
    #print $prompt;
    my $outputline = $prompt . $heap->{state}{InputBuffer};
    my $s = ' ' x (length($outputline) + 1);
    print "\r", $s;
    print "\r", $outputline;
  }

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