hotsanic

Subversion Repositories:
[/] [branches/] [HotSaNIC-0.5.0-pre6/] [lib/] [HotSaNICshellio.pm] - Rev 16 Go to most recent revision
Compare with Previous - Blame - Download
#
# $Id: HotSaNICshellio.pm,v 1.11 2004/04/26 19:31:44 bernisys Exp $
#

package HotSaNICshellio;

($VERSION = '$Revision: 1.11 $') =~ s/.*(\d+\.\d+).*/$1/;

use POSIX qw(:termios_h);

my ($term, $oterm, $echo, $noecho, $fd_stdin);

$fd_stdin = fileno(STDIN);

$term     = POSIX::Termios->new();
$term->getattr($fd_stdin);
$oterm     = $term->getlflag();

$echo     = ECHO | ECHOK | ICANON;
$noecho   = $oterm & ~$echo;

open FILE,"clear|";
$CLS=<FILE>;
close FILE;


######################################################################
#
# waits for a key to be pressed and checks it against a keylist
# if just "enter" is pressed, the default value will be filled in
#
# syntax:
#
#   readkey_list($keylist,$default_answer);
#
#      $keylist           List of valid characters
#      $default_answer    the default character
#
#   returns the first valid key pressed
#
sub readkey_list {
  my $list=lc shift;
  my $default=lc shift;
  my $input="";
  print " > ";
  while ($input eq "") {
    $input=lc readkey();
    chomp $input;
    print "$input\n";
    if ($input eq "") { $input=$default; }
    elsif (index($list,$input) < 0 ) { print "please answer [$list] > "; $input=""; }
    }
  return $input;
  }


######################################################################
#
# ask yes/no question and wait for user input.
#
# syntax:
#
#   askyesno($question,$default_answer);
#
#      $question         raw question to be asked without final "?"
#      $default_answer   either "y" or "n"  (default: "y")
#
#   returns either "y" or "n".
#
sub askyesno {
  my $string=shift;
  my $default=lc shift;
  my $input="";
  if ($default eq "n") { print "$string? (y/N)"; }
  else { print "$string? (Y/n)"; $default="y"; }
  return readkey_list("yn",$default);
  }



######################################################################
#
# let the user choose one item from a list.
#
# syntax:
#
#   $result=choose($currentvalue,$errormessage,@items)
#
#     $currentvalue   the currently selected item
#
#     $errormessage   error that will be printed when @items is empty
#
#     @items          arry that contains all items to choose from
#
#
#  If $currentvalue is an element of @items, $currentvalue will be
#  returned by default, without user-interaction.
#
#  To force interaction set $currentvalue to something NOT in @list
#
sub choose {
  my ($value,$errormsg,@ITEMS)=@_;
    
  $ok=0;
  if (@ITEMS) {
    foreach $nn (@ITEMS) {
      chomp $nn;
      if ( $nn eq $value ) { $ok=1; }
      }

    if ($ok == 0) {
      if ($#ITEMS == 0) {
        print "detected: ",$ITEMS[0],"\n";
        $input=HotSaNICshellio::askyesno("is this corrrect","y");
        if ($input eq "y") { $ok=1; $value=$ITEMS[0]; }
        }
      else {
        print "select one of these items:\n";
        $pos=0;
        foreach $nn (@ITEMS) {
          chomp $nn;
          printf "%5i  $nn\n",$pos++;
          }
        $input=-1;
        print "by just pressing <ENTER>, item \"0\" will be selected.\n";
        print "select item 0 ... ",($pos-1),"? > ";
        while ( $input < 0) {
          if ($pos<10) { $input=lc readkey(); print "$input\n"; }
          else { $input=<STDIN>; }
          chomp $input;
          if ($input eq "") { $input=0; }
          elsif ($input!~ /^[0-9]+$/) {
            print "please enter a positive number! > " if $pos>9;
            $input=-1;
            }
          elsif ($input >= $pos) {
            print "input has to be between 0 and ",($pos-1),"! > " if $pos >9;
            $input=-1;
            }
          }
        $value=$ITEMS[$input];
        }
      }
    }
  else { print "\nERROR: $errormsg\n\n"; }
  return $value;
  }
    
sub cls {
  system "tput clear";
  }

sub goto {
  my $x=shift || 0;
  my $y=shift || 0;
  system "tput cup $x $y";
  }


