File Coverage

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


line stmt bran cond sub pod time code
1             package IO::Stty;
2              
3 1     1   56640 use strict;
  1         3  
  1         25  
4 1     1   3 use warnings;
  1         2  
  1         22  
5              
6 1     1   435 use POSIX;
  1         5260  
  1         4  
7              
8             our $VERSION='0.04';
9              
10             =head1 NAME
11              
12             IO::Stty - 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             # Notice fileno() instead of handle->fileno(). I want it to work with
367             # normal fhs.
368 0           my ($file_num) = fileno($tty_handle);
369             # Is it a terminal?
370 0 0         return undef unless isatty($file_num);
371 0           my($tty_name) = ttyname($file_num);
372             # make a terminal object.
373 0           my($termios)= POSIX::Termios->new();
374 0 0         $termios->getattr($file_num) || warn "Couldn't get terminal parameters for '$tty_name', fine num ($file_num)";
375 0           my($c_cflag) = $termios->getcflag;
376 0           my($c_iflag) = $termios->getiflag;
377 0           my($ispeed) = $termios->getispeed;
378 0           my($c_lflag) = $termios->getlflag;
379 0           my($c_oflag) = $termios->getoflag;
380 0           my($ospeed) = $termios->getospeed;
381 0           my(%control_chars);
382 0           $control_chars{'INTR'}=$termios->getcc(VINTR);
383 0           $control_chars{'QUIT'}=$termios->getcc(VQUIT);
384 0           $control_chars{'ERASE'}=$termios->getcc(VERASE);
385 0           $control_chars{'KILL'}=$termios->getcc(VKILL);
386 0           $control_chars{'EOF'}=$termios->getcc(VEOF);
387 0           $control_chars{'TIME'}=$termios->getcc(VTIME);
388 0           $control_chars{'MIN'}=$termios->getcc(VMIN);
389 0           $control_chars{'START'}=$termios->getcc(VSTART);
390 0           $control_chars{'STOP'}=$termios->getcc(VSTOP);
391 0           $control_chars{'SUSP'}=$termios->getcc(VSUSP);
392 0           $control_chars{'EOL'}=$termios->getcc(VEOL);
393             # OK.. we have our crap.
394              
395 0           my @parameters;
396 0           my $parameter_with_value_rx = qr/^()$/;
397              
398 0 0         if(@_ == 1) {
399             # handle the one-arg cases specifically
400             # Version info
401 0 0         if ($_[0] =~ /^(-v|version)$/ ) {
    0          
    0          
402 0           return $IO::Stty::VERSION."\n";
403             }
404             elsif($_[0] =~ /^\d+$/) {
405 0           push (@parameters,'ispeed',$_[0],'ospeed',$_[0]);
406             }
407             # Do we want to know what the crap is?
408             elsif($_[0] eq '-a') {
409 0           return show_me_the_crap ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag,
410             $ospeed,\%control_chars);
411             }
412             # did we get the '-g' flag?
413 0 0         if($_[0] eq '-g') {
414             return "$c_cflag:$c_iflag:$ispeed:$c_lflag:$c_oflag:$ospeed:".
415             $control_chars{'INTR'}.":".
416             $control_chars{'QUIT'}.":".
417             $control_chars{'ERASE'}.":".
418             $control_chars{'KILL'}.":".
419             $control_chars{'EOF'}.":".
420             $control_chars{'TIME'}.":".
421             $control_chars{'MIN'}.":".
422             $control_chars{'START'}.":".
423             $control_chars{'STOP'}.":".
424             $control_chars{'SUSP'}.":".
425 0           $control_chars{'EOL'};
426             } else {
427             # Or the converse.. -g used before and we're getting the return.
428             # Note that this uses the functionality of stty -g, not any specific
429             # method. Don't take the output here and feed it to the OS stty.
430              
431             # This will make perl -w happy.
432 0           my(@g_params) = split(':',$_[0]);
433 0 0         if (@g_params == 17) {
434             # print "Feeding back...\n";
435 0           ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag,$ospeed)=(@g_params);
436 0           $control_chars{'INTR'}=$g_params[6];
437 0           $control_chars{'QUIT'}=$g_params[7];
438 0           $control_chars{'ERASE'}=$g_params[8];
439 0           $control_chars{'KILL'}=$g_params[9];
440 0           $control_chars{'EOF'}=$g_params[10];
441 0           $control_chars{'TIME'}=$g_params[11];
442 0           $control_chars{'MIN'}=$g_params[12];
443 0           $control_chars{'START'}=$g_params[13];
444 0           $control_chars{'STOP'}=$g_params[14];
445 0           $control_chars{'SUSP'}=$g_params[15];
446 0           $control_chars{'EOL'}=$g_params[16];
447             # leave parameters empty
448             } else {
449             # a simple single option
450 0           @parameters = @_;
451             }
452             }
453             } else {
454 0           @parameters = @_;
455             }
456              
457             # So.. what shall we set?
458 0           my($set_value);
459 0           local($_);
460 0           while (defined ($_ = shift(@parameters))) {
461             # print "Param:$_:\n";
462             # Build the 'this really means this' cases.
463 0 0         if($_ eq 'ek') {
464 0           unshift(@parameters,'erase',8,'kill',21);
465 0           next;
466             }
467 0 0         if($_ eq 'sane') {
468 0           unshift(@parameters,'cread','-ignbrk','brkint','-inlcr','-igncr','icrnl',
469             '-ixoff','opost','isig','icanon','iexten','echo','echoe','echok',
470             '-echonl','-noflsh','-tostop','echok','intr',3,'quit',28,'erase',
471             8,'kill',21,'eof',4,'eol',0,'stop',19,'start',17,'susp',26,
472             'time',0,'min',0 );
473 0           next;
474             # Ugh.
475             }
476 0 0 0       if($_ eq 'cooked' || $_ eq '-raw') {
477             # Is this right?
478 0           unshift(@parameters,'brkint','ignpar','istrip','icrnl','ixon','opost',
479             'isig','icanon',
480             'intr',3,'quit',28,'erase',8,'kill',21,'eof',
481             4,'eol',0,'stop',19,'start',17,'susp',26,'time',0,'min',0);
482 0           next;
483             }
484 0 0 0       if($_ eq 'raw' || $_ eq '-cooked') {
485 0           unshift(@parameters,'-ignbrk','-brkint','-ignpar','-parmrk','-inpck',
486             '-istrip','-inlcr','-igncr','-icrnl','-ixon','-ixoff',
487             '-opost','-isig','-icanon','min',1,'time',0 );
488 0           next;
489             }
490 0 0         if($_ eq 'pass8') {
491 0           unshift(@parameters,'-parenb','-istrip','cs8');
492 0           next;
493             }
494 0 0         if($_ eq '-pass8') {
495 0           unshift(@parameters,'parenb','istrip','cs7');
496 0           next;
497             }
498 0 0         if($_ eq 'crt') {
499 0           unshift(@parameters,'echoe','echok');
500 0           next;
501             }
502 0 0         if($_ eq 'dec') {
503             # 127 == delete, no?
504 0           unshift(@parameters,'echoe','echok','intr',3,'erase', 127,'kill',21);
505 0           next;
506             }
507 0           $set_value = 1; # On by default...
508             # unset if starts w/ -, as in -crtscts
509 0 0         $set_value = 0 if s/^\-//;
510             # Now the fun part.
511            
512             # c_cc field crap.
513 0 0         if ($_ eq 'intr') { $control_chars{'INTR'} = shift @parameters; next;}
  0            
  0            
514 0 0         if ($_ eq 'quit') { $control_chars{'QUIT'} = shift @parameters; next;}
  0            
  0            
515 0 0         if ($_ eq 'erase') { $control_chars{'ERASE'} = shift @parameters; next;}
  0            
  0            
516 0 0         if ($_ eq 'kill') { $control_chars{'KILL'} = shift @parameters; next;}
  0            
  0            
517 0 0         if ($_ eq 'eof') { $control_chars{'EOF'} = shift @parameters; next;}
  0            
  0            
518 0 0         if ($_ eq 'eol') { $control_chars{'EOL'} = shift @parameters; next;}
  0            
  0            
519 0 0         if ($_ eq 'start') { $control_chars{'START'} = shift @parameters; next;}
  0            
  0            
520 0 0         if ($_ eq 'stop') { $control_chars{'STOP'} = shift @parameters; next;}
  0            
  0            
521 0 0         if ($_ eq 'susp') { $control_chars{'SUSP'} = shift @parameters; next;}
  0            
  0            
522 0 0         if ($_ eq 'min') { $control_chars{'MIN'} = shift @parameters; next;}
  0            
  0            
523 0 0         if ($_ eq 'time') { $control_chars{'TIME'} = shift @parameters; next;}
  0            
  0            
524              
525             # c_cflag crap
526 0 0         if ($_ eq 'clocal') { $c_cflag = ($set_value ? ($c_cflag | CLOCAL) : ($c_cflag & (~CLOCAL))); next; }
  0 0          
  0            
527 0 0         if ($_ eq 'cread') { $c_cflag = ($set_value ? ($c_cflag | CREAD) : ($c_cflag & (~CREAD))); next; }
  0 0          
  0            
528             # As best I can tell, doing |~CS8 will clear the bits.. under solaris
529             # anyway, where CS5 = 0, CS6 = 0x20, CS7= 0x40, CS8=0x60
530 0 0         if ($_ eq 'cs5') { $c_cflag = (($c_cflag & ~CS8 )| CS5); next; }
  0            
  0            
531 0 0         if ($_ eq 'cs6') { $c_cflag = (($c_cflag & ~CS8 )| CS6); next; }
  0            
  0            
532 0 0         if ($_ eq 'cs7') { $c_cflag = (($c_cflag & ~CS8 )| CS7); next; }
  0            
  0            
533 0 0         if ($_ eq 'cs8') { $c_cflag = ($c_cflag | CS8); next; }
  0            
  0            
534 0 0         if ($_ eq 'cstopb') { $c_cflag = ($set_value ? ($c_cflag | CSTOPB) : ($c_cflag & (~CSTOPB))); next; }
  0 0          
  0            
535 0 0 0       if ($_ eq 'hupcl' || $_ eq 'hup') { $c_cflag = ($set_value ? ($c_cflag | HUPCL) : ($c_cflag & (~HUPCL))); next; }
  0 0          
  0            
536 0 0         if ($_ eq 'parenb') { $c_cflag = ($set_value ? ($c_cflag | PARENB) : ($c_cflag & (~PARENB))); next; }
  0 0          
  0            
537 0 0         if ($_ eq 'parodd') { $c_cflag = ($set_value ? ($c_cflag | PARODD) : ($c_cflag & (~PARODD))); next; }
  0 0          
  0            
538              
539             # That was fun. Still awake? c_iflag time.
540 0 0         if ($_ eq 'brkint') { $c_iflag = (($set_value ? ($c_iflag | BRKINT) : ($c_iflag & (~BRKINT)))); next; }
  0 0          
  0            
541 0 0         if ($_ eq 'icrnl') { $c_iflag = (($set_value ? ($c_iflag | ICRNL) : ($c_iflag & (~ICRNL)))); next; }
  0 0          
  0            
542 0 0         if ($_ eq 'ignbrk') { $c_iflag = (($set_value ? ($c_iflag | IGNBRK) : ($c_iflag & (~IGNBRK)))); next; }
  0 0          
  0            
543 0 0         if ($_ eq 'igncr') { $c_iflag = (($set_value ? ($c_iflag | IGNCR) : ($c_iflag & (~IGNCR)))); next; }
  0 0          
  0            
544 0 0         if ($_ eq 'ignpar') { $c_iflag = (($set_value ? ($c_iflag | IGNPAR) : ($c_iflag & (~IGNPAR)))); next; }
  0 0          
  0            
545 0 0         if ($_ eq 'inlcr') { $c_iflag = (($set_value ? ($c_iflag | INLCR) : ($c_iflag & (~INLCR)))); next; }
  0 0          
  0            
546 0 0         if ($_ eq 'inpck') { $c_iflag = (($set_value ? ($c_iflag | INPCK) : ($c_iflag & (~INPCK)))); next; }
  0 0          
  0            
547 0 0         if ($_ eq 'istrip') { $c_iflag = (($set_value ? ($c_iflag | ISTRIP) : ($c_iflag & (~ISTRIP)))); next; }
  0 0          
  0            
548 0 0         if ($_ eq 'ixoff') { $c_iflag = (($set_value ? ($c_iflag | IXOFF) : ($c_iflag & (~IXOFF)))); next; }
  0 0          
  0            
549 0 0         if ($_ eq 'ixon') { $c_iflag = (($set_value ? ($c_iflag | IXON) : ($c_iflag & (~IXON)))); next; }
  0 0          
  0            
550 0 0         if ($_ eq 'parmrk') { $c_iflag = (($set_value ? ($c_iflag | PARMRK) : ($c_iflag & (~PARMRK)))); next; }
  0 0          
  0            
551            
552             # Are we there yet? No. Are we there yet? No. Are we there yet...
553             # print "Values: $c_lflag,".($c_lflag | ECHO)." ".($c_lflag & (~ECHO))."\n";
554 0 0         if ($_ eq 'echo') { $c_lflag = (($set_value ? ($c_lflag | ECHO) : ($c_lflag & (~ECHO)))); next; }
  0 0          
  0            
555 0 0         if ($_ eq 'echoe') { $c_lflag = (($set_value ? ($c_lflag | ECHOE) : ($c_lflag & (~ECHOE)))); next; }
  0 0          
  0            
556 0 0         if ($_ eq 'echok') { $c_lflag = (($set_value ? ($c_lflag | ECHOK) : ($c_lflag & (~ECHOK)))); next; }
  0 0          
  0            
557 0 0         if ($_ eq 'echonl') { $c_lflag = (($set_value ? ($c_lflag | ECHONL) : ($c_lflag & (~ECHONL)))); next; }
  0 0          
  0            
558 0 0         if ($_ eq 'icanon') { $c_lflag = (($set_value ? ($c_lflag | ICANON) : ($c_lflag & (~ICANON)))); next; }
  0 0          
  0            
559 0 0         if ($_ eq 'iexten') { $c_lflag = (($set_value ? ($c_lflag | IEXTEN) : ($c_lflag & (~IEXTEN)))); next; }
  0 0          
  0            
560 0 0         if ($_ eq 'isig') { $c_lflag = (($set_value ? ($c_lflag | ISIG) : ($c_lflag & (~ISIG)))); next; }
  0 0          
  0            
561 0 0         if ($_ eq 'noflsh') { $c_lflag = (($set_value ? ($c_lflag | NOFLSH) : ($c_lflag & (~NOFLSH)))); next; }
  0 0          
  0            
562 0 0         if ($_ eq 'tostop') { $c_lflag = (($set_value ? ($c_lflag | TOSTOP) : ($c_lflag & (~TOSTOP)))); next; }
  0 0          
  0            
563              
564             # Make it stop! Make it stop!
565             # c_oflag crap.
566 0 0         if ($_ eq 'opost') { $c_oflag = (($set_value ? ($c_oflag | OPOST) : ($c_oflag & (~OPOST)))); next; }
  0 0          
  0            
567            
568             # Speed?
569 0 0         if ($_ eq 'ospeed') { $ospeed = &{"POSIX::B".shift(@parameters)}; next; }
  0            
  0            
  0            
570 0 0         if ($_ eq 'ispeed') { $ispeed = &{"POSIX::B".shift(@parameters)}; next; }
  0            
  0            
  0            
571             # Default.. parameter hasn't matched anything
572             # print "char:".sprintf("%lo",ord($_))."\n";
573 0           warn "IO::Stty::stty passed invalid parameter '$_'\n";
574             }
575              
576             # What a pain in the ass! Ok.. let's write the crap back.
577 0           $termios->setcflag($c_cflag);
578 0           $termios->setiflag($c_iflag);
579 0           $termios->setispeed($ispeed);
580 0           $termios->setlflag($c_lflag);
581 0           $termios->setoflag($c_oflag);
582 0           $termios->setospeed($ospeed);
583 0           $termios->setcc(VINTR,$control_chars{'INTR'});
584 0           $termios->setcc(VQUIT,$control_chars{'QUIT'});
585 0           $termios->setcc(VERASE,$control_chars{'ERASE'});
586 0           $termios->setcc(VKILL,$control_chars{'KILL'});
587 0           $termios->setcc(VEOF,$control_chars{'EOF'});
588 0           $termios->setcc(VTIME,$control_chars{'TIME'});
589 0           $termios->setcc(VMIN,$control_chars{'MIN'});
590 0           $termios->setcc(VSTART,$control_chars{'START'});
591 0           $termios->setcc(VSTOP,$control_chars{'STOP'});
592 0           $termios->setcc(VSUSP,$control_chars{'SUSP'});
593 0           $termios->setcc(VEOL,$control_chars{'EOL'});
594 0           $termios->setattr($file_num,TCSANOW); # TCSANOW = do immediately. don't unbuffer first.
595             # OK.. that sucked.
596             }
597              
598             =item B
599              
600             Needs documentation
601              
602             =cut
603              
604             sub show_me_the_crap {
605 0     0 1   my ($c_cflag,$c_iflag,$ispeed,$c_lflag,$c_oflag,
606             $ospeed,$control_chars) = @_;
607 0           my(%cc) = %$control_chars;
608             # rs = return string
609 0           my($rs)='';
610 0           $rs .= 'speed ';
611 0 0         if ($ospeed == B0) { $rs .= 0; }
  0            
612 0 0         if ($ospeed == B50) { $rs .= 50; }
  0            
613 0 0         if ($ospeed == B75) { $rs .= 75; }
  0            
614 0 0         if ($ospeed == B110) { $rs .= 110; }
  0            
615 0 0         if ($ospeed == B134) { $rs .= 134; }
  0            
616 0 0         if ($ospeed == B150) { $rs .= 150; }
  0            
617 0 0         if ($ospeed == B200) { $rs .= 200; }
  0            
618 0 0         if ($ospeed == B300) { $rs .= 300; }
  0            
619 0 0         if ($ospeed == B600) { $rs .= 600; }
  0            
620 0 0         if ($ospeed == B1200) { $rs .= 1200; }
  0            
621 0 0         if ($ospeed == B1800) { $rs .= 1800; }
  0            
622 0 0         if ($ospeed == B2400) { $rs .= 2400; }
  0            
623 0 0         if ($ospeed == B4800) { $rs .= 4800; }
  0            
624 0 0         if ($ospeed == B9600) { $rs .= 9600; }
  0            
625 0 0         if ($ospeed == B19200) { $rs .= 19200; }
  0            
626 0 0         if ($ospeed == B38400) { $rs .= 38400; }
  0            
627 0           $rs .= " baud\n";
628 0           $rs .= <
629             intr = $cc{'INTR'}; quit = $cc{'QUIT'}; erase = $cc{'ERASE'}; kill = $cc{'KILL'};
630             eof = $cc{'EOF'}; eol = $cc{'EOL'}; start = $cc{'START'}; stop = $cc{'STOP'}; susp = $cc{'SUSP'};
631             EOM
632             ;
633             # c flags.
634 0 0         $rs .= (($c_cflag & CLOCAL) ? '' : '-' ).'clocal ';
635 0 0         $rs .= (($c_cflag & CREAD) ? '' : '-' ).'cread ';
636 0 0         $rs .= (($c_cflag & CSTOPB) ? '' : '-' ).'cstopb ';
637 0 0         $rs .= (($c_cflag & HUPCL) ? '' : '-' ).'hupcl ';
638 0 0         $rs .= (($c_cflag & PARENB) ? '' : '-' ).'parenb ';
639 0 0         $rs .= (($c_cflag & PARODD) ? '' : '-' ).'parodd ';
640 0           $c_cflag = $c_cflag & CS8;
641 0 0         if ($c_cflag == CS8) {
    0          
    0          
642 0           $rs .= "cs8\n";
643             } elsif ($c_cflag == CS7) {
644 0           $rs .= "cs7\n";
645             } elsif ($c_cflag == CS6) {
646 0           $rs .= "cs6\n";
647             } else {
648 0           $rs .= "cs5\n";
649             }
650             # l flags.
651 0 0         $rs .= (($c_lflag & ECHO) ? '' : '-' ).'echo ';
652 0 0         $rs .= (($c_lflag & ECHOE) ? '' : '-' ).'echoe ';
653 0 0         $rs .= (($c_lflag & ECHOK) ? '' : '-' ).'echok ';
654 0 0         $rs .= (($c_lflag & ECHONL) ? '' : '-' ).'echonl ';
655 0 0         $rs .= (($c_lflag & ICANON) ? '' : '-' ).'icanon ';
656 0 0         $rs .= (($c_lflag & ISIG) ? '' : '-' ).'isig ';
657 0 0         $rs .= (($c_lflag & NOFLSH) ? '' : '-' ).'noflsh ';
658 0 0         $rs .= (($c_lflag & TOSTOP) ? '' : '-' ).'tostop ';
659 0 0         $rs .= (($c_lflag & IEXTEN) ? '' : '-' ).'iexten ';
660             # o flag. jam it after the l flags so it looks more compact.
661 0 0         $rs .= (($c_oflag & OPOST) ? '' : '-' )."opost\n";
662             # i flags.
663 0 0         $rs .= (($c_iflag & BRKINT) ? '' : '-' ).'brkint ';
664 0 0         $rs .= (($c_iflag & IGNBRK) ? '' : '-' ).'ignbrk ';
665 0 0         $rs .= (($c_iflag & IGNPAR) ? '' : '-' ).'ignpar ';
666 0 0         $rs .= (($c_iflag & PARMRK) ? '' : '-' ).'parmrk ';
667 0 0         $rs .= (($c_iflag & INPCK) ? '' : '-' ).'inpck ';
668 0 0         $rs .= (($c_iflag & ISTRIP) ? '' : '-' ).'istrip ';
669 0 0         $rs .= (($c_iflag & INLCR) ? '' : '-' ).'inlcr ';
670 0 0         $rs .= (($c_iflag & ICRNL) ? '' : '-' ).'icrnl ';
671 0 0         $rs .= (($c_iflag & IXON) ? '' : '-' ).'ixon ';
672 0 0         $rs .= (($c_iflag & IXOFF) ? '' : '-' )."ixoff\n";
673 0           return $rs;
674             }
675            
676             =back
677              
678             =head1 AUTHOR
679              
680             Austin Schutz (Initial version and maintenance)
681              
682             Todd Rinaldo (Maintenance)
683              
684             =head1 BUGS
685              
686             This is use at your own risk software. Do anything you want with it except
687             blame me for it blowing up your machine because it's full of bugs.
688              
689             See above for what functions are supported. It's mostly standard POSIX
690             stuff. If any of the settings are wrong and you actually know what some of
691             these extremely arcane settings (like what 'sane' should be in POSIX land)
692             really should be, please open an RT ticket.
693              
694             =head1 ACKNOWLEDGEMENTS
695              
696             None
697              
698             =head1 COPYRIGHT & LICENSE
699              
700             Copyright 1997 Austin Schutz, all rights reserved.
701              
702             This program is free software; you can redistribute it and/or modify it
703             under the same terms as Perl itself.
704              
705             =cut
706              
707            
708             1;