Perl Test Programs

Windows Batch File
How to Get Rid of the DOS Window
Test Project Commands
Send Project Commands
Test Communication Object
Serial Port Read
Serial Port Write
Test Sine Cosine
Test Modulus

Windows Batch File

Each Perl program is executed by its own Windows batch file. This simplified development and testing. For example:
@echo off
rem =========================================================
rem
rem =========================================================

perl -w name-of-Perl-script-to-execute.pl

pause

How to Get Rid of the DOS Windows

In C:\Perl\bin there is an executable called wperl.exe that will run a Perl script without opening a DOS window. It is simply a Perl interpreter compiled as a Windows application rather than a console application.

Create a shortcut with...

wperl -w c:\path\to\script.pl

  or

C:\Perl\bin\wperl -w c:\path\to\script.pl

Double click it to run without a DOS window.

From: www.perlmonks.org/?node_id=271330

Test Project Commands

See the Arduino Test Sketches.

# ==================================================================
# Test Project Commands (send predefined, hard coded commands)
# ==================================================================

use strict;
use warnings;

require Win32::SerialPort;

my $portname = "COM4";

my $port = Win32::SerialPort->new($portname)
   or die "Can't open serial port (" . $portname . ")\n$^E\n";

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

$port->initialize();
$port->databits(8);
$port->baudrate(9600);
$port->parity("none");
$port->stopbits(1);
$port->debug(0);

#print "Serial port baudrate: " . $port->baudrate() . "\n";

# define line termination for $port->lookfor()
# Note: Arduino serial.println terminates each line/string
#       sent with a "\r\n"

$port->are_match("\r\n");

# ----------------------------------------------------------------
# send test S command
# ----------------------------------------------------------------

my $cmd;

$cmd = "S22,31";
print "\nSending Cmd $cmd\n";
sentCommand($cmd);
processReply();

# ----------------------------------------------------------------
# send test M command
# ----------------------------------------------------------------

$cmd = "M123";
print "\nSending Cmd $cmd\n";
sentCommand($cmd);
processReply();

# ----------------------------------------------------------------
# send test P command
# ----------------------------------------------------------------

$cmd = "P";
print "\nSending Cmd $cmd\n";
sentCommand($cmd);
processReply();

# ----------------------------------------------------------------
# send test C command
# ----------------------------------------------------------------

$cmd = "C";
print "\nSending Cmd $cmd\n";
sentCommand($cmd);
processReply();

# ----------------------------------------------------------------
# send test bad command
# ----------------------------------------------------------------

$cmd = "B,45,67,8";
print "\nSending Cmd $cmd\n";
sentCommand($cmd);
processReply();


$port->close();
exit 0;


# ----------------------------------------------------------------
# send command
# ----------------------------------------------------------------

sub sendCommand
{
   my $cmd = $_[0];

   my $l = length($cmd); 

   $port->lookclear;           # empty buffer

   my $c = $port->write($cmd);

   if ($c == 0)
   {
      print "\nwrite failed\n";
   }
   elsif ($c != $l)
   {
      print "\nWrite incomplete (c=$c) (l=$l)\n";
   }

   return;
}


# ----------------------------------------------------------------
# process command reply
# ----------------------------------------------------------------

sub processReply
{
   my $data;

   $port->lookclear;           # empty buffer

   while(1)
   {
      # poll looking for data

      $data = $port->lookfor();

      # remove training carriage return (the default for
      #     are_match is "\n")
      # this code is not needed because of the $port->are_match
      # $data =~ s/\r$//;

      # if we get data, print it

      if ($data)
      {
         #print "String length:    " . length($data) . "\n";
         print "String Received: (" . $data . ")\n";
      }

      if ($data =~ /^x/) { return; }
   }     

   return;
}

Send Project Commands

See the Arduino Test Sketches.

# ==================================================================
# Send Project Commands (ask the user for a command and send it)
# ==================================================================

use strict;
use warnings;

require Win32::SerialPort;

my $portname = "COM4";

my $port = Win32::SerialPort->new($portname)
   or die "Can't open serial port (" . $portname . ")\n$^E\n";


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

$port->initialize();
$port->databits(8);
$port->baudrate(9600);
$port->parity("none");
$port->stopbits(1);
$port->debug(0);

#print "Serial port baudrate: " . $port->baudrate() . "\n";

# define line termination for $port->lookfor()
# Note: Arduino serial.println terminates each line/string
#       sent with a "\r\n"

$port->are_match("\r\n");

# ------------------------------------------------------------------
# ask the user for a command and send it to the Arduino
# ------------------------------------------------------------------

my $cmd;

while(1)
{
   print "\nEnter commmand: ";
   $cmd = ;
   chomp $cmd;

   $cmd =~ s/^\s+//;          # trim white space
   $cmd =~ s/\s+$//;          # trim white space

   if (! $cmd) { last; }      # no command?

   if (($cmd =~ /^H/) || ($cmd =~ /^h/))
   {
      help();
      next;
   }
  
   sendCommand($cmd);
   processReply();
}

