File Coverage

blib/lib/IO/Stty.pm
Criterion Covered Total %
statement 9 315 2.8
branch 0 266 0.0
condition 0 12 0.0
subroutine 3 5 60.0
pod 2 2 100.0
total 14 600 2.3


line stmt bran cond sub pod time code
1             package IO::Stty;
2              
3 1     1   24088 use strict;
  1         2  
  1         37  
4 1     1   5 use warnings;
  1         2  
  1         35  
5              
6 1     1   993 use POSIX;
  1         8199  
  1         6  
7              
8             our $VERSION='0.03';
9              
10             =head1 NAME
11              
12             Change and print terminal line settings
13              
14             =head1 SYNOPSIS
15              
16             # calling the script directly
17             stty.pl [setting...]
18             stty.pl {-a,-g,-v,--version}
19            
20             # Calling Stty module
21             use IO::Stty;
22             IO::Stty::stty(\*TTYHANDLE, @modes);
23              
24             use IO::Stty;
25             $old_mode=IO::Stty::stty(\*STDIN,'-g');
26              
27             # Turn off echoing.
28             IO::Stty::stty(\*STDIN,'-echo');
29              
30             # Do whatever.. grab input maybe?
31             $read_password = <>;
32              
33             # Now restore the old mode.
34             IO::Stty::stty(\*STDIN,$old_mode);
35              
36             # What settings do we have anyway?
37             print IO::Stty::stty(\*STDIN,'-a');
38              
39             =head1 DESCRIPTION
40              
41             This is the PERL POSIX compliant stty.
42              
43             =head1 INTRO
44              
45             This has not been tailored to the IO::File stuff but will work with it as
46             indicated. Before you go futzing with term parameters it's a good idea to grab
47             the current settings and restore them when you finish.
48              
49             stty accepts the following non-option arguments that change aspects of the
50             terminal line operation. A `[-]' before a capability means that it can be
51             turned off by preceding it with a `-'.
52              
53             =head1 stty parameters
54              
55             =head2 Control settings
56              
57             =over 4
58              
59             =item [-]parenb
60              
61             Generate parity bit in output and expect parity bit in input.
62              
63             =item [-]parodd
64              
65             Set odd parity (even with `-').
66              
67             =item cs5 cs6 cs7 cs8
68              
69             Set character size to 5, 6, 7, or 8 bits.
70              
71             =item [-]hupcl [-]hup
72              
73             Send a hangup signal when the last process closes the tty.
74              
75             =item [-]cstopb
76              
77             Use two stop bits per character (one with `-').
78              
79             =item [-]cread
80              
81             Allow input to be received.
82              
83             =item [-]clocal
84              
85             Disable modem control signals.
86              
87             =back
88              
89             =head2 Input settings
90              
91             =over 4
92              
93             =item [-]ignbrk
94              
95             Ignore break characters.
96              
97             =item [-]brkint
98              
99             Breaks cause an interrupt signal.
100              
101             =item [-]ignpar
102              
103             Ignore characters with parity errors.
104              
105             =item [-]parmrk
106              
107             Mark parity errors (with a 255-0-character sequence).
108              
109             =item [-]inpck
110              
111             Enable input parity checking.
112              
113             =item [-]istrip
114              
115             Clear high (8th) bit of input characters.
116              
117             =item [-]inlcr
118              
119             Translate newline to carriage return.
120              
121             =item [-]igncr
122              
123             Ignore carriage return.
124              
125             =item [-]icrnl
126              
127             Translate carriage return to newline.
128              
129             =item [-]ixon
130              
131             Enable XON/XOFF flow control.
132              
133             =item [-]ixoff
134              
135             Enable sending of stop character when the system
136             input buffer is almost full, and start character
137             when it becomes almost empty again.
138              
139             =back
140              
141             =head2 Output settings
142              
143             =over 4
144              
145             =item [-]opost
146              
147             Postprocess output.
148              
149             =back
150              
151             =head2 Local settings
152              
153             =over 4
154              
155             =item [-]isig
156              
157             Enable interrupt, quit, and suspend special characters.
158              
159             =item [-]icanon
160              
161             Enable erase, kill, werase, and rprnt special characters.
162              
163             =item [-]echo
164              
165             Echo input characters.
166              
167             =item [-]echoe, [-]crterase
168              
169             Echo erase characters as backspace-space-backspace.
170              
171             =item [-]echok
172              
173             Echo a newline after a kill character.
174              
175             =item [-]echonl
176              
177             Echo newline even if not echoing other characters.
178              
179             =item [-]noflsh
180              
181             Disable flushing after interrupt and quit special characters.
182              
183             * Though this claims non-posixhood it is supported by the perl POSIX.pm.
184              
185             =item [-]tostop (np)
186              
187             Stop background jobs that try to write to the terminal.
188              
189             =back
190              
191             =head2 Combination settings
192              
193             =over 4
194              
195             =item ek
196              
197             Reset the erase and kill special characters to their default values.
198              
199             =item sane
200              
201             Same as:
202              
203             cread -ignbrk brkint -inlcr -igncr icrnl -ixoff opost
204             isig icanon echo echoe echok -echonl -noflsh -tostop
205              
206             also sets all special characters to their default
207             values.
208              
209             =item [-]cooked
210              
211             Same as:
212              
213             brkint ignpar istrip icrnl ixon opost isig icanon
214              
215             plus sets the eof and eol characters to their default values
216             if they are the same as the min and time characters.
217             With `-', same as raw.
218              
219             =item [-]raw
220              
221             Same as:
222              
223             -ignbrk -brkint -ignpar -parmrk -inpck -istrip -inlcr -igncr
224             -icrnl -ixon -ixoff -opost -isig -icanon min 1 time 0
225              
226             With `-', same as cooked.
227              
228             =item [-]pass8
229              
230             Same as:
231              
232             -parenb -istrip cs8
233              
234             With `-', same as parenb istrip cs7.
235              
236             =item dec
237              
238             Same as:
239              
240             echoe echoctl echoke -ixany
241              
242             Also sets the interrupt special character to Ctrl-C, erase to
243             Del, and kill to Ctrl-U.
244              
245             =back
246              
247             =head2 Special characters
248              
249             The special characters' default values vary from system to
250             system. They are set with the syntax `name value', where
251             the names are listed below and the value can be given
252             either literally, in hat notation (`^c'), or as an integer
253             which may start with `0x' to indicate hexadecimal, `0' to
254             indicate octal, or any other digit to indicate decimal.
255             Giving a value of `^-' or `undef' disables that special
256             character.
257              
258             =over 4
259              
260             =item intr
261              
262             Send an interrupt signal.
263              
264             =item quit
265              
266             Send a quit signal.
267              
268             =item erase
269              
270             Erase the last character typed.
271              
272             =item kill
273              
274             Erase the current line.
275              
276             =item eof
277              
278             Send an end of file (terminate the input).
279              
280             =item eol
281              
282             End the line.
283              
284             =item start
285              
286             Restart the output after stopping it.
287              
288             =item stop
289              
290             Stop the output.
291              
292             =item susp
293              
294             Send a terminal stop signal.
295              
296             =back
297              
298             =head2 Special settings
299              
300             =over 4
301              
302             =item min N
303              
304             Set the minimum number of characters that will satisfy a read
305             until the time value has expired, when -icanon is set.
306              
307             =item time N
308              
309             Set the number of tenths of a second before reads
310             time out if the min number of characters have not
311             been read, when -icanon is set.
312              
313             =item N
314              
315             Set the input and output speeds to N. N can be one
316             of: 0 50 75 110 134 134.5 150 200 300 600 1200 1800
317             2400 4800 9600 19200 38400 exta extb. exta is the
318             same as 19200; extb is the same as 38400. 0 hangs
319             up the line if -clocal is set.
320              
321             =back
322              
323             =head2 OPTIONS
324              
325             =over 4
326              
327             =item -a
328              
329             Print all current settings in human-readable form.
330              
331             =item -g
332              
333             Print all current settings in a form that can be
334             used as an argument to another stty command to
335             restore the current settings.
336              
337             =item -v,--version
338              
339             Print version info.
340              
341             =back
342              
343             =head1 Direct Subroutines
344              
345             =over 4
346              
347             =item B
348              
349             IO::Stty::stty(\*STDIN, @params);
350              
351             From comments:
352              
353             I'm not feeling very inspired about this. Terminal parameters are obscure
354             and boring. Basically what this will do is get the current setting,
355             take the parameters, modify the setting and write it back. Zzzz.
356             This is not especially efficent and probably not too fast. Assuming the POSIX
357             spec has been implemented properly it should mostly work.
358              
359             =cut
360              
361             sub stty {
362 0     0 1   my $tty_handle = shift; # This should be a \*HANDLE
363              
364 0 0         @_ or die("No parameters passed to stty");
365              
366             # Version info
367 0 0 0       if ($_[0] eq '-v' || $_[0] =~ /version/ ) {
368 0           return $IO::Stty::VERSION."\n";
369             }
370            
371            
372              
373 0           my @parameters;
374             my $parameter;
375             # Build the 'this really means this' cases.
376 0           foreach $parameter (@_) {
377 0 0         if($parameter eq 'ek') {
378 0           push (@parameters,'erase',8,'kill',21);
379 0           next;
380             }
381 0 0         if($parameter eq 'sane') {
382 0           push (@parameters,'cread','-ignbrk','brkint','-inlcr','-igncr','icrnl',
383             '-ixoff','opost','isig','icanon','iexten','echo','echoe','echok',
384             '-echonl','-noflsh','-tostop','echok','intr',3,'quit',28,'erase',
385             8,'kill',21,'eof',4,'eol',0,'stop',19,'start',17,'susp',26,
386             'time',0,'min',0 );
387 0           next;
388             # Ugh.
389             }
390 0 0 0       if($parameter eq 'cooked' || $parameter eq '-raw') {
391             # Is this right?
392 0           push (@parameters,'brkint','ignpar','istrip','icrnl','ixon','opost',
393             'isig','icanon');
394 0           push (@parameters,'intr',3,'quit',28,'erase',8,'kill',21,'eof',
395             4,'eol',0,'stop',19,'start',17,'susp',26,'time',0,'min',0);
396 0           next;
397             }
398 0 0 0       if($parameter eq 'raw' || $parameter eq '-cooked') {
399 0           push (@parameters,'-ignbrk','-brkint','-ignpar','-parmrk','-inpck',
400             '-istrip','-inlcr','-igncr','-icrnl','-ixon','-ixoff',
401             '-opost','-isig','-icanon','min',1,'time',0 );
402 0           next;
403             }
404 0 0         if($parameter eq 'pass8') {
405 0           push (@parameters,'-parenb','-istrip','cs8');
406 0           next;
407             }
408 0 0         if($parameter eq '-pass8') {
409 0           push (@parameters,'parenb','istrip','cs7');
410 0           next;
411             }
412 0 0         if($parameter eq 'crt') {
413 0           push (@parameters,'echoe','echok');
414 0           next;
415             }
416 0 0         if($parameter eq 'dec') {
417             # 127 == delete, no?
418 0           push (@parameters,'echoe','echok','intr',3,'erase', 127,'kill',21);
419 0           next;
420             }
421 0 0         if($parameter =~ /^\d+$/) {
422 0           push (@parameters,'ispeed',$parameter,'ospeed',$parameter);
423 0           next;
424             }
425 0           push (@parameters,$parameter);
426             }
427            
428            
429             # Notice fileno() instead of handle->fileno(). I want it to work with
430             # normal fhs.
431 0           my ($file_num) = fileno($tty_handle);
432             # Is it a terminal?
433 0 0         return undef unless isatty($file_num);
434 0           my($tty_name) = ttyname($file_num);
435             # make a terminal object.
436 0           my($termios)= POSIX::Termios->new();
437 0 0         $termios->getattr($file_num) || warn "Couldn't get terminal parameters for '$tty_name', fine num ($file_num)";
438 0           my($c_cflag) = $termios->getcflag;
439 0           my($c_iflag) = $termios->getiflag;
440 0           my($ispeed) = $termios->getispeed;
441 0           my($c_lflag) = $termios->getlflag;
442 0           my($c_oflag) = $termios->getoflag;
443 0           my($ospeed) = $termios->getospeed;
444 0           my(%control_chars);
445 0           $control_chars{'INTR'}=$termios->getcc(VINTR);
446 0           $control_chars{'QUIT'}=$termios->getcc(VQUIT);
447 0           $control_chars{'ERASE'}=$termios->getcc(VERASE);
448 0           $control_chars{'KILL'}=$termios->getcc(VKILL);
449 0           $control_chars{'EOF'}=$termios->getcc(VEOF);
450 0           $control_chars{'TIME'}=$termios->getcc(VTIME);
451 0           $control_chars{'MIN'}=$termios->getcc(VMIN);
452 0           $control_chars{'START'}=$termios->getcc(VSTART);
453 0           $control_chars{'STOP'}=$termios->getcc(VSTOP);
454 0           $control_chars{'SUSP'}=$termios->getcc(VSUSP);
455 0           $control_chars{'EOL'}=$termios->getcc(VEOL);
456             # OK.. we have our crap.
457             # Do we want to know what the crap is?
458 0 0         if($parameters[0] eq '-a') {
459 0           return show_me_the_crap ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag,
460             $ospeed,\%control_chars);
461             }
462             # did we get the '-g' flag?
463 0 0         if($parameters[0] eq '-g') {
464 0           return "$c_cflag:$c_iflag:$ispeed:$c_lflag:$c_oflag:$ospeed:".
465             $control_chars{'INTR'}.":".
466             $control_chars{'QUIT'}.":".
467             $control_chars{'ERASE'}.":".
468             $control_chars{'KILL'}.":".
469             $control_chars{'EOF'}.":".
470             $control_chars{'TIME'}.":".
471             $control_chars{'MIN'}.":".
472             $control_chars{'START'}.":".
473             $control_chars{'STOP'}.":".
474             $control_chars{'SUSP'}.":".
475             $control_chars{'EOL'};
476             }
477             # Or the converse.. -g used before and we're getting the return.
478             # Note that this uses the functionality of stty -g, not any specific
479             # method. Don't take the output here and feed it to the OS stty.
480              
481             # This will make perl -w happy.
482 0           my(@useless_var) = split(':',$parameters[0]);
483 0 0         if (@useless_var == 17) {
484             # print "Feeding back...\n";
485 0           @parameters = split(':',$parameters[0]);
486 0           ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag,$ospeed)=(@parameters);
487 0           $control_chars{'INTR'}=$parameters[6];
488 0           $control_chars{'QUIT'}=$parameters[7];
489 0           $control_chars{'ERASE'}=$parameters[8];
490 0           $control_chars{'KILL'}=$parameters[9];
491 0           $control_chars{'EOF'}=$parameters[10];
492 0           $control_chars{'TIME'}=$parameters[11];
493 0           $control_chars{'MIN'}=$parameters[12];
494 0           $control_chars{'START'}=$parameters[13];
495 0           $control_chars{'STOP'}=$parameters[14];
496 0           $control_chars{'SUSP'}=$parameters[15];
497 0           $control_chars{'EOL'}=$parameters[16];
498 0           @parameters=(); # Unset so while loop is passed.
499             }
500             # So.. what shall we set?
501 0           my($set_value);
502 0           while ($parameter = shift(@parameters)) {
503             # print "Param:$parameter:\n";
504 0           $set_value = 1; # On by default...
505             # unset if starts w/ -, as in -crtscts
506 0 0         $set_value = 0 if $parameter=~ s/^\-//;
507             # Now the fun part.
508            
509             # c_cc field crap.
510 0 0         if ($parameter eq 'intr') { $control_chars{'INTR'} = shift @parameters; next;}
  0            
  0            
511 0 0         if ($parameter eq 'quit') { $control_chars{'QUIT'} = shift @parameters; next;}
  0            
  0            
512 0 0         if ($parameter eq 'erase') { $control_chars{'ERASE'} = shift @parameters; next;}
  0            
  0            
513 0 0         if ($parameter eq 'kill') { $control_chars{'KILL'} = shift @parameters; next;}
  0            
  0            
514 0 0         if ($parameter eq 'eof') { $control_chars{'EOF'} = shift @parameters; next;}
  0            
  0            
515 0 0         if ($parameter eq 'eol') { $control_chars{'EOL'} = shift @parameters; next;}
  0            
  0            
516 0 0         if ($parameter eq 'start') { $control_chars{'START'} = shift @parameters; next;}
  0            
  0            
517 0 0         if ($parameter eq 'stop') { $control_chars{'STOP'} = shift @parameters; next;}
  0            
  0            
518 0 0         if ($parameter eq 'susp') { $control_chars{'SUSP'} = shift @parameters; next;}
  0            
  0            
519 0 0         if ($parameter eq 'min') { $control_chars{'MIN'} = shift @parameters; next;}
  0            
  0            
520 0 0         if ($parameter eq 'time') { $control_chars{'TIME'} = shift @parameters; next;}
  0            
  0            
521              
522             # c_cflag crap
523 0 0         if ($parameter eq 'clocal') { $c_cflag = ($set_value ? ($c_cflag | CLOCAL) : ($c_cflag & (~CLOCAL))); next; }
  0 0          
  0            
524 0 0         if ($parameter eq 'cread') { $c_cflag = ($set_value ? ($c_cflag | CREAD) : ($c_cflag & (~CREAD))); next; }
  0 0          
  0            
525             # As best I can tell, doing |~CS8 will clear the bits.. under solaris
526             # anyway, where CS5 = 0, CS6 = 0x20, CS7= 0x40, CS8=0x60
527 0 0         if ($parameter eq 'cs5') { $c_cflag = (($c_cflag & ~CS8 )| CS5); next; }
  0            
  0            
528 0 0         if ($parameter eq 'cs6') { $c_cflag = (($c_cflag & ~CS8 )| CS6); next; }
  0            
  0            
529 0 0         if ($parameter eq 'cs7') { $c_cflag = (($c_cflag & ~CS8 )| CS7); next; }
  0            
  0            
530 0 0         if ($parameter eq 'cs8') { $c_cflag = ($c_cflag | CS8); next; }
  0            
  0            
531 0 0         if ($parameter eq 'cstopb') { $c_cflag = ($set_value ? ($c_cflag | CSTOPB) : ($c_cflag & (~CSTOPB))); next; }
  0 0          
  0            
532 0 0 0       if ($parameter eq 'hupcl' || $parameter eq 'hup') { $c_cflag = ($set_value ? ($c_cflag | HUPCL) : ($c_cflag & (~HUPCL))); next; }
  0 0          
  0            
533 0 0         if ($parameter eq 'parenb') { $c_cflag = ($set_value ? ($c_cflag | PARENB) : ($c_cflag & (~PARENB))); next; }
  0 0          
  0            
534 0 0         if ($parameter eq 'parodd') { $c_cflag = ($set_value ? ($c_cflag | PARODD) : ($c_cflag & (~PARODD))); next; }
  0 0          
  0            
535              
536             # That was fun. Still awake? c_iflag time.
537 0 0         if ($parameter eq 'brkint') { $c_iflag = (($set_value ? ($c_iflag | BRKINT) : ($c_iflag & (~BRKINT)))); next; }
  0 0          
  0            
538 0 0         if ($parameter eq 'icrnl') { $c_iflag = (($set_value ? ($c_iflag | ICRNL) : ($c_iflag & (~ICRNL)))); next; }
  0 0          
  0            
539 0 0         if ($parameter eq 'ignbrk') { $c_iflag = (($set_value ? ($c_iflag | IGNBRK) : ($c_iflag & (~IGNBRK)))); next; }
  0 0          
  0            
540 0 0         if ($parameter eq 'igncr') { $c_iflag = (($set_value ? ($c_iflag | IGNCR) : ($c_iflag & (~IGNCR)))); next; }
  0 0          
  0            
541 0 0         if ($parameter eq 'ignpar') { $c_iflag = (($set_value ? ($c_iflag | IGNPAR) : ($c_iflag & (~IGNPAR)))); next; }
  0 0          
  0            
542 0 0         if ($parameter eq 'inlcr') { $c_iflag = (($set_value ? ($c_iflag | INLCR) : ($c_iflag & (~INLCR)))); next; }
  0 0          
  0            
543 0 0         if ($parameter eq 'inpck') { $c_iflag = (($set_value ? ($c_iflag | INPCK) : ($c_iflag & (~INPCK)))); next; }
  0 0          
  0            
544 0 0         if ($parameter eq 'istrip') { $c_iflag = (($set_value ? ($c_iflag | ISTRIP) : ($c_iflag & (~ISTRIP)))); next; }
  0 0          
  0            
545 0 0         if ($parameter eq 'ixoff') { $c_iflag = (($set_value ? ($c_iflag | IXOFF) : ($c_iflag & (~IXOFF)))); next; }
  0 0          
  0            
546 0 0         if ($parameter eq 'ixon') { $c_iflag = (($set_value ? ($c_iflag | IXON) : ($c_iflag & (~IXON)))); next; }
  0 0          
  0            
547 0 0         if ($parameter eq 'parmrk') { $c_iflag = (($set_value ? ($c_iflag | PARMRK) : ($c_iflag & (~PARMRK)))); next; }
  0 0          
  0            
548            
549             # Are we there yet? No. Are we there yet? No. Are we there yet...
550             # print "Values: $c_lflag,".($c_lflag | ECHO)." ".($c_lflag & (~ECHO))."\n";
551 0 0         if ($parameter eq 'echo') { $c_lflag = (($set_value ? ($c_lflag | ECHO) : ($c_lflag & (~ECHO)))); next; }
  0 0          
  0            
552 0 0         if ($parameter eq 'echoe') { $c_lflag = (($set_value ? ($c_lflag | ECHOE) : ($c_lflag & (~ECHOE)))); next; }
  0 0          
  0            
553 0 0         if ($parameter eq 'echok') { $c_lflag = (($set_value ? ($c_lflag | ECHOK) : ($c_lflag & (~ECHOK)))); next; }
  0 0          
  0            
554 0 0         if ($parameter eq 'echonl') { $c_lflag = (($set_value ? ($c_lflag | ECHONL) : ($c_lflag & (~ECHONL)))); next; }
  0 0          
  0            
555 0 0         if ($parameter eq 'icanon') { $c_lflag = (($set_value ? ($c_lflag | ICANON) : ($c_lflag & (~ICANON)))); next; }
  0 0          
  0            
556 0 0         if ($parameter eq 'iexten') { $c_lflag = (($set_value ? ($c_lflag | IEXTEN) : ($c_lflag & (~IEXTEN)))); next; }
  0 0          
  0            
557 0 0         if ($parameter eq 'isig') { $c_lflag = (($set_value ? ($c_lflag | ISIG) : ($c_lflag & (~ISIG)))); next; }
  0 0          
  0            
558 0 0         if ($parameter eq 'noflsh') { $c_lflag = (($set_value ? ($c_lflag | NOFLSH) : ($c_lflag & (~NOFLSH)))); next; }
  0 0          
  0            
559 0 0         if ($parameter eq 'tostop') { $c_lflag = (($set_value ? ($c_lflag | TOSTOP) : ($c_lflag & (~TOSTOP)))); next; }
  0 0          
  0            
560              
561             # Make it stop! Make it stop!
562             # c_oflag crap.
563 0 0         if ($parameter eq 'opost') { $c_oflag = (($set_value ? ($c_oflag | OPOST) : ($c_oflag & (~OPOST)))); next; }
  0 0          
  0            
564            
565             # Speed?
566 0 0         if ($parameter eq 'ospeed') { $ospeed = &{"POSIX::B".shift(@parameters)}; next; }
  0            
  0            
  0            
567 0 0         if ($parameter eq 'ispeed') { $ispeed = &{"POSIX::B".shift(@parameters)}; next; }
  0            
  0            
  0            
568             # Default.. parameter hasn't matched anything
569             # print "char:".sprintf("%lo",ord($parameter))."\n";
570 0           warn "IO::Stty::stty passed invalid parameter '$parameter'\n";
571             }
572              
573             # What a pain in the ass! Ok.. let's write the crap back.
574 0           $termios->setcflag($c_cflag);
575 0           $termios->setiflag($c_iflag);
576 0           $termios->setispeed($ispeed);
577 0           $termios->setlflag($c_lflag);
578 0           $termios->setoflag($c_oflag);
579 0           $termios->setospeed($ospeed);
580 0           $termios->setcc(VINTR,$control_chars{'INTR'});
581 0           $termios->setcc(VQUIT,$control_chars{'QUIT'});
582 0           $termios->setcc(VERASE,$control_chars{'ERASE'});
583 0           $termios->setcc(VKILL,$control_chars{'KILL'});
584 0           $termios->setcc(VEOF,$control_chars{'EOF'});
585 0           $termios->setcc(VTIME,$control_chars{'TIME'});
586 0           $termios->setcc(VMIN,$control_chars{'MIN'});
587 0           $termios->setcc(VSTART,$control_chars{'START'});
588 0           $termios->setcc(VSTOP,$control_chars{'STOP'});
589 0           $termios->setcc(VSUSP,$control_chars{'SUSP'});
590 0           $termios->setcc(VEOL,$control_chars{'EOL'});
591 0           $termios->setattr($file_num,TCSANOW); # TCSANOW = do immediately. don't unbuffer first.
592             # OK.. that sucked.
593             }
594              
595             =item B
596              
597             Needs documentation
598              
599             =cut
600              
601             sub show_me_the_crap {
602 0     0 1   my ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag,
603             $ospeed,$control_chars) = @_;
604 0           my(%cc) = %$control_chars;
605             # rs = return string
606 0           my($rs)='';
607 0           $rs .= 'speed ';
608 0 0         if ($ospeed == B0) { $rs .= 0; }
  0            
