Seriove porty a Perl.

[Peter Kundrat]

On Wed, Feb 25, 1998 at 04:58:18PM +0100, Rejc Libor wrote:
> Dobre odpoledne.
> 
> Mozna mi vynadate, ale uz jsem zkousel vsechno. Tento problem jsem
> nadhodil i v konferenci o Perlu a zatim jsem nedostal odpoved, ktera by
> mi vytrhla trn ... Potrebuji napsat programek v Perlu, ktery bude cist
> nejaka data pres seriovy port. To neni problem a funguje mi to. Nemuzu
> se ale nikde dopatrat, jak zmenit parametry tech portu. Myslim tim
> baudy, paritu, stopbity atd. Pomuze nekdo ?
> Podotykam, ze se samozrejme jedna o Linux.

Vsetko dolezite je v man 3pm POSIX a man 3 termios.

use POSIX qw(:termios_h :fcntl_h);

$tios = new POSIX::Termios;
$tios->setispeed($baudrate);
$tios->setospeed($baudrate);

Na uchovavanie nastavenia ako celku (okrem rychlosti), mozete pouzit
doleuvedene funkcie (plus su tam konstanty pre vyssie rychlosti (ktore v
POSIX-e nie su. Viac kosher by bolo pouzit h2ph a require 'termbits.ph').  

Format retazca je rovnaky s vystupom stty -g, takze je mozne cez stty zistit
nastavenie tty a nastavit ho rovnako v perl-e.

$orig= $tios->Get()
$tios->Set("5:0:800000bf:0:3:1c:7f:15:4:0:0:0:11:13:1a:0:12:f:17:16:0:0:73");


package POSIX;
sub B57600  {0010001};
sub B115200 {0010002};
sub B230400 {0010003};
sub B460800 {0010004};

package POSIX::Termios;
sub Set {
        my ($this, $str) = @_;
        my (@stra) = split(/:/, $str);
        my ($i);

        $this->setiflag(hex(shift @stra));
        $this->setoflag(hex(shift @stra));
        $this->setcflag(hex(shift @stra));
        $this->setlflag(hex(shift @stra));

        for ($i=0; $i < &POSIX::NCCS; $i++) {
                $this->setcc($i, hex(shift @stra));
        }

}
sub Get {
        my ($this, $i, $str) = shift;

        for $i ($this->getiflag(),$this->getoflag(),
                        $this->getcflag(),$this->getlflag()
        ) {
                $str .= sprintf("%x:", $i);
        }
        for ($i=0; $i < &POSIX::NCCS; $i++){
                $str .= sprintf("%x%s", $this->getcc($i), ($i== &POSIX::NCCS-1)?"":":");
        }
        return $str;
}