#!/usr/bin/env perl

use Term::ReadKey;
use Time::HiRes qw( usleep );
use Data::Dumper;

use Time::localtime;
use threads;

#use IO::Handle;

use strict;
use warnings;

# http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.31.html
# http://www.rocketaware.com/perl/perlfaq5/How_can_I_read_a_single_cha
+racte.htm

# Works only in linux:
# http://groups.google.com/group/linux.debian.user/browse_thread/threa
+d/eaaedcaae8bc3e9a/8109745493b41a58?lnk=st&q=pgup+perl+readkey&rnum=5
+&hl=sv#8109745493b41a58

# PC 2-byte keycodes = ^@ + the following:

# HEX     KEYS
# ---     ----
# 0F      SHF TAB
# 10-19   ALT QWERTYUIOP
# 1E-26   ALT ASDFGHJKL
# 2C-32   ALT ZXCVBNM
# 3B-44   F1-F10
# 47-49   HOME,UP,PgUp
# 4B      LEFT
# 4D      RIGHT
# 4F-53   END,DOWN,PgDn,Ins,Del
# 54-5D   SHF F1-F10
# 5E-67   CTR F1-F10
# 68-71   ALT F1-F10
# 73-77   CTR LEFT,RIGHT,END,PgDn,HOME
# 78-83   ALT 1234567890-=
# 84      CTR PgUp

$| = 1;
#$|++;
#select(STDOUT);
#$| = 1;

#my $io = new IO::Handle;
#if ($io->fdopen(fileno(STDOUT),"w")) {
#    $io->print("Some text\n");
#}
#autoflush STDOUT 1;


#my $old_ioctl;

#BEGIN {
#    $old_ioctl = ioctl(STDIN,0,0) || -1;     # Gets device info
#    $old_ioctl &= 0xff;
#    ioctl(STDIN,1,$old_ioctl | 32);    # Writes it back, setting bit 
+5
#}

my %key_cmd_map = (
    # escseq       command
    '[A'  => sub { print "Up\n" },      # those escape sequences shoul
+d
    '[B'  => sub { print "Down\n" },    # work in the linux console
    '[C'  => sub { print "Right\n" },
    '[D'  => sub { print "Left\n" },
    '[G'  => sub { print "Center\n" },
    '[5~' => sub { print "PgUp\n" },
    '[6~' => sub { print "PgDn\n" },
    '[1~' => sub { print "Home\n" },
    '[4~' => sub { print "End\n" },


    '[[A' => sub { print "F1\n" },


    '[2~' => sub { print "Insert Key" },        # Insert key
    '[3~' => sub { print "Delete Key" },        # Delete key
);


startListening();

sub startListening {


    # Start seperate thread:
    my $thr = threads->create('helper_thread');
    # Disable CTRL keys
    ReadMode(0);
    my $word = '';
    my $prompt = "PerlMonkShell> ";
    my $pos = 0;

    print formatTime(time) . " | " . $prompt;
    while(1){

        my $char;
        while (!defined ($char = ReadKey(-1))){
            usleep 1_100;
            #print chr(8) x (length($word) + 1)
            #.     ' ' x (length($word) + 1)
            print "\r"
            .     formatTime(time) . " | " . $prompt . $word;
        }

        #sysread(STDIN,$char,1);               # Read a single charact
+er

        my $ord = ord($char);

        if ($ord == 0) {

            #ioctl(STDIN,1,$old_ioctl);         # Sets it back to cook
+ed mode.
            #print Dumper($old_ioctl);

            #sysread(STDIN,$char,1);


            #while (!defined ($char = ReadKey(-1))){
            #    sleep 1;
            #    print "#\n";
            #}

            #print "NEW: " . hex(ord($char)) . "\n";

         }

        last if ($ord == 3);

        last if ($ord == 4);

        #chomp($char);
        #print $char;
        #print $ord;

        if ($ord == 10 or $ord == 13) {  # "Enter"
            #print chr(8) x (length($word) + length($prompt))
            #.     ' ' x (length($word) + length($prompt))
            #.     "\r"
            #;
            if (length($word) < 1) {
                next;
            }
            print "\n";
            enterPressed($word);
            $word = "";
            print formatTime(time) . " | " . $prompt;

            $pos = 0;
            next;
        }
        elsif ($ord == 127) { # ie "Backspace"
            #chop($word);
            #print chr(8),' ',chr(8);
            #print "BACKSPACE!\n";
            next;
        }
        elsif ($ord == 27) { # "ESC"
            print chr(8) x (length($word) + 1)
            .     ' ' x (length($word) + 1)
            .     "\r"
            .     $prompt;
            $word="";
            $pos = 0;
        }
        elsif ($ord == 8) {

            if ($pos == 0) {
                print " ";
                next;
            }
            --$pos;
            #print "BACKSPACE!\n";
             #print chr(8) . ' ' . chr(8);
             chop($word);
             print " " . chr(8);
             next;
        }

        if($ord >= 32 && $ord < 155) {
            ++$pos;
            $word .= chr($ord);
            #print '*';
        }

    }

    ReadMode(0);
}

sub helper_thread {

    while(1) {

        #print "!\n";
        sleep 1;
    }
}

sub enterPressed {

    my $word = shift;
    #print "WORD: " . $word . "\n";

}

sub formatTime {

    my $t_time = shift;
       my $temp_time = localtime($t_time);
       my $time = "1900-01-01 01:01:01";
       if (defined ($temp_time)) {
           $time = sprintf "%04d-%02d-%02d %02d:%02d:%02d", $temp_time
+->year+1900, $temp_time->mon+1, $temp_time->mday, $temp_time->hour, $
+temp_time->min, $temp_time->sec;
       }
       return $time;
}
[download]