609 0 0         if ($ospeed == B50) { $rs .= 50; }
  0            
610 0 0         if ($ospeed == B75) { $rs .= 75; }
  0            
611 0 0         if ($ospeed == B110) { $rs .= 110; }
  0            
612 0 0         if ($ospeed == B134) { $rs .= 134; }
  0            
613 0 0         if ($ospeed == B150) { $rs .= 150; }
  0            
614 0 0         if ($ospeed == B200) { $rs .= 200; }
  0            
615 0 0         if ($ospeed == B300) { $rs .= 300; }
  0            
616 0 0         if ($ospeed == B600) { $rs .= 600; }
  0            
617 0 0         if ($ospeed == B1200) { $rs .= 1200; }
  0            
618 0 0         if ($ospeed == B1800) { $rs .= 1800; }
  0            
619 0 0         if ($ospeed == B2400) { $rs .= 2400; }
  0            
620 0 0         if ($ospeed == B4800) { $rs .= 4800; }
  0            
621 0 0         if ($ospeed == B9600) { $rs .= 9600; }
  0            
622 0 0         if ($ospeed == B19200) { $rs .= 19200; }
  0            
623 0 0         if ($ospeed == B38400) { $rs .= 38400; }
  0            
624 0           $rs .= " baud\n";
625 0           $rs .= <
626             intr = $cc{'INTR'}; quit = $cc{'QUIT'}; erase = $cc{'ERASE'}; kill = $cc{'KILL'};
627             eof = $cc{'EOF'}; eol = $cc{'EOL'}; start = $cc{'START'}; stop = $cc{'STOP'}; susp = $cc{'SUSP'};
628             EOM
629             ;
630             # c flags.
631 0 0         $rs .= (($c_cflag & CLOCAL) ? '' : '-' ).'clocal ';
632 0 0         $rs .= (($c_cflag & CREAD) ? '' : '-' ).'cread ';
633 0 0         $rs .= (($c_cflag & CSTOPB) ? '' : '-' ).'cstopb ';
634 0 0         $rs .= (($c_cflag & HUPCL) ? '' : '-' ).'hupcl ';
635 0 0         $rs .= (($c_cflag & PARENB) ? '' : '-' ).'parenb ';
636 0 0         $rs .= (($c_cflag & PARODD) ? '' : '-' ).'parodd ';
637 0           $c_cflag = $c_cflag & CS8;
638 0 0         if ($c_cflag == CS8) {
    0          
    0          
639 0           $rs .= "cs8\n";
640             } elsif ($c_cflag == CS7) {
641 0           $rs .= "cs7\n";
642             } elsif ($c_cflag == CS6) {
643 0           $rs .= "cs6\n";
644             } else {
645 0           $rs .= "cs5\n";
646             }
647             # l flags.
648 0 0         $rs .= (($c_lflag & ECHO) ? '' : '-' ).'echo ';
649 0 0         $rs .= (($c_lflag & ECHOE) ? '' : '-' ).'echoe ';
650 0 0         $rs .= (($c_lflag & ECHOK) ? '' : '-' ).'echok ';
651 0 0         $rs .= (($c_lflag & ECHONL) ? '' : '-' ).'echonl ';
652 0 0         $rs .= (($c_lflag & ICANON) ? '' : '-' ).'icanon ';
653 0 0         $rs .= (($c_lflag & ISIG) ? '' : '-' ).'isig ';
654 0 0         $rs .= (($c_lflag & NOFLSH) ? '' : '-' ).'noflsh ';
655 0 0         $rs .= (($c_lflag & TOSTOP) ? '' : '-' ).'tostop ';
656 0 0         $rs .= (($c_lflag & IEXTEN) ? '' : '-' ).'iexten ';
657             # o flag. jam it after the l flags so it looks more compact.
658 0 0         $rs .= (($c_oflag & OPOST) ? '' : '-' )."opost\n";
659             # i flags.
660 0 0         $rs .= (($c_iflag & BRKINT) ? '' : '-' ).'brkint ';
661 0 0         $rs .= (($c_iflag & IGNBRK) ? '' : '-' ).'ignbrk ';
662 0 0         $rs .= (($c_iflag & IGNPAR) ? '' : '-' ).'ignpar ';
663 0 0         $rs .= (($c_iflag & PARMRK) ? '' : '-' ).'parmrk ';
664 0 0         $rs .= (($c_iflag & INPCK) ? '' : '-' ).'inpck ';
665 0 0         $rs .= (($c_iflag & ISTRIP) ? '' : '-' ).'istrip ';
666 0 0         $rs .= (($c_iflag & INLCR) ? '' : '-' ).'inlcr ';
667 0 0         $rs .= (($c_iflag & ICRNL) ? '' : '-' ).'icrnl ';
668 0 0         $rs .= (($c_iflag & IXON) ? '' : '-' ).'ixon ';
669 0 0         $rs .= (($c_iflag & IXOFF) ? '' : '-' )."ixoff\n";
670 0           return $rs;
671             }
672            
673             =back
674              
675             =head1 AUTHOR
676              
677             Austin Schutz (Initial version and maintenance)
678              
679             Todd Rinaldo (Maintenance)
680              
681             =head1 BUGS
682              
683             This is use at your own risk software. Do anything you want with it except
684             blame me for it blowing up your machine because it's full of bugs.
685              
686             See above for what functions are supported. It's mostly standard POSIX
687             stuff. If any of the settings are wrong and you actually know what some of
688             these extremely arcane settings (like what 'sane' should be in POSIX land)
689             really should be, please open an RT ticket.
690              
691             =head1 ACKNOWLEDGEMENTS
692              
693             None
694              
695             =head1 COPYRIGHT & LICENSE
696              
697             Copyright 1997 Austin Schutz, all rights reserved.
698              
699             This program is free software; you can redistribute it and/or modify it
700             under the same terms as Perl itself.
701              
702             =cut
703              
704            
705             1;