POE/Component/Terminal.pm

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