SerialPort write question
From: Spin (cNaOlSePbA_at_MvPeLtEsAtSaEr.com)
Date: 10/28/04
- Next message: Spin: "Serialport Read question"
- Previous message: Nathan Gray: "Perl6::Rules character class Segmentation Fault"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Date: Thu, 28 Oct 2004 10:52:51 -0600
I am using Device::Serialport 1.000002 on a RH 7.2 box, listening on
/dev/ttyS1 to a laboratory device.
I'm just getting going with this module and I'm finding the $ob-write()
a little erratic.
What is the nature of the data that is sent to the serial port?
This works fairly consistently (95% +):
$ob->write("\x02\x30\x33\x80\x90\x41\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x03\r\n");
but this doesn't work consistently:
$ob->write(&ack_msg($loc));
where ack_msg is:
sub ack_msg {
my ($ack,$data,@array, $format, $i);
$data = unpack("a16"x(length($_[0])/16)."a*",$_[0]);
my($len) = int(16); # ACK message length constant
@array = unpack('C*', $data);
$_ = sprintf "%2.2x", $_ for @array;
$format = "%s%s%s%s\n";
$data =~ tr/\0-\37\177-\377/./;
$ack = '"\x02'; # Start of message (STX)
$ack .= '\x3'.substr($data,2,1);# Destination from source
$ack .= '\x3'.substr($data,1,1);# Source from Destination
$ack .= '\x80';
$ack .= '\x90';
$ack .= '\x41';
$ack .= '\x80';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\x00';
$ack .= '\xc1';
$ack .= '\x03\r\n"';
return $ack;
};
I would sure appreciate some tips on what I'm doing wrong. This is how I
listen for input and send a message back:
# Now print inbound data from serial port
$in = 1;
while ($in) {
if (($loc = $ob->read(255)) ne "") {
$loc =~ s/\cM/\r\n/;
$inbound_message_type = get_message_type($loc);
my $curr_date = localtime();
# react to message type
SWITCH: {
($inbound_message_type eq "s") && do { # status inquiry message
received
print color ("green"), "LabMach->PC: Status Inquiry $curr_date\n";
print hdump($loc), color("reset");
my $count_out_ack = $ob->write(&ack_msg($loc));
warn "write failed\n" unless ($count_out_ack);
warn "write incomplete\n" if ( $count_out_ack !=
length(&ack_msg($loc)) );
print "PC->VetTest: Ack $curr_date\n" if
($count_out_ack = length(&ack_msg($loc)));
print &ack_msg($loc)."\n";
my $count_out_stat = $ob->write(&status_msg($loc));
warn "write failed\n" unless ($count_out_stat);
warn "write incomplete\n" if ( $count_out_stat !=
length(&status_msg($loc)) );
print "PC->LabMach: Status reply $curr_date\n" if
($count_out_stat = length(&status_msg($loc)));
print &status_msg($loc)."\n";
#$ob->write("\x02\x30\x33\x80\x90\x41\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x03\r\n");
#$ob->write("\x02\x30\x33\x80\x86\x53\x50\x20\x33\x20\x73\x89\x03\r\n");
last SWITCH;
};
($inbound_message_type eq "A") && do { # acknowledgement message
received
print "\a";
print color ("green"), "LabMach->PC: Ack $curr_date\n";
print hdump($loc), color("reset");
last SWITCH;
};
($inbound_message_type eq "I") && do { # port inquiry message received
print color ("green"), "LabMach->PC: Port Inq: $curr_date\n";
print hdump($loc), color("reset");
my $count_out_ack = $ob->write(&ack_msg($loc));
warn "write failed\n" unless ($count_out_ack);
warn "write incomplete\n" if ( $count_out_ack !=
length(&ack_msg($loc)) );
print "PC->LabMach: Ack $curr_date\n" if
($count_out_ack = length(&ack_msg($loc)));
my $count_out_inq = $ob->write(&inq_msg($loc));
warn "write failed\n" unless ($count_out_inq);
warn "write incomplete\n" if ( $count_out_inq !=
length(&inq_msg($loc)) );
print "PC->LabMach: Status reply $curr_date\n" if
($count_out_inq = length(&inq_msg($loc)));
last SWITCH;
};
# END SWITCH
}
}
if ($loc =~ /\cZ/) { $in--; }
if ($ob->reset_error) { $in--; }
}
- Next message: Spin: "Serialport Read question"
- Previous message: Nathan Gray: "Perl6::Rules character class Segmentation Fault"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Relevant Pages
|
|
