I am working with one of these serial cameras http://www.4dsystems.com.au/prod.php?id=75 The camera is pretty finicky, even the demo software works intermittently, i have to power off the camera to reset it at times. I have the perl code below working partially - The camera requires a 'sync' string to be sent before other commands are issued. If i do that in the demo program, close it, then run my perl script it works, i get responses from the commands i send and jpg data (Please ignore the retrieveimage portion of the code its only a stub as of yet).

Its like the demo code is either sending commands i am not - although I have verified through a term program and the manual we are sending the same commands or WIN32::SerialPort is initializing the port differently than i am?? I am using 8N1 @ 57600 which is what the manual suggests but there are a lof of config parameters in the SerialPort config file. There are many other examples of this camera working, here is an example of using the camera in visual studio i believe - http://www.codeproject.com/Articles/34988/C328R-Serial-Camera-Example-with-xBee-using-C

Are there any secrets to using com ports in Perl? Any thoughts on coding errors - again ignoring the imageretrieve portion? Thanks for any help you can provide, Jason

######################################
#       Camera Commands
#
# Sync AA0D00000000
# Init AA0100070903
# Pkg  AA0608640000
# Capt AA0405000000
# Get  AA0E00000000, AA0E00000100
#
#
######################################

use strict;
use Win32::SerialPort;
use Time::HiRes qw (sleep);

my ($CommandUnpacked, $ResultUnpacked, $FrameNum, $FrameHex);

#my $status = pack('HHHHHH', 'aa', '0d', '00', '00', '00', '00');
my $LogFile = "log.txt";
#my ($Result, $Count, $ResultUnpacked);
open (LOG, "+>" . $LogFile) || die ("Cannot open log!");

my $ob = Win32::SerialPort->start ("tpj4.cfg") || die;



# Initializes the Camera
# Sends sync command and looks for ACK
# Replies to that ACK with ACK referencing ACK # sent by camera
    my $Sync = pack( 'C*', 0xaa, 0x0d, 0x00, 0x00, 0x00, 0x00);
    print "\nInitializing Camera\n";
    
# Sends sync command with ACK expected 
    ($CommandUnpacked, $ResultUnpacked) = &SendCommand($Sync, 'aa0e');

# Reads Ack and determines which count to use in the the ACK response 
+           
# Finds frame # in ACK -  aa0e0d000000aa0d000000
#                               ^^  
    $FrameNum = substr($ResultUnpacked, 6,2);
    
    #Converts HEX found to Decimal then back to Hex to be packed
    $FrameHex = '0x' . $FrameNum;
    $FrameNum = eval $FrameHex;  
    print "FrameNum = $FrameNum \n";
    
# Sends ACK with correct frame number
#                          #AA    0E    0D      xx           00    00
    my $Ack = pack( 'C*', 0xaa, 0x0e, 0x0d, 0x.$FrameNum, 0x00, 0x00);
    #my $Ack = pack( 'C*', 0xaa, 0x0e, 0xff, 0x00, 0x00, 0x00);
    print "\n\nAcking Initialization\n";
    #($CommandUnpacked, $ResultUnpacked) = &SendCommand($Ack);
    
    sleep(2);

   
# Sets baud rate - Cam is auto sensing so skipping this step
   # print "\n\nSetting Baud Rate\n";
   # my $BaudRate = pack( 'C*', 0xaa, 0x07, 0x1f, 0x01, 0x00, 0x00);
   # ($CommandUnpacked, $ResultUnpacked) = &SendCommand($BaudRate, 'aa
+0e');
    

#Sets picture size
    #my $Init = pack( 'C*', 0xaa, 0x01, 0x00, 0x07, 0x09, 0x03); #640x
+480
    my $Init = pack( 'C*', 0xaa, 0x01, 0x00, 0x03, 0x09, 0x03); #160x1
+20
    print "\nSetting picture type\n";
    ($CommandUnpacked, $ResultUnpacked) = &SendCommand($Init, 'aa0e');


