Perl a COM port (LONG)

[Milan Pikula - WWW]

On Mon, 17 Jan 2000, Milan Sorm wrote:

W>Mon, Jan 17, 2000 ve 03:07:18PM +0100 Dominik Formanek napsal:
W># Ahoj,
W># 
W># mam takovy dotaz. Lze perlem ovladat COM porty ? Myslim treba nastaveni protokolu komunikace a tak...rychost...
W># 
W># Dominik
W>
W>ja to delam:
W>
W>system 'stty -neco....';
W>
W>--milan
W>
W>a funguje to pekne.

nechcel som pouzivat system(), tak som to spravil takto:

package ModemIO;

BEGIN {
}

# /usr/include/asm/ioctls.h
        $TCGETS = 0x5401;
        $TCSETS = 0x5403;
# /usr/include/asm/termbits.h

        $IGNBRK  = 0000001;
        $BRKINT  = 0000002;
        $IGNPAR  = 0000004;
        $PARMRK  = 0000010;
        $INPCK   = 0000020;
        $ISTRIP  = 0000040;
        $INLCR   = 0000100;
        $IGNCR   = 0000200;
        $ICRNL   = 0000400;
        $IUCLC   = 0001000;
        $IXON    = 0002000;
        $IXANY   = 0004000;
        $IXOFF   = 0010000;
        $IMAXBEL = 0020000;

        $OPOST   = 0000001;
        $OLCUC   = 0000002;
        $ONLCR   = 0000004;
        $OCRNL   = 0000010;
        $ONOCR   = 0000020;
        $ONLRET  = 0000040;
        $OFILL   = 0000100;
        $OFDEL   = 0000200;
        $NLDLY   = 0000400;
        $NL0     = 0000000;
        $NL1     = 0000400;
        $CRDLY   = 0003000;
        $CR0     = 0000000;
        $CR1     = 0001000;
        $CR2     = 0002000;
        $CR3     = 0003000;
        $TABDLY  = 0014000;
        $TAB0    = 0000000;
        $TAB1    = 0004000;
        $TAB2    = 0010000;
        $TAB3    = 0014000;
        $XTABS   = 0014000;
        $BSDLY   = 0020000;
        $BS0     = 0000000;
        $BS1     = 0020000;
        $VTDLY   = 0040000;
        $VT0     = 0000000;
        $VT1     = 0040000;
        $FFDLY   = 0100000;
        $FF0     = 0000000;
        $FF1     = 0100000;

        $CBAUD   =  0010017;
        $B0      =  0000000;
        $B50     =  0000001;
        $B75     =  0000002;
        $B110    =  0000003;
        $B134    =  0000004;
        $B150    =  0000005;
        $B200    =  0000006;
        $B300    =  0000007;
        $B600    =  0000010;
        $B1200   =  0000011;
        $B1800   =  0000012;
        $B2400   =  0000013;
        $B4800   =  0000014;
        $B9600   =  0000015;
        $B19200  =  0000016;
        $B38400  =  0000017;
        $CSIZE   =  0000060;
        $CS5     =  0000000;
        $CS6     =  0000020;
        $CS7     =  0000040;
        $CS8     =  0000060;
        $CSTOPB  =  0000100;
        $CREAD   =  0000200;
        $PARENB  =  0000400;
        $PARODD  =  0001000;
        $HUPCL   =  0002000;
        $CLOCAL  =  0004000;
        $CBAUDEX =  0010000;
        $B57600  =  0010001;
        $B115200 =  0010002;
        $B230400 =  0010003;
        $B460800 =  0010004;
        $B500000 =  0010005;
        $B576000 =  0010006;
        $B921600 =  0010007;
        $B1000000 = 0010010;
        $B1152000 = 0010011;
        $B1500000 = 0010012;
        $B2000000 = 0010013;
        $B2500000 = 0010014;
        $B3000000 = 0010015;
        $B3500000 = 0010016;
        $B4000000 = 0010017;
        $CIBAUD   = 002003600000;
        $CMSPAR   = 010000000000;
        $CRTSCTS  = 020000000000;

        $ISIG    = 0000001;
        $ICANON  = 0000002;
        $XCASE   = 0000004;
        $ECHO    = 0000010;
        $ECHOE   = 0000020;
        $ECHOK   = 0000040;
        $ECHONL  = 0000100;
        $NOFLSH  = 0000200;
        $TOSTOP  = 0000400;
        $ECHOCTL = 0001000;
        $ECHOPRT = 0002000;
        $ECHOKE  = 0004000;
        $FLUSHO  = 0010000;
        $PENDIN  = 0040000;
        $IEXTEN  = 0100000;

# /usr/src/linux/include/asm/termbits.h
        $struct_termios = 'IIIICCCCCCCCCCCCCCCCCCCC';

sub init {
        my $tmp1;
        my @tmp2;

        $line = $_[0];
        $speed = $_[1];
        open(MODEM, "+<$line") ||
        open(MODEM, "+</dev/$line") ||
        open(MODEM, "+</dev/tty$line") || return 0;

        my $tmp1;
        $tmp1 = pack ($struct_termios, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0);
        ioctl(MODEM, $TCGETS, $tmp1) || return 0;
        @tmp2 = unpack($struct_termios, $tmp1);
        $tmp2[0] = $IGNBRK;
        $tmp2[1] = 0;
        $tmp2[2] = $CS8 | $HUPCL | $CREAD | $CLOCAL | $SPEED;
        $tmp2[3] = 0;

        $tmp1 = pack($struct_termios, @tmp2);
        ioctl(MODEM, $TCSETS, $tmp1);

        return 1;
}

sub getchar {
        return getc MODEM;
}

sub getline {
        my $n = <MODEM>;
        $n =~ s/[\x0d\x0a]//g;
        return $n;
}

sub putline {
        my $msg;
        foreach $msg (@_) {
                print "Sending: $msg\n";
                print MODEM "$msg\r\n";
        }
}

sub expect {
        my $msg;
        my $lin;

        print "Expecting: @_\n";
        while (1) {
                $lin = getline();
                foreach $msg (@_) {
                        return 1
                                if ($lin =~ m/$msg/);
                }
        }
}

sub reset {
        print "Reseting modem\n";
        sleep 3;
        print MODEM "+++";
        sleep 3;
        putline "ATZ";
        expect "OK";
        putline "AT S7=45 S0=0 L1 V1 X3 \&c1 E1 Q0";
        expect "OK";
}

sub rcvdtmf {
        my $char;
        while (ord(getchar()) != 16) {}
        $char = getchar();
        return $char;
}

sub readall {
        print "Receiving:\n";
        while (<MODEM>) {
                print;
        }
}

1;


	Milan

--
Milan Pikula, WWW. Finger me for Geek Code.
http://fornax.elf.stuba.sk/~www, www na fornax.elf.stuba.sk
.. dajte mi pevnu linku a pohnem zemegulou ..