POE/Component/Terminal.pm

#!/usr/bin/perl
##
## POE::Component::Terminal -- Terminal Component
##
## $Id: Terminal.pm,v 0.01 2002/06/13 19:10:05 joko Exp $
##
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 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};

  ## 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 ($key) {
    
    $heap->{state}{KeyPressed} = 1;

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

    # enter pressed?
    if ($key eq "\r") {
      # send command
      my $buf = $heap->{state}{InputBuffer};
      if ($buf) {
        $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);
      }
      $heap->{state}{InputBuffer} = '';

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

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

  }

  
  $kernel->post($session, "pollForKey");
  #$kernel->delay("term_work", 0.1);

}


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