#Sets transfer package size
    my $Package = pack( 'C*', 0xaa, 0x06, 0x08, 0x64, 0x00, 0x00); # 1
+00
    print "\nSetting packet size\n";
    ($CommandUnpacked, $ResultUnpacked) = &SendCommand($Package, 'aa0e
+');
    
#Captures image
    my $Capture = pack( 'C*', 0xaa, 0x04, 0x05, 0x00, 0x00, 0x00);
    print "\nCapturing image\n";
   ($CommandUnpacked, $ResultUnpacked) = &SendCommand($Capture, 'aa0e'
+);
    
#Transfers image
    print "\nRetrieving picture\n";
    &RetrieveImage();


undef $ob; 
close LOG;



#################################
#         SUBS                  #
#################################





sub SendCommand($$)
{
  
    my ($Command, $Ack) = @_;
    my ($Count, $Result, $ResultUnpacked, $CommandUnpacked);
    my $Success = 0;
    
    while (!$Success)
    {
        $ob->lookclear;
        $ob->stty_echo(0);
    
        $ob->write("$Command\r");
        ($Count, $Result) = $ob->read(120);
        $ob->read_interval(10);
        sleep(.25);
    
        #$ob->error_msg(1);  # prints hardware messages like "Framing 
+Error"
        #print "Error msg $PortObj\n";
        #$ob->user_msg(1); 
        #print "User msg $PortObj\n";
    
        $CommandUnpacked = unpack ('H*', $Command);
        $ResultUnpacked = unpack ('H*', $Result);
        print "Sent = $CommandUnpacked \n";
        print "Results = $ResultUnpacked \n";
           if ($Ack && $ResultUnpacked =~ /$Ack/ )
            {
                print "Command succeeded\n";
                $Success = 1;
            }
    
    }
        return($CommandUnpacked, $ResultUnpacked);
    
    
} # End of sub SendCommand


sub RetrieveImage()
{
    my $SuccessCode = 'xx';
    my ($Count, $Command, $Result, $ResultUnpacked, $CommandUpacked, $
+PacketNum, $JPEGFrame, $ImageFile);
    my $Success = 0;
    $PacketNum = 0;


    $ob->lookclear;
    $ob->stty_echo(0);

$ImageFile = "picture.jpg";

open (IMAGEFILE, ">" . $ImageFile);

    while (!$Success)
    { 
        $Command = pack( 'C*', 0xaa, 0x0e, 0x00, 0x00, 0x.$PacketNum, 
+0x00);
        #$ob->write(uc($Command) . "\r");
        $ob->write("$Command\r");
        ($Count, $Result) = $ob->read(120);
        $ob->read_interval(10);
        sleep(.25);


        $CommandUpacked = unpack ('H*', $Command);
        $ResultUnpacked = unpack ('H*', $Result);

# Removes header bytes - first 4 characters - 0000
        #$ResultUnpacked =~ s/^.{1,4}//s;

        print "Sent = $CommandUpacked \n";
        print "Results = $ResultUnpacked \n";

# Writes image file
#        print IMAGEFILE $ResultUnpacked;

        if ( $ResultUnpacked =~ /$SuccessCode/ )
        {
            print "Command succeeded\n";
            $Success = 1;
        }
    $PacketNum++;
    }

close IMAGEFILE;
return();

} # End of sub RetrieveImage


# Picture Type Error      01h   Parameter Error                   0Bh 
# Picture Up Scale        02h   Send Register Timeout             0Ch 
# Picture Scale Error     03h   Command ID Error                  0Dh 
# Unexpected Reply        04h   Picture Not Ready                 0Fh 
# Send Picture Timeout    05h   Transfer Package Number Error     10h 
# Unexpected Command      06h   Set Transfer Package Size Wrong   11h 
# SRAM JPEG Type Error    07h   Command Header Error              F0h
# SRAM JPEG Size Error    08h   Command Length Error              F1h
# Picture Format Error    09h   Send Picture Error                F5h
# Picture Size Error      0Ah   Send Command Error                FFh
[download]