Key-Board Interactive Perl Application

[anshumangoyal]

I want to make a keyboard interactive application which listens to the key-strokes and calls a subroutine accordingly.

e.g. when this application is running (in listening mode), and without stopping it if i press "AB<Enter>" it should run a sub routine AB_SUB and similarly with other keystrokes.

I don't know where to start with. Can anyone help me starting that.

[GrandFather]

For that sort of application I use light weight OO. Consider:

use strict;
use warnings;

my $obj = bless {indent => '...'};

for my $suffix (qw(hello world)) {
    my $func = $obj->can("print_$suffix");
    
    next if ! $func;
    $func->($obj, " (suffix was $suffix)");
}


sub print_hello {
    my ($self, $suffix) = @_;
    
    print "$self->{indent}hello$suffix\n";
}


sub print_world {
    my ($self, $suffix) = @_;
    
    print "$self->{indent}world$suffix\n";
}

Prints:

...hello (suffix was hello)
...world (suffix was world)

There are a few subtle things going on there. If you've not used OO before notice that the object ($obj) carries along a hash reference so you can provide common information (see how 'indent' is used).

The reason the sub names have a 'print_' prefix is so that user provided names can't be used to call unintended subs.

[roboticus]

...must...resist...urge...to...post...symbolic...reference...example...

Whew! I wrote the symbolic reference example, but didn't post it. Here are a couple alternatives:

You can use brute force:

while (my $inp = <>) {
    $inp =~ s/^\s*(\w+)\s*$/$1/;
    if    ($inp eq 'AB') { AB() }
    elsif ($inp eq 'CD') { CD() }
    ... etc ...    
    else {
        print "Command unknown: '$inp'\n";
    }
}

If you're using a more modern perl the brute force method could look like:

while (my $inp = <>) {
    $inp =~ s/^\s*(\w+)\s*$/$1/;
    given ($inp) {
       when ('AB') { AB() }
       when ('CD') { CD() }
       ... etc ...
       default {
        print "Command unknown: '$inp'\n";
    }
}

However, a better method is a dispatch table. There's a little more setup work at the beginning, but as you add new command handlers, you'll find it's easier to maintain:

my %dispatch_table = (
    AB => \&AB,
    CD => \&CD,
    ... etc ...
);
while (my $inp = <>) {
    $inp =~ s/^\s*(\w+)\s*$/$1/;
    if (exists $dispatch_table{$inp}) {
        &{$dispatch_table{$inp}}();
    }
    else {
        print "Command unknown: '$inp'\n";
    }
}

...roboticus

When your only tool is a hammer, all problems look like your thumb.

[zentara]

It smells like a homework assignment to me, but here are some things you will need to consider.

First, in order to have your program be both responsive to key entries, and at the same time be running other subroutines, you will need to use fork or threads.

Second, if you want to enter data like AB<ENTER>, you will be looking for readline routines, not readkey routines. Readline waits for an <ENTER> before sending it to STDIN.

Here are a few basic examples. There are many other event systems besides Glib, but I prefer it.

#!/usr/bin/perl 
use warnings;
use strict;
use Glib;

my $main_loop = Glib::MainLoop->new;

Glib::IO->add_watch (fileno 'STDIN', [qw/in/], \&watch_callback, 'STDI
+N');    

#just to show it's non blocking
my $timer1  = Glib::Timeout->add (10000, \&testcallback, undef, 1 );

$main_loop->run;

sub watch_callback {
#    print "@_\n";
    my ($fd, $condition, $fh) = @_;
    my $line = readline STDIN;
    print $line;
    #always return TRUE to continue the callback
    return 1;
}    

sub testcallback{
   print "\t\t\t".time."\n";

}
__END__

#!/usr/bin/perl
use warnings;
use strict;
use Term::ReadKey;
use threads;

$|++;
#ReadMode('cbreak');

# works non-blocking if read stdin is in a thread
my $thr = threads->new(\&read_in)->detach;

while(1){
print "test\n";
sleep 5;
}

#ReadMode('normal'); # restore normal tty settings


sub read_in{
        while(1){
         my $char;
         if (defined ($char = ReadKey(0)) ) {
            print "\t\t$char->", ord($char),"\n";    
            #process key presses here
            if($char eq 'q'){exit}
            #if(length $char){exit}  # panic button on any key :-)
            }
          }
}

__END__

[LanX]

Term::ReadLine is a core module which facilitates keyboard interactions a lot and is extremely rich in features.

The simplest approach to execute the input text is eval.

Depending if it's just a personal play tool or an application for other users you should consider limiting what input is executed!

E.g. Grandfather showed you an approach to limit input to methods of a special class w/o eval, which is quite safe!

Example: Just taking the synopsis-code from term-readline already does most of the trick. Additionally limiting to package 'allowed_subs" is a (weaker) protection against misuse.

use Term::ReadLine;
my $term = Term::ReadLine->new('Simple Perl calc');
my $prompt = "Enter code: ";
my $OUT = $term->OUT || \*STDOUT;
while ( defined ($_ = $term->readline($prompt)) ) {
  my $res = eval("package allowed_subs; $_");
  warn $@ if $@;
  print $OUT $res, "\n" unless $@;
  $term->addhistory($_) if /\S/;
}
  
package allowed_subs;
 
sub ab {
  `xmessage "@_"`       # Pop-Up input  (linux only)
}