Re^2: Calling hyper terminal and executing commands in hyper terminal from Perl

I agree that Win32::SerialPort is the way to go, I have used it myself. The API is not simple and the docs are none too clear, though, so I made my own wrapper to make it simpler to use. In case it is of use to you, I am including below my wrapper class (called Win32::RS232Port) and some snippets from an application of mine that use it.

The Win32::RS232Port class:

package Win32::RS232Port;

use strict;
use warnings;

use Win32::SerialPort 0.14;
use Carp;

@Win32::RS232Port::ISA = ('Win32::SerialPort');

sub new {
    my ($class, $port, %given_options) = @_;

    $port = 'COM' . $port if ( $port =~ m/\A \d+ /xms );
    $port = "\\\\.\\" . $port;

    my $self = $class->SUPER::new($port);
    if (!$self) {
        die "could not open port '$port'\n";
    }
    
    my %options = (
        # defaults:
        baudrate => 115200,
        parity => 'none',
        databits => 8,
        stopbits => 1,
        handshake => 'none',
    );
    for my $opt (keys %options) {
        if (exists $given_options{$opt}) {
            $options{$opt} = $given_options{$opt};
        }
    }

    $self->baudrate($options{baudrate})   || croak "bad baudrate '$opt
+ions{baudrate}'";
    $self->parity($options{parity})       || croak "bad parity '$optio
+ns{parity}'";
    $self->databits($options{databits})   || croak "bad databits '$opt
+ions{databits}'";
    $self->stopbits($options{stopbits})   || croak "bad stopbits '$opt
+ions{stopbits}'";
    $self->handshake($options{handshake}) || croak "bad handshake '$op
+tions{handshake}'";
    if ($options{parity} eq 'none') {
        defined $self->parity_enable(0)  || croak "internal error: par
+ity_enable setting failed";
    }
    else {
        defined $self->parity_enable(1)  || croak "internal error: par
+ity_enable setting failed";
    }

    $self->write_settings || undef $self;
    unless ($self) { croak "couldn't write_settings"; }

    #~ $self->are_match(-re => '.');
    $self->are_match("\n");

    # "private" (to this class) data
    $self->{"_APP_TX_QUEUE"} = q{};
    $self->{"_TX_PENDING"}   = 0;

    bless( $self, $class );
    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->SUPER::DESTROY();
}

sub change_settings {
    my ($self, %opts) = @_;
    while (my ($optname, $optsetting) = each %opts ) {
        if ($optname eq 'baudrate') {
            $self->baudrate($optsetting)  || croak "bad baudrate '$opt
+setting'";
        }
        elsif ($optname eq 'parity') {
            $self->parity($optsetting)    || croak "bad parity '$optse
+tting'";
            if ($optsetting eq 'none') {
                defined $self->parity_enable(0)  || croak "internal er
+ror: parity_enable setting failed";
            }
            else {
                defined $self->parity_enable(1)  || croak "internal er
+ror: parity_enable setting failed";
            }
        }
        elsif ($optname eq 'databits') {
            $self->databits($optsetting)  || croak "bad databits '$opt
+setting'";
        }
        elsif ($optname eq 'stopbits') {
            $self->stopbits($optsetting)  || croak "bad stopbits '$opt
+setting'";
        }
        elsif ($optname eq 'handshake') {
            $self->handshake($optsetting) || croak "bad handshake '$op
+tsetting'";
        }
        else {
            croak "Unknown serial port setting '$optname'";
        }
        #~ $options{$optname} = $optsetting;
    }
    $self->write_settings || croak "couldn't write_settings";
}


sub tx_pending {
    my ($self) = @_;
    #~ $self->{"_TX_PENDING"} = $self->{"_TX_PENDING"} && !$self->writ
+e_done(0);
    if ($self->{"_TX_PENDING"}) {
        my ($done, $count_out) = $self->write_done(0);
        $self->{"_TX_PENDING"} = 0 if $done;
        return $self->{"_TX_PENDING"};
    }
    return 0;
}

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

    # do serial transmit of queued data
    my $tx_is_pending = $self->tx_pending;
    if ( $self->{"_APP_TX_QUEUE"} ne q{} && !$tx_is_pending ) {
        $self->write_bg( $self->{"_APP_TX_QUEUE"} );
        $self->{"_APP_TX_QUEUE"} = q{};    # clear our app. Tx queue
        $self->{"_TX_PENDING"}   = 1;
        return 1;
    }
    return $tx_is_pending;
}

sub qtx {
    my ( $self, $send ) = @_;
    $self->{"_APP_TX_QUEUE"} .= $send;
    $self->poll_tx;
    return;
}

sub rx_data {
    my $self = shift;
    my ($done, $count_in, $rx) = $self->read_done(0);
    $self->read_bg(256) if $done;
    return $rx;
}

1;
[download]

An example of using the Win32::RS232Port (The app uses the classic hashref-as-object OO style, which is why the serial port object is stored in $self->{serport}):

# open serial port, create instance of Win32::RS232Port object
$self->{serport} =  Win32::RS232Port->new($comport_name, handshake => 
+'rts', baudrate => 9600);
if (!defined $self->{serport}) { die "Could not open reference COM por
+t"; }

# manually set state of handshaking output lines:
$self->{serport}->rts_active(1);
$self->{serport}->dtr_active(1);

# transmit some data:
$self->{serport}->qtx("SYST:ERR?\r\n");

sub poll {
    # call this function regularly to check for received data and to p
+ass on any queued data for transmission
    my $self = shift;
    
    if ( defined $self->{serport} ) {
        # pass on any queued data for transmission
        $self->{serport}->poll_tx;
        
        # handle incoming data: here I'm just appending it to $self->{
+com_rxd} where it can be picked up by code that's interested.
        my $rx = $self->{serport}->rx_data;
        if ($rx ne q{}) {
            $self->{com_rxd} = q{} if !defined $self->{com_rxd};
            $self->{com_rxd} .= $rx;
        }
    }
}

sub wait_for_tx_done {
    my $self = shift;
    my $tstart = time;
    while (defined $self->{serport} && $self->{serport}->tx_pending) {
        $self->poll();
        die "Timeout on serial port transmission\n" if time > $tstart 
++ 10;
    }
}

# close the serial port
$self->{serport}->close();
[download]

"Any sufficiently analyzed magic is indistinguishable from science" - Agatha Heterodyne

Comment on Re^2: Calling hyper terminal and executing commands in hyper terminal from Perl Select or Download Code