Včera jsem potřeboval v jednom perlivém modulu vyřešit komunikaci se sériovým portem v Linuxu. Inu, řešení se nabízí přímo samo a to komunikovat přímo s /dev/ttySn jako s obyčejným souborem. Jde to, ale dře to, hlavně při pohledu na manuálovou stránku programu stty, který slouží k nastavování všemožných parametrů sériového portu.
PERLivý svět však disponuje nepřeberným množstvím předvařených modulů řešící všemožné záludnosti tohoto světa a shodou okolností je mezi nimi i modul Device::SerialPort. Ovšem jeho manuálová stránka je krize sama o sobě, nelhledě na přibalené expamles. A přitom mi šlo o jediné: vyslat řetězec a přijmout řetezec :-) Takovou "záludnost" jsem v Delphi řešil 20 sekund vyhledáním metody ReadString a SendString. Zde nic takového není a tak jsem spláncul něco velmi jednoduchého, jen tak na test, že to jde. A to je výsledek. Třeba vám pomůže.
Pokud modul Device::SerialPort na svém stroji nemáte, řešení je perl -MCPAN -e 'install Device::SerialPort'
#!/usr/bin/perl -w
use Device::SerialPort qw( :PARAM :STAT 0.07 );
# Otevreni portu / instance tridy Device::SerialPort
$port=Device::SerialPort->new("/dev/ttyS0");
# Nastaveni parametru portu
# Rychlost: 2400, 4800, 9600 apod.. klasika
$port->baudrate(9600);
# Parita: node, odd, even
$port->parity("none");
# Datovych bitu na ramec, obvykle 8
$port->databits(8);
# Pocet stop bitu, obvykle 1, nekdy 2
$port->stopbits(1);
# Rizeni provozu: none, xon, xoff
$port->handshake("none");
# Jak dlouho se ma cekat na dalsi znak. To zde neresime.
$port->read_char_time(0);
# Jak dlouho se ma z portu prijimat v ms, zde 1 sec
$port->read_const_time(1000);
# Posle na port text AHOJ SVETE a ukonci ho znakem \n
$port->write("AHOJ SVETE\n");
# Bude cekat 10 sekund na odpoved ze serioveho portu. Pokud odpoved prijde, vypise ji.
$vysledek=&readstring(10);
print "Ze serioveho portu prislo: $vysledek";
# Podprogram na cteni retezce se serioveho portu. Periodicky testuje prichozi data a pokud
# se objevi retezec obsahujici \n\r, cekani ukocni, retezec orizne a vrati. Jinak napise timeout.
# Perioda je dana parametrem read_const_time a to je v tomto pripade 1 sekunda.
# Delka nacteneho reteze je max. 253 znaku a musi byt vzdy ukoncen \n\r viz reg. vyrazy.
sub readstring {
my ($timeout) = @_;
my ($buffer,$saw,$count);
$buffer="";
$saw="";
while (($timeout>0)&&($saw !~ /[\n\r]/)) {
($count,$saw)=$port->read(255);
$buffer.=$saw;
$timeout--;
}
$buffer =~ s/[\n\r].*//g;
if($timeout==0) {print "timeout";}
return($buffer);
}