jablonka.czprosek.czf

hotsanic

 Subversion Repositories:
[/] [trunk/] [lib/] [HotSaNICshellio.pm] - Blame information for rev 1

 

Line No. Rev Author Line
11simandl#
2# $Id: HotSaNICshellio.pm,v 1.10 2004/02/07 23:03:11 bernisys Exp $
3#
4 
5package HotSaNICshellio;
6 
7($VERSION = '$Revision: 1.10 $') =~ s/.*(\d+\.\d+).*/$1/;
8 
9use POSIX qw(:termios_h);
10 
11my ($term, $oterm, $echo, $noecho, $fd_stdin);
12 
13$fd_stdin = fileno(STDIN);
14 
15$term = POSIX::Termios->new();
16$term->getattr($fd_stdin);
17$oterm = $term->getlflag();
18 
19$echo = ECHO | ECHOK | ICANON;
20$noecho = $oterm & ~$echo;
21 
22open FILE,"clear|";
23$CLS=<FILE>;
24close FILE;
25 
26 
27######################################################################
28#
29# waits for a key to be pressed and checks it against a keylist
30# if just "enter" is pressed, the default value will be filled in
31#
32# syntax:
33#
34# readkey_list($keylist,$default_answer);
35#
36# $keylist List of valid characters
37# $default_answer the default character
38#
39# returns the first valid key pressed
40#
41sub readkey_list {
42 my $list=lc shift;
43 my $default=lc shift;
44 my $input="";
45 print " > ";
46 while ($input eq "") {
47 $input=lc readkey();
48 chomp $input;
49 print "$input\n";
50 if ($input eq "") { $input=$default; }
51 elsif (index($list,$input) < 0 ) { print "please answer [$list] > "; $input=""; }
52 }
53 return $input;
54 }
55 
56 
57######################################################################
58#
59# ask yes/no question and wait for user input.
60#
61# syntax:
62#
63# askyesno($question,$default_answer);
64#
65# $question raw question to be asked without final "?"
66# $default_answer either "y" or "n" (default: "y")
67#
68# returns either "y" or "n".
69#
70sub askyesno {
71 my $string=shift;
72 my $default=lc shift;
73 my $input="";
74 if ($default eq "n") { print "$string? (y/N)"; }
75 else { print "$string? (Y/n)"; $default="y"; }
76 return readkey_list("yn",$default);
77 }
78 
79 
80 
81######################################################################
82#
83# let the user choose one item from a list.
84#
85# syntax:
86#
87# $result=choose($currentvalue,$errormessage,@items)
88#
89# $currentvalue the currently selected item
90#
91# $errormessage error that will be printed when @items is empty
92#
93# @items arry that contains all items to choose from
94#
95#
96# If $currentvalue is an element of @items, $currentvalue will be
97# returned by default, without user-interaction.
98#
99# To force interaction set $currentvalue to something NOT in @list
100#
101sub choose {
102 my ($value,$errormsg,@ITEMS)=@_;
103 
104 $ok=0;
105 if (@ITEMS) {
106 foreach $nn (@ITEMS) {
107 chomp $nn;
108 if ( $nn eq $value ) { $ok=1; }
109 }
110 
111 if ($ok == 0) {
112 if ($#ITEMS == 0) {
113 print "detected: ",$ITEMS[0],"\n";
114 $input=HotSaNICshellio::askyesno("is this corrrect","y");
115 if ($input eq "y") { $ok=1; $value=$ITEMS[0]; }
116 }
117 else {
118 print "select one of these items:\n";
119 $pos=0;
120 foreach $nn (@ITEMS) {
121 chomp $nn;
122 printf "%5i $nn\n",$pos++;
123 }
124 $input=-1;
125 print "by just pressing ´ENTER´, item \"0\" will be selected.\n";
126 print "select item 0 ... ",($pos-1),"? > ";
127 while ( $input < 0) {
128 if ($pos<10) { $input=lc readkey(); print "$input\n"; }
129 else { $input=<STDIN>; }
130 chomp $input;
131 if ($input eq "") { $input=0; }
132 elsif ($input!~ /^[0-9]+$/) {
133 print "please enter a positive number! > " if $pos>9;
134 $input=-1;
135 }
136 elsif ($input >= $pos) {
137 print "input has to be between 0 and ",($pos-1),"! > " if $pos >9;
138 $input=-1;
139 }
140 }
141 $value=$ITEMS[$input];
142 }
143 }
144 }
145 else { print "\nERROR: $errormsg\n\n"; }
146 return $value;
147 }
148 
149sub cls {
150 system "tput clear";
151 }
152 
153sub goto {
154 my $x=shift || 0;
155 my $y=shift || 0;
156 system "tput cup $x $y";
157 }
158 
159 
160######################################################################
161#
162# prints a table at the given position. If the terminal supports
163# ANSI colors, it will be printed on blue background.
164#
165# usage:
166# table($x,$y,$head,@lines);
167#
168sub table {
169 my $x=shift || 0;
170 my $y=shift || 0;
171 my $head=shift || "";
172 my @lines=@_;
173 
174# require Curses;
175# $win=new Curses;
176 
177 my $maxlen=length($head);
178 for (@lines) {
179 my $len=length($_);
180 if ($maxlen < $len) { $maxlen=$len; }
181 }
182 
183 HotSaNICshellio::goto($x++,$y);
184 setattr("BG_BLUE","FG_WHITE","UNDERLINE");
185 printf "%-".$maxlen."s",$head;
186 setattr("NORMAL","BG_BLUE");
187 for (@lines) {
188# $win -> addstr($x++,$y,$_);
189 HotSaNICshellio::goto($x++,$y);
190 printf "%-".$maxlen."s",$_;
191 }
192 setattr("NORMAL");
193 print "\n";
194 
195# $win -> refresh();
196 
197 }
198 
199sub setattr {
200 my $line="";
201 my %ATTR=(
202 "BG_BLACK"=>"setab 0","FG_BLACK"=>"setaf 0",
203 "BG_RED"=>"setab 1","FG_RED"=>"setaf 1",
204 "BG_GREEN"=>"setab 2","FG_GREEN"=>"setaf 2",
205 "BG_YELLOW"=>"setab 3","FG_YELLOW"=>"setaf 3",
206 "BG_BLUE"=>"setab 4","FG_BLUE"=>"setaf 4",
207 "BG_MAGENTA"=>"setab 5","FG_MAGENTA"=>"setaf 5",
208 "BG_CYAN"=>"setab 6","FG_CYAN"=>"setaf 6",
209 "BG_WHITE"=>"setab 7","FG_WHITE"=>"setaf 7",
210 "BOLD"=>"bold","DIM"=>"dim",
211 "UNDERLINE"=>"smul","NO_UNDERLINE"=>"rmul",
212 "NORMAL"=>"sgr0"
213 );
214 for (@_) {
215 if ( defined $ATTR{$_} ) { $line=$line."\n".$ATTR{$_}; }
216 }
217 if ($line eq "") { $line="setab 0\nsetaf 7\ndim\n"; }
218 system "tput -S<<EOF$line\nEOF";
219 }
220 
221# Colour Capabilities
222# tput setab [1-7] Set a background colour using ANSI escape
223# tput setb [1-7] Set a background colour
224# tput setaf [1-7] Set a foreground colour using ANSI escape
225# tput setf [1-7] Set a foreground colour
226#
227# Text Mode Capabilities
228# tput bold Set bold mode
229# tput dim turn on half-bright mode
230# tput smul begin underline mode
231# tput rmul exit underline mode
232# tput rev Turn on reverse mode
233# tput smso Enter standout mode (bold on rxvt)
234# tput rmso Exit standout mode
235# tput sgr0 Turn off all attributes (doesn't work quite as expected)
236#
237# Cursor Movement Capabilities
238# tput cup Y X Move cursor to screen location X,Y (top left is 0,0)
239# tput sc Save the cursor position
240# tput rc Restore the cursor position
241# tput lines Output the number of lines of the terminal
242# tput cols Output the number of columns of the terminal
243# tput cub N Move N characters left
244# tput cuf N Move N characters right
245# tput cub1 move left one space
246# tput cuf1 non-destructive space (move right one space)
247# tput ll last line, first column (if no cup)
248# tput cuu1 up one line
249#
250# Clear and Insert Capabilities
251# tput ech N Erase N characters
252# tput clear clear screen and home cursor
253# tput el1 Clear to beginning of line
254# tput el clear to end of line
255# tput ed clear to end of screen
256# tput ich N insert N characters (moves rest of line forward!)
257# tput il N insert N lines
258#
259# see:
260#
261# http://www.gnu.org/manual/termutils-2.0/html_chapter/tput_toc.html#TOC8
262# http://www.linuxgazette.com/issue65/padala.html
263 
264######################################################################
265#
266# disables all output and expects one keystroke.
267# (found in perlfaq5 man-page)
268#
269# usage: $key=readkey();
270#
271# Compatibility: Linux and Solaris seem to work fine.
272#
273sub readkey {
274 my $key = '';
275 cbreak();
276 sysread(STDIN, $key, 1);
277 cooked();
278 return $key;
279 }
280 
281######################################################################
282#
283# local echo off
284#
285sub cbreak {
286 $term->setlflag($noecho);
287 $term->setcc(VTIME, 1);
288 $term->setattr($fd_stdin, TCSANOW);
289 }
290 
291######################################################################
292#
293# local echo on
294#
295sub cooked {
296 $term->setlflag($oterm);
297 $term->setcc(VTIME, 0);
298 $term->setattr($fd_stdin, TCSANOW);
299 }
300 
301######################################################################
302#
303# clear screen
304#
305sub clear {
306 print $CLS;
307 }
308 
3091;

Powered by WebSVN 2.2.1