Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | #!/usr/bin/perl |
2 | require 5; | |
3 | ||
4 | package IO::Stty; | |
5 | ||
6 | use POSIX; | |
7 | ||
8 | $IO::Stty::VERSION='.02'; | |
9 | ||
10 | ||
11 | sub stty { | |
12 | # I'm not feeling very inspired about this. Terminal parameters are obscure | |
13 | # and boring. Basically what this will do is get the current setting, | |
14 | # take the parameters, modify the setting and write it back. Zzzz. | |
15 | # This is not especially efficent and probably not too fast. Assuming the POSIX | |
16 | # spec has been implemented properly it should mostly work. | |
17 | # Version info | |
18 | if ($_[1] eq '-v' || $_[1] =~ /version/ ) { | |
19 | return $IO::Stty::VERSION."\n"; | |
20 | } | |
21 | my ($tty_handle)=shift; # This should be a \*HANDLE | |
22 | my (@parameters); | |
23 | my($parameter); | |
24 | # Build the 'this really means this' cases. | |
25 | foreach $parameter (@_) { | |
26 | if($parameter eq 'ek') { | |
27 | push (@parameters,'erase',8,'kill',21); | |
28 | next; | |
29 | } | |
30 | if($parameter eq 'sane') { | |
31 | push (@parameters,'cread','-ignbrk','brkint','-inlcr','-igncr','icrnl', | |
32 | '-ixoff','opost','isig','icanon','iexten','echo','echoe','echok', | |
33 | '-echonl','-noflsh','-tostop','echok','intr',3,'quit',28,'erase', | |
34 | 8,'kill',21,'eof',4,'eol',0,'stop',19,'start',17,'susp',26, | |
35 | 'time',0,'min',0 ); | |
36 | next; | |
37 | # Ugh. | |
38 | } | |
39 | if($parameter eq 'cooked' || $parameter eq '-raw') { | |
40 | # Is this right? | |
41 | push (@parameters,'brkint','ignpar','istrip','icrnl','ixon','opost', | |
42 | 'isig','icanon'); | |
43 | push (@parameters,'intr',3,'quit',28,'erase',8,'kill',21,'eof', | |
44 | 4,'eol',0,'stop',19,'start',17,'susp',26,'time',0,'min',0); | |
45 | next; | |
46 | } | |
47 | if($parameter eq 'raw' || $parameter eq '-cooked') { | |
48 | push (@parameters,'-ignbrk','-brkint','-ignpar','-parmrk','-inpck', | |
49 | '-istrip','-inlcr','-igncr','-icrnl','-ixon','-ixoff', | |
50 | '-opost','-isig','-icanon','min',1,'time',0 ); | |
51 | next; | |
52 | } | |
53 | if($parameter eq 'pass8') { | |
54 | push (@parameters,'-parenb','-istrip','cs8'); | |
55 | next; | |
56 | } | |
57 | if($parameter eq '-pass8') { | |
58 | push (@parameters,'parenb','istrip','cs7'); | |
59 | next; | |
60 | } | |
61 | if($parameter eq 'crt') { | |
62 | push (@parameters,'echoe','echok'); | |
63 | next; | |
64 | } | |
65 | if($parameter eq 'dec') { | |
66 | # 127 == delete, no? | |
67 | push (@parameters,'echoe','echok','intr',3,'erase', 127,'kill',21); | |
68 | next; | |
69 | } | |
70 | if($parameter =~ /^\d+$/) { | |
71 | push (@parameters,'ispeed',$parameter,'ospeed',$parameter); | |
72 | next; | |
73 | } | |
74 | push (@parameters,$parameter); | |
75 | } | |
76 | ||
77 | ||
78 | # Notice fileno() instead of handle->fileno(). I want it to work with | |
79 | # normal fhs. | |
80 | my ($file_num) = fileno($tty_handle); | |
81 | # Is it a terminal? | |
82 | return undef unless isatty($file_num); | |
83 | my($tty_name) = ttyname($file_num); | |
84 | # make a terminal object. | |
85 | my($termios)= POSIX::Termios->new(); | |
86 | $termios->getattr($file_num) || warn "Couldn't get terminal parameters for '$tty_name', fine num ($file_num)"; | |
87 | my($c_cflag) = $termios->getcflag; | |
88 | my($c_iflag) = $termios->getiflag; | |
89 | my($ispeed) = $termios->getispeed; | |
90 | my($c_lflag) = $termios->getlflag; | |
91 | my($c_oflag) = $termios->getoflag; | |
92 | my($ospeed) = $termios->getospeed; | |
93 | my(%control_chars); | |
94 | $control_chars{'INTR'}=$termios->getcc(VINTR); | |
95 | $control_chars{'QUIT'}=$termios->getcc(VQUIT); | |
96 | $control_chars{'ERASE'}=$termios->getcc(VERASE); | |
97 | $control_chars{'KILL'}=$termios->getcc(VKILL); | |
98 | $control_chars{'EOF'}=$termios->getcc(VEOF); | |
99 | $control_chars{'TIME'}=$termios->getcc(VTIME); | |
100 | $control_chars{'MIN'}=$termios->getcc(VMIN); | |
101 | $control_chars{'START'}=$termios->getcc(VSTART); | |
102 | $control_chars{'STOP'}=$termios->getcc(VSTOP); | |
103 | $control_chars{'SUSP'}=$termios->getcc(VSUSP); | |
104 | $control_chars{'EOL'}=$termios->getcc(VEOL); | |
105 | # OK.. we have our crap. | |
106 | # Do we want to know what the crap is? | |
107 | if($parameters[0] eq '-a') { | |
108 | return show_me_the_crap ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag, | |
109 | $ospeed,\%control_chars); | |
110 | } | |
111 | # did we get the '-g' flag? | |
112 | if($parameters[0] eq '-g') { | |
113 | return "$c_cflag:$c_iflag:$ispeed:$c_lflag:$c_oflag:$ospeed:". | |
114 | $control_chars{'INTR'}.":". | |
115 | $control_chars{'QUIT'}.":". | |
116 | $control_chars{'ERASE'}.":". | |
117 | $control_chars{'KILL'}.":". | |
118 | $control_chars{'EOF'}.":". | |
119 | $control_chars{'TIME'}.":". | |
120 | $control_chars{'MIN'}.":". | |
121 | $control_chars{'START'}.":". | |
122 | $control_chars{'STOP'}.":". | |
123 | $control_chars{'SUSP'}.":". | |
124 | $control_chars{'EOL'}; | |
125 | } | |
126 | # Or the converse.. -g used before and we're getting the return. | |
127 | # Note that this uses the functionality of stty -g, not any specific | |
128 | # method. Don't take the output here and feed it to the OS stty. | |
129 | ||
130 | # This will make perl -w happy. | |
131 | my(@useless_var) = split(':',$parameters[0]); | |
132 | if (@useless_var == 17) { | |
133 | # print "Feeding back...\n"; | |
134 | @parameters = split(':',$parameters[0]); | |
135 | ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag,$ospeed)=(@parameters); | |
136 | $control_chars{'INTR'}=$parameters[6]; | |
137 | $control_chars{'QUIT'}=$parameters[7]; | |
138 | $control_chars{'ERASE'}=$parameters[8]; | |
139 | $control_chars{'KILL'}=$parameters[9]; | |
140 | $control_chars{'EOF'}=$parameters[10]; | |
141 | $control_chars{'TIME'}=$parameters[11]; | |
142 | $control_chars{'MIN'}=$parameters[12]; | |
143 | $control_chars{'START'}=$parameters[13]; | |
144 | $control_chars{'STOP'}=$parameters[14]; | |
145 | $control_chars{'SUSP'}=$parameters[15]; | |
146 | $control_chars{'EOL'}=$parameters[16]; | |
147 | @parameters=(); # Unset so while loop is passed. | |
148 | } | |
149 | # So.. what shall we set? | |
150 | my($set_value); | |
151 | while ($parameter = shift(@parameters)) { | |
152 | # print "Param:$parameter:\n"; | |
153 | $set_value = 1; # On by default... | |
154 | # unset if starts w/ -, as in -crtscts | |
155 | $set_value = 0 if $parameter=~ s/^\-//; | |
156 | # Now the fun part. | |
157 | ||
158 | # c_cc field crap. | |
159 | if ($parameter eq 'intr') { $control_chars{'INTR'} = shift @parameters; next;} | |
160 | if ($parameter eq 'quit') { $control_chars{'QUIT'} = shift @parameters; next;} | |
161 | if ($parameter eq 'erase') { $control_chars{'ERASE'} = shift @parameters; next;} | |
162 | if ($parameter eq 'kill') { $control_chars{'KILL'} = shift @parameters; next;} | |
163 | if ($parameter eq 'eof') { $control_chars{'EOF'} = shift @parameters; next;} | |
164 | if ($parameter eq 'eol') { $control_chars{'EOL'} = shift @parameters; next;} | |
165 | if ($parameter eq 'start') { $control_chars{'START'} = shift @parameters; next;} | |
166 | if ($parameter eq 'stop') { $control_chars{'STOP'} = shift @parameters; next;} | |
167 | if ($parameter eq 'susp') { $control_chars{'SUSP'} = shift @parameters; next;} | |
168 | if ($parameter eq 'min') { $control_chars{'MIN'} = shift @parameters; next;} | |
169 | if ($parameter eq 'time') { $control_chars{'TIME'} = shift @parameters; next;} | |
170 | ||
171 | # c_cflag crap | |
172 | if ($parameter eq 'clocal') { $c_cflag = ($set_value ? ($c_cflag | CLOCAL) : ($c_cflag & (~CLOCAL))); next; } | |
173 | if ($parameter eq 'cread') { $c_cflag = ($set_value ? ($c_cflag | CREAD) : ($c_cflag & (~CREAD))); next; } | |
174 | # As best I can tell, doing |~CS8 will clear the bits.. under solaris | |
175 | # anyway, where CS5 = 0, CS6 = 0x20, CS7= 0x40, CS8=0x60 | |
176 | if ($parameter eq 'cs5') { $c_cflag = (($c_cflag & ~CS8 )| CS5); next; } | |
177 | if ($parameter eq 'cs6') { $c_cflag = (($c_cflag & ~CS8 )| CS6); next; } | |
178 | if ($parameter eq 'cs7') { $c_cflag = (($c_cflag & ~CS8 )| CS7); next; } | |
179 | if ($parameter eq 'cs8') { $c_cflag = ($c_cflag | CS8); next; } | |
180 | if ($parameter eq 'cstopb') { $c_cflag = ($set_value ? ($c_cflag | CSTOPB) : ($c_cflag & (~CSTOPB))); next; } | |
181 | if ($parameter eq 'hupcl' || $parameter eq 'hup') { $c_cflag = ($set_value ? ($c_cflag | HUPCL) : ($c_cflag & (~HUPCL))); next; } | |
182 | if ($parameter eq 'parenb') { $c_cflag = ($set_value ? ($c_cflag | PARENB) : ($c_cflag & (~PARENB))); next; } | |
183 | if ($parameter eq 'parodd') { $c_cflag = ($set_value ? ($c_cflag | PARODD) : ($c_cflag & (~PARODD))); next; } | |
184 | ||
185 | # That was fun. Still awake? c_iflag time. | |
186 | if ($parameter eq 'brkint') { $c_iflag = (($set_value ? ($c_iflag | BRKINT) : ($c_iflag & (~BRKINT)))); next; } | |
187 | if ($parameter eq 'icrnl') { $c_iflag = (($set_value ? ($c_iflag | ICRNL) : ($c_iflag & (~ICRNL)))); next; } | |
188 | if ($parameter eq 'ignbrk') { $c_iflag = (($set_value ? ($c_iflag | IGNBRK) : ($c_iflag & (~IGNBRK)))); next; } | |
189 | if ($parameter eq 'igncr') { $c_iflag = (($set_value ? ($c_iflag | IGNCR) : ($c_iflag & (~IGNCR)))); next; } | |
190 | if ($parameter eq 'ignpar') { $c_iflag = (($set_value ? ($c_iflag | IGNPAR) : ($c_iflag & (~IGNPAR)))); next; } | |
191 | if ($parameter eq 'inlcr') { $c_iflag = (($set_value ? ($c_iflag | INLCR) : ($c_iflag & (~INLCR)))); next; } | |
192 | if ($parameter eq 'inpck') { $c_iflag = (($set_value ? ($c_iflag | INPCK) : ($c_iflag & (~INPCK)))); next; } | |
193 | if ($parameter eq 'istrip') { $c_iflag = (($set_value ? ($c_iflag | ISTRIP) : ($c_iflag & (~ISTRIP)))); next; } | |
194 | if ($parameter eq 'ixoff') { $c_iflag = (($set_value ? ($c_iflag | IXOFF) : ($c_iflag & (~IXOFF)))); next; } | |
195 | if ($parameter eq 'ixon') { $c_iflag = (($set_value ? ($c_iflag | IXON) : ($c_iflag & (~IXON)))); next; } | |
196 | if ($parameter eq 'parmrk') { $c_iflag = (($set_value ? ($c_iflag | PARMRK) : ($c_iflag & (~PARMRK)))); next; } | |
197 | ||
198 | # Are we there yet? No. Are we there yet? No. Are we there yet... | |
199 | # print "Values: $c_lflag,".($c_lflag | ECHO)." ".($c_lflag & (~ECHO))."\n"; | |
200 | if ($parameter eq 'echo') { $c_lflag = (($set_value ? ($c_lflag | ECHO) : ($c_lflag & (~ECHO)))); next; } | |
201 | if ($parameter eq 'echoe') { $c_lflag = (($set_value ? ($c_lflag | ECHOE) : ($c_lflag & (~ECHOE)))); next; } | |
202 | if ($parameter eq 'echok') { $c_lflag = (($set_value ? ($c_lflag | ECHOK) : ($c_lflag & (~ECHOK)))); next; } | |
203 | if ($parameter eq 'echonl') { $c_lflag = (($set_value ? ($c_lflag | ECHONL) : ($c_lflag & (~ECHONL)))); next; } | |
204 | if ($parameter eq 'icanon') { $c_lflag = (($set_value ? ($c_lflag | ICANON) : ($c_lflag & (~ICANON)))); next; } | |
205 | if ($parameter eq 'iexten') { $c_lflag = (($set_value ? ($c_lflag | IEXTEN) : ($c_lflag & (~IEXTEN)))); next; } | |
206 | if ($parameter eq 'isig') { $c_lflag = (($set_value ? ($c_lflag | ISIG) : ($c_lflag & (~ISIG)))); next; } | |
207 | if ($parameter eq 'noflsh') { $c_lflag = (($set_value ? ($c_lflag | NOFLSH) : ($c_lflag & (~NOFLSH)))); next; } | |
208 | if ($parameter eq 'tostop') { $c_lflag = (($set_value ? ($c_lflag | TOSTOP) : ($c_lflag & (~TOSTOP)))); next; } | |
209 | ||
210 | # Make it stop! Make it stop! | |
211 | # c_oflag crap. | |
212 | if ($parameter eq 'opost') { $c_oflag = (($set_value ? ($c_oflag | OPOST) : ($c_oflag & (~OPOST)))); next; } | |
213 | ||
214 | # Speed? | |
215 | if ($parameter eq 'ospeed') { $ospeed = &{"POSIX::B".shift(@parameters)}; next; } | |
216 | if ($parameter eq 'ispeed') { $ispeed = &{"POSIX::B".shift(@parameters)}; next; } | |
217 | # Default.. parameter hasn't matched anything | |
218 | # print "char:".sprintf("%lo",ord($parameter))."\n"; | |
219 | warn "IO::Stty::stty passed invalid parameter '$parameter'\n"; | |
220 | } | |
221 | ||
222 | # What a pain in the ass! Ok.. let's write the crap back. | |
223 | $termios->setcflag($c_cflag); | |
224 | $termios->setiflag($c_iflag); | |
225 | $termios->setispeed($ispeed); | |
226 | $termios->setlflag($c_lflag); | |
227 | $termios->setoflag($c_oflag); | |
228 | $termios->setospeed($ospeed); | |
229 | $termios->setcc(VINTR,$control_chars{'INTR'}); | |
230 | $termios->setcc(VQUIT,$control_chars{'QUIT'}); | |
231 | $termios->setcc(VERASE,$control_chars{'ERASE'}); | |
232 | $termios->setcc(VKILL,$control_chars{'KILL'}); | |
233 | $termios->setcc(VEOF,$control_chars{'EOF'}); | |
234 | $termios->setcc(VTIME,$control_chars{'TIME'}); | |
235 | $termios->setcc(VMIN,$control_chars{'MIN'}); | |
236 | $termios->setcc(VSTART,$control_chars{'START'}); | |
237 | $termios->setcc(VSTOP,$control_chars{'STOP'}); | |
238 | $termios->setcc(VSUSP,$control_chars{'SUSP'}); | |
239 | $termios->setcc(VEOL,$control_chars{'EOL'}); | |
240 | $termios->setattr($file_num,TCSANOW); # TCSANOW = do immediately. don't unbuffer first. | |
241 | # OK.. that sucked. | |
242 | } | |
243 | ||
244 | sub show_me_the_crap { | |
245 | my ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag, | |
246 | $ospeed,$control_chars) = @_; | |
247 | my(%cc) = %$control_chars; | |
248 | # rs = return string | |
249 | my($rs)=''; | |
250 | $rs .= 'speed '; | |
251 | if ($ospeed == B0) { $rs .= 0; } | |
252 | if ($ospeed == B50) { $rs .= 50; } | |
253 | if ($ospeed == B75) { $rs .= 75; } | |
254 | if ($ospeed == B110) { $rs .= 110; } | |
255 | if ($ospeed == B134) { $rs .= 134; } | |
256 | if ($ospeed == B150) { $rs .= 150; } | |
257 | if ($ospeed == B200) { $rs .= 200; } | |
258 | if ($ospeed == B300) { $rs .= 300; } | |
259 | if ($ospeed == B600) { $rs .= 600; } | |
260 | if ($ospeed == B1200) { $rs .= 1200; } | |
261 | if ($ospeed == B1800) { $rs .= 1800; } | |
262 | if ($ospeed == B2400) { $rs .= 2400; } | |
263 | if ($ospeed == B4800) { $rs .= 4800; } | |
264 | if ($ospeed == B9600) { $rs .= 9600; } | |
265 | if ($ospeed == B19200) { $rs .= 19200; } | |
266 | if ($ospeed == B38400) { $rs .= 38400; } | |
267 | $rs .= " baud\n"; | |
268 | $rs .= <<EOM; | |
269 | intr = $cc{'INTR'}; quit = $cc{'QUIT'}; erase = $cc{'ERASE'}; kill = $cc{'KILL'}; | |
270 | eof = $cc{'EOF'}; eol = $cc{'EOL'}; start = $cc{'START'}; stop = $cc{'STOP'}; susp = $cc{'SUSP'}; | |
271 | EOM | |
272 | ; | |
273 | # c flags. | |
274 | $rs .= (($c_cflag & CLOCAL) ? '' : '-' ).'clocal '; | |
275 | $rs .= (($c_cflag & CREAD) ? '' : '-' ).'cread '; | |
276 | $rs .= (($c_cflag & CSTOPB) ? '' : '-' ).'cstopb '; | |
277 | $rs .= (($c_cflag & HUPCL) ? '' : '-' ).'hupcl '; | |
278 | $rs .= (($c_cflag & PARENB) ? '' : '-' ).'parenb '; | |
279 | $rs .= (($c_cflag & PARODD) ? '' : '-' ).'parodd '; | |
280 | $c_cflag = $c_cflag & CS8; | |
281 | if ($c_cflag == CS8) { | |
282 | $rs .= "cs8\n"; | |
283 | } elsif ($c_cflag == CS7) { | |
284 | $rs .= "cs7\n"; | |
285 | } elsif ($c_cflag == CS6) { | |
286 | $rs .= "cs6\n"; | |
287 | } else { | |
288 | $rs .= "cs5\n"; | |
289 | } | |
290 | # l flags. | |
291 | $rs .= (($c_lflag & ECHO) ? '' : '-' ).'echo '; | |
292 | $rs .= (($c_lflag & ECHOE) ? '' : '-' ).'echoe '; | |
293 | $rs .= (($c_lflag & ECHOK) ? '' : '-' ).'echok '; | |
294 | $rs .= (($c_lflag & ECHONL) ? '' : '-' ).'echonl '; | |
295 | $rs .= (($c_lflag & ICANON) ? '' : '-' ).'icanon '; | |
296 | $rs .= (($c_lflag & ISIG) ? '' : '-' ).'isig '; | |
297 | $rs .= (($c_lflag & NOFLSH) ? '' : '-' ).'noflsh '; | |
298 | $rs .= (($c_lflag & TOSTOP) ? '' : '-' ).'tostop '; | |
299 | $rs .= (($c_lflag & IEXTEN) ? '' : '-' ).'iexten '; | |
300 | # o flag. jam it after the l flags so it looks more compact. | |
301 | $rs .= (($c_oflag & OPOST) ? '' : '-' )."opost\n"; | |
302 | # i flags. | |
303 | $rs .= (($c_iflag & BRKINT) ? '' : '-' ).'brkint '; | |
304 | $rs .= (($c_iflag & IGNBRK) ? '' : '-' ).'ignbrk '; | |
305 | $rs .= (($c_iflag & IGNPAR) ? '' : '-' ).'ignpar '; | |
306 | $rs .= (($c_iflag & PARMRK) ? '' : '-' ).'parmrk '; | |
307 | $rs .= (($c_iflag & INPCK) ? '' : '-' ).'inpck '; | |
308 | $rs .= (($c_iflag & ISTRIP) ? '' : '-' ).'istrip '; | |
309 | $rs .= (($c_iflag & INLCR) ? '' : '-' ).'inlcr '; | |
310 | $rs .= (($c_iflag & ICRNL) ? '' : '-' ).'icrnl '; | |
311 | $rs .= (($c_iflag & IXON) ? '' : '-' ).'ixon '; | |
312 | $rs .= (($c_iflag & IXOFF) ? '' : '-' )."ixoff\n"; | |
313 | return $rs; | |
314 | } | |
315 | ||
316 | ||
317 | ||
318 | ||
319 | 1; |