#!/opt/perl/bin/perl -w # cross-platform example1 use strict; use vars qw( $OS_win $ob $port ); BEGIN { $OS_win = ($^O eq "MSWin32") ? 1 : 0; eval "use Device::SerialPort"; die "$@\n" if ($@); } # End BEGIN $port = '/dev/ttyUSB0'; $ob = Device::SerialPort->new ($port); die "Can't open serial port $port: $^E\n" unless ($ob); $ob->user_msg(1); # misc. warnings $ob->error_msg(1); # hardware and data errors $ob->baudrate(4800); $ob->parity("none"); ## $ob->parity_enable(1); # for any parity except "none" $ob->databits(8); $ob->stopbits(1); $ob->handshake('none'); my $baud = $ob->baudrate; my $parity = $ob->parity; my $data = $ob->databits; my $stop = $ob->stopbits; my $hshake = $ob->handshake; my @baud_opt = $ob->baudrate; my @parity_opt = $ob->parity; my @data_opt = $ob->databits; my @stop_opt = $ob->stopbits; my @hshake_opt = $ob->handshake; my $c = 8; print "\nData Bit Options: "; foreach $a (@data_opt) { print " $a"; } print "\n\nStop Bit Options: "; foreach $a (@stop_opt) { print " $a"; } print "\n\nHandshake Options: "; foreach $a (@hshake_opt) { print " $a"; } print "\n\nParity Options: "; foreach $a (@parity_opt) { print " $a"; } print "\n\nBaudrate Options: "; foreach $a (@baud_opt) { print " $a"; unless (--$c > 0) { $c = 8; print "\n "; } } print "\n\nCurrent Settings: "; print "B = $baud, D = $data, P = $parity, S = $stop, H = $hshake\n"; $ob->read_interval(0) if ($OS_win); $ob->read_const_time(10000); sleep 1; my $result = $ob->input; print "result = $result\n"; print "Starting 500 character background read\n"; my $in; $in = $ob->read_bg(500) if ($OS_win); my $done = 0; my $blk; my $err; my $out; for (;;) { ($blk, $in, $out, $err)=$ob->status; print "got $in characters so far..\n"; sleep 1; ($done, $in, $result) = $ob->read_done(0) if ($OS_win); last if $done; last if ($in >= 500); } my $active = $ob->input; print "result = $active\n"; sleep 1; $active = $ob->input; $result = ""; while ($active) { sleep 1; $active = $ob->input; print "result = $active\n"; } print "\n\n....And now the rest = \n$result\n"; undef $ob; print "Hello World\n"; ;