Introduction

A communication object is used by the control program to communicate with the Arduino.

Create the file communications.pm with the code in it.

Note: See the test programs for an example of using a communication object.

Perl Code

package communications;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Object methods:
# new           create a new object
# toString      return a string version of the object data   
# open          open a connection to a port 
# close         close a connection to a port
#               object is not destroyed and may be re-used
# sentMessage   send a message (string)
# receiveReply  receive reply messages (strings)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

use strict;
use warnings;

require Win32::SerialPort;

# -------------------------------------------------------------------
# constructor
# ------------------------------------------------------------------- 

sub new
{
   my ($class) = @_;
   my ($self) = { _port     => undef,
                  _portname => undef,
                  _baudrate => undef };
   bless($self,$class);
   return $self;
}

# -------------------------------------------------------------------
# convert object to string
# ------------------------------------------------------------------- 

sub toString
{
   my ($self) = @_;

   my $str = "";

   if (!defined($self->{_port}))
   {
      $str="Port not defined";
      return $str;
   }

   $str = "Port is open\n" . 
          "Port name " . $self->{_portname} . "\n" .
          "Baudrate " . $self->{_baudrate};

   return $str;
}

# -------------------------------------------------------------------
# open port connection
# ------------------------------------------------------------------- 

sub open
{
   my ($self,$portname,$baudrate) = @_;

   # is the port already open?

   my @reply = ();

   if (defined($self->{_port}))
   {
      $reply[0] = "Connection already open";
      return (0,\@reply);
   }

   # open port connection

   my $port;
   my $quite = 1;

   if (!($port = Win32::SerialPort->new($portname,$quite)))
   {
      $reply[0] = "Can not open port ($portname)";
      $reply[1] = $^E;
      return (0,\@reply); 
   }

   # save the port information

   $self->{_port}     = $port;
   $self->{_portname} = $portname;
   $self->{_baudrate} = $baudrate;


   # -- for debugging --------------------------------------------------
   # prints hardware messages like "Framing Error"
   # $self->{_port}->error_msg(1);
   # prints function messages like "Waiting for CTS"
   # $self->{_port}->user_msg(1);   
   # ------------------------------------------------------------------- 

   $self->{_port}->initialize();
   $self->{_port}->databits(8);
   $self->{_port}->baudrate($self->{_baudrate});
   $self->{_port}->parity("none");
   $self->{_port}->stopbits(1);
   $self->{_port}->debug(0);
   $self->{_port}->are_match("\r\n");

   $reply[0] = "Connected to port ($portname)";
   return (1,\@reply);
}

# ----------------------------------------------------------------
# close port connection
# ----------------------------------------------------------------

sub close
{
  my ($self) = @_;
  if (!defined($self->{_port})) { return 1; }
  $self->{_port}->close();
  $self->{_port}     = undef;
  $self->{_portname} = undef;
  $self->{_baudrate} = undef;
  my @reply = ("Connection closed");
  return (1,\@reply);
}

# ----------------------------------------------------------------
# send message
# ----------------------------------------------------------------

sub sendMessage
{
   my ($self,$msg) = @_;

   if (! defined($self->{_port}))
   {
      my @reply = ("Connection not open");
      return (0,\@reply);
   }

   my $l = length($msg);       # length of message 

   $self->{_port}->lookclear;  # empty buffer

   my $c = $self->{_port}->write($msg); # write message,
                                        # get characters sent count

   if ($c == 0)
   {
      my @reply = ("write failed - no characters sent");
      return (0,\@reply);
   }
   elsif ($c != $l)
   {
      my @reply = ("Write incomplete (sent=$c) (msglength=$l)");
      return (0,\@reply);
   }

   my @reply = ("Write complete (sent=$c)");
   return (1,\@reply);
}

# ----------------------------------------------------------------
# receive reply messages
# ----------------------------------------------------------------

sub receiveReply
{
   my ($self) = @_;

   my @reply = ();             # array to collect reply messages

   if (! defined($self->{_port}))
   {
      $reply[0] = "Connection not open";
      return (0,\@reply);
   }

   $self->{_port}->lookclear;  # empty buffer

   my $msg;                    # reply message

   while(1)
   {
      # poll looking for data

      $msg = $self->{_port}->lookfor();

      # if we get data, save it

      if ($msg) { push(@reply,$msg); }

      # last reply messages?

      if ($msg =~ /^x/) { return (1,\@reply); }
   }     

   unshift(@reply,'Received reply terminated early. ' .
                  'Did not receive "x" message.');

   return (0,\@reply);
}

1;