$port->close();
exit 0;


# ----------------------------------------------------------------
# send command
# ----------------------------------------------------------------

sub sendCommand
{
   my $cmd = $_[0];

   my $l = length($cmd); 

   $port->lookclear;           # empty buffer

   my $c = $port->write($cmd);

   if ($c == 0)
   {
      print "\nwrite failed\n";
   }
   elsif ($c != $l)
   {
      print "\nWrite incomplete (c=$c) (l=$l)\n";
   }

   return;
}


# ------------------------------------------------------------------
# process the command's reply
# ------------------------------------------------------------------

sub processReply
{
   my $data;

   $port->lookclear;           # empty buffer

   while(1)
   {
      # poll looking for data

      $data = $port->lookfor();

      # remove training carriage return (the default for
      #    are_match is "\n")
      # this code is not needed because of the $port->are_match
      # $data =~ s/\r$//;

      # if we get data, print it

      if ($data)
      {
         #print "String length:    " . length($data) . "\n";
         print "String Received: (" . $data . ")\n";
      }

      if ($data =~ /^x/) { return; }
   }     
}

# ------------------------------------------------------------------
# display help
# ------------------------------------------------------------------

sub help
{
   print << 'END';

Spos1,pos2 -- Do a ping sweep from servo position 1 to servo
              position 2 and return the resultant distances. 

Mpos       -- Move the servo to a specified position.

P          -- Do a single ping for distance. 

C          -- Return the current position and distance.

H or h     -- This help message.

END
}

Test Communication Object

See the Arduino Test Sketches.

# ==================================================================
# Test communication object
# ==================================================================

my $aref;
my $cmd;
my $status;

print "Creating communication object\n";

my $comm = new communications();

print "Opening communication port\n";

($status,$aref) = $comm->open('COM4',9600);

if (!$status)
{
   print "Communication failed\n";
   DisplayReply($aref);
   exit 0;
}

# ----------------------------------------------------------------
# Sending test S command
# ----------------------------------------------------------------

my $aref;
my $cmd;
my $status;

$cmd = "s22,31";

print "\nSending Cmd $cmd\n";

($status,$aref) = $comm->sendMessage("S22,31");

if (!$status)
{
   print "Communication failed\n";
   DisplayReply($aref);
   exit 0;
}

($status,$aref) = $comm->receiveReply();

DisplayReply($aref);


# ----------------------------------------------------------------
# Sending test M command
# ----------------------------------------------------------------

$cmd = "M123";

print "\nSending Cmd $cmd\n";

($status,$aref) = $comm->sendMessage($cmd);

if (!$status)
{
   print "Communication failed\n";
   DisplayReply($aref);
   exit 0;
}

($status,$aref) = $comm->receiveReply();

DisplayReply($aref);

# ----------------------------------------------------------------
# Sending test P command
# ----------------------------------------------------------------

$cmd = "P";
print "\nSending Cmd $cmd\n";

($status,$aref) = $comm->sendMessage($cmd);

if (!$status)
{
   print "Communication failed\n";
   DisplayReply($aref);
   exit 0;
}

($status,$aref) = $comm->receiveReply();

DisplayReply($aref);

# ----------------------------------------------------------------
# Sending test C command
# ----------------------------------------------------------------

$cmd = "C";

print "\nSending Cmd $cmd\n";

($status,$aref) = $comm->sendMessage($cmd);

if (!$status)
{
   print "Communication failed\n";
   DisplayReply($aref);
   exit 0;
}

($status,$aref) = $comm->receiveReply();

DisplayReply($aref);

# ----------------------------------------------------------------
# Sending bad command
# ----------------------------------------------------------------

$cmd = "B,45,67,8";

print "\nSending Cmd $cmd\n";

($status,$aref) = $comm->sendMessage($cmd);

if (!$status)
{
   print "Communication failed\n";
   DisplayReply($aref);
   exit 0;
}

($status,$aref) = $comm->receiveReply();

DisplayReply($aref);

# ----------------------------------------------------------------
# close communication port
# ----------------------------------------------------------------

print "\nClosing communication port\n";

$comm->close();


# ----------------------------------------------------------------
# Sending command to closed communication port
# ----------------------------------------------------------------

$cmd = "ZZZ";

print "\nSending Cmd $cmd\n";

($status,$aref) = $comm->sendMessage($cmd);

if (!$status)
{
   print "Communication failed\n";
   DisplayReply($aref);
   exit 0;
}

($status,$aref) = $comm->receiveReply();

DisplayReply($aref);

exit 0;

# ================================================================
# display reply messages
# ================================================================

sub DisplayReply
{
   my $aref = $_[0];         # reference to array of reply strings

   foreach my $m (@$aref) { print "$m\n"; }
}
Creating communication object
Opening communication port

Sending Cmd s22,31
S22,31
s22,220
s23,230
s24,240
s25,250
s26,260
s27,270
s28,280
s29,290
s30,300
s31,310
x

Sending Cmd M123
M123
x

Sending Cmd P
p124
x

