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	cvsjoko	1.1	#!/usr/bin/perl
2			##
3			## POE::Component::Terminal -- Terminal Component
4			##
5	cvsjoko	1.2	## $Id$
6			##
7			## $Log$
8	cvsjoko	1.1	##
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	cvsjoko	1.2	$heap->{state}{InputBuffer} = '';
194	cvsjoko	1.1	$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