######################################################################
#
# prints a table at the given position. If the terminal supports
# ANSI colors, it will be printed on blue background.
#
# usage:
#   table($x,$y,$head,@lines);
#
sub table {
  my $x=shift || 0;
  my $y=shift || 0;
  my $head=shift || "";
  my @lines=@_;

# require Curses;
# $win=new Curses;

  my $maxlen=length($head);
  for (@lines) {
    my $len=length($_);
    if ($maxlen < $len) { $maxlen=$len; }
    }

  HotSaNICshellio::goto($x++,$y);
  setattr("BG_BLUE","FG_WHITE","UNDERLINE");
  printf "%-".$maxlen."s",$head;
  setattr("NORMAL","BG_BLUE");
  for (@lines) {
#   $win -> addstr($x++,$y,$_);
  HotSaNICshellio::goto($x++,$y);
    printf "%-".$maxlen."s",$_;
    }
  setattr("NORMAL");
  print "\n";

# $win -> refresh();

  }

sub setattr {
  my $line="";
  my %ATTR=(
    "BG_BLACK"=>"setab 0","FG_BLACK"=>"setaf 0",
    "BG_RED"=>"setab 1","FG_RED"=>"setaf 1",
    "BG_GREEN"=>"setab 2","FG_GREEN"=>"setaf 2",
    "BG_YELLOW"=>"setab 3","FG_YELLOW"=>"setaf 3",
    "BG_BLUE"=>"setab 4","FG_BLUE"=>"setaf 4",
    "BG_MAGENTA"=>"setab 5","FG_MAGENTA"=>"setaf 5",
    "BG_CYAN"=>"setab 6","FG_CYAN"=>"setaf 6",
    "BG_WHITE"=>"setab 7","FG_WHITE"=>"setaf 7",
    "BOLD"=>"bold","DIM"=>"dim",
    "UNDERLINE"=>"smul","NO_UNDERLINE"=>"rmul",
    "NORMAL"=>"sgr0"
    );
  for (@_) {
    if ( defined $ATTR{$_} ) { $line=$line."\n".$ATTR{$_}; }
    }
  if ($line eq "") { $line="setab 0\nsetaf 7\ndim\n"; }
  system "tput -S<<EOF$line\nEOF";
  }

# Colour Capabilities
#   tput setab [1-7]         Set a background colour using ANSI escape
#   tput setb [1-7]          Set a background colour
#   tput setaf [1-7]         Set a foreground colour using ANSI escape
#   tput setf [1-7]          Set a foreground colour
#
# Text Mode Capabilities
#   tput bold    Set bold mode
#   tput dim     turn on half-bright mode
#   tput smul    begin underline mode
#   tput rmul    exit underline mode
#   tput rev     Turn on reverse mode
#   tput smso    Enter standout mode (bold on rxvt)
#   tput rmso    Exit standout mode
#   tput sgr0    Turn off all attributes (doesn't work quite as expected)
#
# Cursor Movement Capabilities
#   tput cup Y X   Move cursor to screen location X,Y (top left is 0,0)
#   tput sc        Save the cursor position
#   tput rc        Restore the cursor position
#   tput lines     Output the number of lines of the terminal
#   tput cols      Output the number of columns of the terminal
#   tput cub N     Move N characters left
#   tput cuf N     Move N characters right
#   tput cub1      move left one space
#   tput cuf1      non-destructive space (move right one space)
#   tput ll        last line, first column (if no cup)
#   tput cuu1      up one line
#
# Clear and Insert Capabilities
#   tput ech N   Erase N characters
#   tput clear   clear screen and home cursor
#   tput el1     Clear to beginning of line
#   tput el      clear to end of line
#   tput ed      clear to end of screen
#   tput ich N   insert N characters (moves rest of line forward!)
#   tput il N    insert N lines
#
#  see:
#
#    http://www.gnu.org/manual/termutils-2.0/html_chapter/tput_toc.html#TOC8
#    http://www.linuxgazette.com/issue65/padala.html

######################################################################
#
# disables all output and expects one keystroke.
# (found in perlfaq5 man-page)
#
# usage:  $key=readkey();
#
# Compatibility: Linux and Solaris seem to work fine.
#
sub readkey {
  my $key = '';
  cbreak();
  sysread(STDIN, $key, 1);
  cooked();
  return $key;
  }

######################################################################
#
# local echo off
#
sub cbreak {
  $term->setlflag($noecho);
  $term->setcc(VTIME, 1);
  $term->setattr($fd_stdin, TCSANOW);
  }

######################################################################
#
# local echo on
#
sub cooked {
  $term->setlflag($oterm);
  $term->setcc(VTIME, 0);
  $term->setattr($fd_stdin, TCSANOW);
  }

######################################################################
#
# clear screen
#
sub clear {
  print $CLS;
  }

1;