Sending Cmd C
c45,90
x

Sending Cmd B,45,67,8
e66
x

Closing communication port

Sending Cmd ZZZ
Communication failed
Connection not open

Serial Port Read

# ==================================================================
# Listen for messages from the Arduino and displays them
# ------------------------------------------------------------------
# Windows 7, ActivePerl (32 bit)
# install win32::SerialPort module
# ==================================================================

use strict;
use warnings;

require Win32::SerialPort;

my $portname = "COM4";

my $port = Win32::SerialPort->new($portname)
   or die "Can't open serial port (" . $portname . ")\n$^E\n";

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

$port->initialize();
$port->databits(8);
$port->baudrate(9600);
$port->parity("none");
$port->stopbits(1);
$port->debug(0);

print "Serial port baudrate: " . $port->baudrate() . "\n";

# define line termination for $port->lookfor()
# Note: Arduino serial.println terminates each line/string sent with a "\r\n"

$port->are_match("\r\n");

# loop forever

my $data;

while(1)
{
   # poll looking for data

   $data = $port->lookfor();

   # remove training carriage return (the default for are_match is "\n")
   # this code is not needed because of the $port->are_match
   # $data =~ s/\r$//;

   # if we get data, print it

   if ($data)
   {
      print "String length:    " . length($data) . "\n";
      print "String Received: (" . $data . ")\n";
   }

   # sleep for a second (look up usleep for a shorter period)

   sleep(1);
}

Serial Port Write

# ==================================================================
# Write messages to the Arduino which displays them on a LCD
# ------------------------------------------------------------------
# Windows 7, ActivePerl (32 bit)
# install win32::SerialPort module
# ==================================================================

use strict;
use warnings;

require Win32::SerialPort;

my $portname = "COM4";

my $port = Win32::SerialPort->new($portname,0)
   or die "Can't open serial port (" . $portname . ")\n$^E\n";

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

$port->baudrate(9600); 
$port->parity("none"); 
$port->databits(8); 
$port->stopbits(1); 
$port->debug(0);

#print "Serial port baudrate  : " . $port->baudrate() . "\n";

$port->lookclear; 

my $data = "ABC";

$port->write($data);

$port->close();

Test Sine and Cosine

#!/usr/local/bin/perl -w

use strict;
use Math::Trig;
   
my @a = (0,45,90,135,180,225,270,315,360,405);
   

foreach my $v (@a)
{
   displaySineCosine($v);
}

#-----------------------------------------------------

sub displaySineCosine
{
   my $angle = $_[0];

   my $radian = $angle * (pi/180.0);

   printf "Sine   of %3d  is % 2.6f",$angle,sin($radian);
   printf "Cosine of %3d  is % 2.6f",$angle,cos($radian);
   print "\n";

   return;
}
Sine   of   0  is  0.000000  Cosine of   0  is  1.000000
Sine   of  45  is  0.707107  Cosine of  45  is  0.707107
Sine   of  90  is  1.000000  Cosine of  90  is  0.000000
Sine   of 135  is  0.707107  Cosine of 135  is -0.707107
Sine   of 180  is  0.000000  Cosine of 180  is -1.000000
Sine   of 225  is -0.707107  Cosine of 225  is -0.707107
Sine   of 270  is -1.000000  Cosine of 270  is -0.000000
Sine   of 315  is -0.707107  Cosine of 315  is  0.707107
Sine   of 360  is -0.000000  Cosine of 360  is  1.000000
Sine   of 405  is  0.707107  Cosine of 405  is  0.707107

Test Modulus Operator

#!/usr/local/bin/perl -w

use strict;

print "\nTest Mod Operator\n";

print "\nWith Integer\n\n";

print "   359 % 360  = " . 359 % 360 . "\n";
print "   360 % 360  = " . 360 % 360 . "\n"; 
print "   361 % 360  = " . 361 % 360 . "\n";

print "\nWith Floating Point\n\n";

print "   359.1 % 360.0  = " . 359.1 % 360.0 . "\n";
print "   360.1 % 360.0  = " . 360.1 % 360.0 . "\n"; 
print "   361.1 % 360.0  = " . 361.1 % 360.0 . "\n"; 

print "\nWith Floating Point Subroutine\n\n";

print "results: " . modFloatingPoint(359.1,360.0) . "\n";
print "results: " . modFloatingPoint(360.1,360.0) . "\n";
print "results: " . modFloatingPoint(361.1,360.0) . "\n";

print"\n";

#-----------------------------------------------------

sub modFloatingPoint
{
   my $n1 = $_[0];
   my $n2 = $_[1];

   my $n = int($n1/$n2);

   return $n1 - ($n * $n2);
}
Test Mod Operator

With Integer

   359 % 360  = 359
   360 % 360  = 0
   361 % 360  = 1

With Floating Point

   359.1 % 360.0  = 359
   360.1 % 360.0  = 0
   361.1 % 360.0  = 1

With Floating Point Subroutine

results: 359.1
results: 0.100000000000023
results: 1.10000000000002