Subversion Repositories Projects

# This part includes the low-level API calls

package Win32API::CommPort;

use Win32;

use Win32::API 0.01;

if ( $] < 5.004 ) {

    my $no_silly_warning = $Win32::API::VERSION;

    $no_silly_warning = $Win32::API::pack;

}

use Carp;

use strict;

                #### API declarations ####

no strict 'subs';       # these may be imported someday

use vars qw(

        $_CloseHandle           $_CreateFile            $_GetCommState

        $_ReadFile              $_SetCommState          $_SetupComm

        $_PurgeComm             $_CreateEvent           $_GetCommTimeouts

        $_SetCommTimeouts       $_GetCommProperties     $_ClearCommBreak

        $_ClearCommError        $_EscapeCommFunction    $_GetCommConfig

        $_GetCommMask           $_GetCommModemStatus    $_SetCommBreak

        $_SetCommConfig         $_SetCommMask           $_TransmitCommChar

        $_WaitCommEvent         $_WriteFile             $_ResetEvent

        $_GetOverlappedResult

);

$_CreateFile = new Win32::API("kernel32", "CreateFile",

         [P, N, N, N, N, N, N], N);

$_CloseHandle = new Win32::API("kernel32", "CloseHandle", [N], N);

$_GetCommState = new Win32::API("kernel32", "GetCommState", [N, P], I);

$_SetCommState = new Win32::API("kernel32", "SetCommState", [N, P], I);

$_SetupComm = new Win32::API("kernel32", "SetupComm", [N, N, N], I);

$_PurgeComm = new Win32::API("kernel32", "PurgeComm", [N, N], I);

$_CreateEvent = new Win32::API("kernel32", "CreateEvent", [P, I, I, P], N);

$_GetCommTimeouts = new Win32::API("kernel32", "GetCommTimeouts",

         [N, P], I);

$_SetCommTimeouts = new Win32::API("kernel32", "SetCommTimeouts",

         [N, P], I);

$_GetCommProperties = new Win32::API("kernel32", "GetCommProperties",

         [N, P], I);

$_ReadFile = new Win32::API("kernel32", "ReadFile", [N, P, N, P, P], I);

$_WriteFile = new Win32::API("kernel32", "WriteFile", [N, P, N, P, P], I);

$_TransmitCommChar = new Win32::API("kernel32", "TransmitCommChar", [N, I], I);

$_ClearCommBreak = new Win32::API("kernel32", "ClearCommBreak", [N], I);

$_SetCommBreak = new Win32::API("kernel32", "SetCommBreak", [N], I);

$_ClearCommError = new Win32::API("kernel32", "ClearCommError", [N, P, P], I);

$_EscapeCommFunction = new Win32::API("kernel32", "EscapeCommFunction",

         [N, N], I);

$_GetCommModemStatus = new Win32::API("kernel32", "GetCommModemStatus",

         [N, P], I);

$_GetOverlappedResult = new Win32::API("kernel32", "GetOverlappedResult",

         [N, P, P, I], I);

#### these are not used yet

$_GetCommConfig = new Win32::API("kernel32", "GetCommConfig", [N, P, P], I);

$_GetCommMask = new Win32::API("kernel32", "GetCommMask", [N, P], I);

$_SetCommConfig = new Win32::API("kernel32", "SetCommConfig", [N, P, N], I);

$_SetCommMask = new Win32::API("kernel32", "SetCommMask", [N, N], I);

$_WaitCommEvent = new Win32::API("kernel32", "WaitCommEvent", [N, P, P], I);

$_ResetEvent = new Win32::API("kernel32", "ResetEvent", [N], I);

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $RBUF_Size);

$VERSION = '0.19';

$RBUF_Size = 4096;

require Exporter;

## require AutoLoader;

@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export

# names by default without a very good reason. Use EXPORT_OK instead.

# Do not simply export all your public functions/methods/constants.

@EXPORT= qw();

@EXPORT_OK= qw();

%EXPORT_TAGS = (STAT    => [qw( BM_fCtsHold     BM_fDsrHold

                                BM_fRlsdHold    BM_fXoffHold

                                BM_fXoffSent    BM_fEof

                                BM_fTxim        BM_AllBits

                                MS_CTS_ON       MS_DSR_ON

                                MS_RING_ON      MS_RLSD_ON

                                CE_RXOVER       CE_OVERRUN

                                CE_RXPARITY     CE_FRAME

                                CE_BREAK        CE_TXFULL

                                CE_MODE         ST_BLOCK

                                ST_INPUT        ST_OUTPUT

                                ST_ERROR )],

                RAW     => [qw( CloseHandle             CreateFile

                                GetCommState            ReadFile

                                SetCommState            SetupComm

                                PurgeComm               CreateEvent

                                GetCommTimeouts         SetCommTimeouts

                                GetCommProperties       ClearCommBreak

                                ClearCommError          EscapeCommFunction

                                GetCommConfig           GetCommMask

                                GetCommModemStatus      SetCommBreak

                                SetCommConfig           SetCommMask

                                TransmitCommChar        WaitCommEvent

                                WriteFile               ResetEvent

                                GetOverlappedResult

                                PURGE_TXABORT           PURGE_RXABORT

                                PURGE_TXCLEAR           PURGE_RXCLEAR

                                SETXOFF                 SETXON

                                SETRTS                  CLRRTS

                                SETDTR                  CLRDTR

                                SETBREAK                CLRBREAK

                                EV_RXCHAR               EV_RXFLAG

                                EV_TXEMPTY              EV_CTS

                                EV_DSR                  EV_RLSD

                                EV_BREAK                EV_ERR

                                EV_RING                 EV_PERR

                                EV_RX80FULL             EV_EVENT1

                                EV_EVENT2               ERROR_IO_INCOMPLETE

                                ERROR_IO_PENDING )],

              COMMPROP  => [qw( BAUD_USER       BAUD_075        BAUD_110

                                BAUD_134_5      BAUD_150        BAUD_300

                                BAUD_600        BAUD_1200       BAUD_1800

                                BAUD_2400       BAUD_4800       BAUD_7200

                                BAUD_9600       BAUD_14400      BAUD_19200

                                BAUD_38400      BAUD_56K        BAUD_57600

                                BAUD_115200     BAUD_128K

                                PST_FAX         PST_LAT         PST_MODEM

                                PST_RS232       PST_RS422       PST_RS423

                                PST_RS449       PST_SCANNER     PST_X25

                                PST_NETWORK_BRIDGE      PST_PARALLELPORT

                                PST_TCPIP_TELNET        PST_UNSPECIFIED

                                PCF_INTTIMEOUTS         PCF_PARITY_CHECK

                                PCF_16BITMODE           PCF_DTRDSR

                                PCF_SPECIALCHARS        PCF_RLSD

                                PCF_RTSCTS              PCF_SETXCHAR

                                PCF_TOTALTIMEOUTS       PCF_XONXOFF

                                SP_BAUD         SP_DATABITS     SP_HANDSHAKING

                                SP_PARITY       SP_PARITY_CHECK SP_RLSD

                                SP_STOPBITS     SP_SERIALCOMM

                                DATABITS_5      DATABITS_6      DATABITS_7

                                DATABITS_8      DATABITS_16     DATABITS_16X

                                STOPBITS_10     STOPBITS_15     STOPBITS_20

                                PARITY_SPACE    PARITY_NONE     PARITY_ODD

                                PARITY_EVEN     PARITY_MARK

                                COMMPROP_INITIALIZED )],

                DCB     => [qw( CBR_110         CBR_300         CBR_600

                                CBR_1200        CBR_2400        CBR_4800

                                CBR_9600        CBR_14400       CBR_19200

                                CBR_38400       CBR_56000       CBR_57600

                                CBR_115200      CBR_128000      CBR_256000

                                DTR_CONTROL_DISABLE     DTR_CONTROL_ENABLE

                                DTR_CONTROL_HANDSHAKE   RTS_CONTROL_DISABLE

                                RTS_CONTROL_ENABLE      RTS_CONTROL_HANDSHAKE

                                RTS_CONTROL_TOGGLE

                                EVENPARITY      MARKPARITY      NOPARITY

                                ODDPARITY       SPACEPARITY

                                ONESTOPBIT      ONE5STOPBITS    TWOSTOPBITS

                                FM_fBinary              FM_fParity

                                FM_fOutxCtsFlow         FM_fOutxDsrFlow

                                FM_fDtrControl          FM_fDsrSensitivity

                                FM_fTXContinueOnXoff    FM_fOutX

                                FM_fInX                 FM_fErrorChar

                                FM_fNull                FM_fRtsControl

                                FM_fAbortOnError        FM_fDummy2 )],

                PARAM   => [qw( LONGsize        SHORTsize       OS_Error

                                nocarp          internal_buffer yes_true )]);

Exporter::export_ok_tags('STAT', 'RAW', 'COMMPROP', 'DCB', 'PARAM');

$EXPORT_TAGS{ALL} = \@EXPORT_OK;

#### subroutine wrappers for API calls

sub CloseHandle {

    return unless ( 1 == @_ );

    return $_CloseHandle->Call( shift );

}

sub CreateFile {

    return $_CreateFile->Call( @_ );

    # returns handle

}

sub GetCommState {

    return $_GetCommState->Call( @_ );

}

sub SetCommState {

    return $_SetCommState->Call( @_ );

}

sub SetupComm {

    return $_SetupComm->Call( @_ );

}

sub PurgeComm {

    return $_PurgeComm->Call( @_ );

}

sub CreateEvent {

    return $_CreateEvent->Call( @_ );

}

sub GetCommTimeouts {

    return $_GetCommTimeouts->Call( @_ );

}

sub SetCommTimeouts {

    return $_SetCommTimeouts->Call( @_ );

}

sub GetCommProperties {

    return $_GetCommProperties->Call( @_ );

}

sub ReadFile {

    return $_ReadFile->Call( @_ );

}

sub WriteFile {

    return $_WriteFile->Call( @_ );

}

sub TransmitCommChar {

    return $_TransmitCommChar->Call( @_ );

}

sub ClearCommBreak {

    return unless ( 1 == @_ );

    return $_ClearCommBreak->Call( shift );

}

sub SetCommBreak {

    return unless ( 1 == @_ );

    return $_SetCommBreak->Call( shift );

}

sub ClearCommError {

    return $_ClearCommError->Call( @_ );

}

sub EscapeCommFunction {

    return $_EscapeCommFunction->Call( @_ );

}

sub GetCommModemStatus {

    return $_GetCommModemStatus->Call( @_ );

}

sub GetOverlappedResult {

    return $_GetOverlappedResult->Call( @_ );

}

sub GetCommConfig {

    return $_GetCommConfig->Call( @_ );

}

sub GetCommMask {

    return $_GetCommMask->Call( @_ );

}

sub SetCommConfig {

    return $_SetCommConfig->Call( @_ );

}

sub SetCommMask {

    return $_SetCommMask->Call( @_ );

}

sub WaitCommEvent {

    return $_WaitCommEvent->Call( @_ );

}

sub ResetEvent {

    return unless ( 1 == @_ );

    return $_ResetEvent->Call( shift );

}

#### "constant" declarations from Win32 header files ####

#### compatible with ActiveState ####

## COMMPROP structure

sub SP_SERIALCOMM       { 0x1 }

sub BAUD_075            { 0x1 }

sub BAUD_110            { 0x2 }

sub BAUD_134_5          { 0x4 }

sub BAUD_150            { 0x8 }

sub BAUD_300            { 0x10 }

sub BAUD_600            { 0x20 }

sub BAUD_1200           { 0x40 }

sub BAUD_1800           { 0x80 }

sub BAUD_2400           { 0x100 }

sub BAUD_4800           { 0x200 }

sub BAUD_7200           { 0x400 }

sub BAUD_9600           { 0x800 }

sub BAUD_14400          { 0x1000 }

sub BAUD_19200          { 0x2000 }

sub BAUD_38400          { 0x4000 }

sub BAUD_56K            { 0x8000 }

sub BAUD_57600          { 0x40000 }

sub BAUD_115200         { 0x20000 }

sub BAUD_128K           { 0x10000 }

sub BAUD_USER           { 0x10000000 }

sub PST_FAX             { 0x21 }

sub PST_LAT             { 0x101 }

sub PST_MODEM           { 0x6 }

sub PST_NETWORK_BRIDGE  { 0x100 }

sub PST_PARALLELPORT    { 0x2 }

sub PST_RS232           { 0x1 }

sub PST_RS422           { 0x3 }

sub PST_RS423           { 0x4 }

sub PST_RS449           { 0x5 }

sub PST_SCANNER         { 0x22 }

sub PST_TCPIP_TELNET    { 0x102 }

sub PST_UNSPECIFIED     { 0 }

sub PST_X25             { 0x103 }

sub PCF_16BITMODE       { 0x200 }

sub PCF_DTRDSR          { 0x1 }

sub PCF_INTTIMEOUTS     { 0x80 }

sub PCF_PARITY_CHECK    { 0x8 }

sub PCF_RLSD            { 0x4 }

sub PCF_RTSCTS          { 0x2 }

sub PCF_SETXCHAR        { 0x20 }

sub PCF_SPECIALCHARS    { 0x100 }

sub PCF_TOTALTIMEOUTS   { 0x40 }

sub PCF_XONXOFF         { 0x10 }

sub SP_BAUD             { 0x2 }

sub SP_DATABITS         { 0x4 }

sub SP_HANDSHAKING      { 0x10 }

sub SP_PARITY           { 0x1 }

sub SP_PARITY_CHECK     { 0x20 }

sub SP_RLSD             { 0x40 }

sub SP_STOPBITS         { 0x8 }

sub DATABITS_5          { 1 }

sub DATABITS_6          { 2 }

sub DATABITS_7          { 4 }

sub DATABITS_8          { 8 }

sub DATABITS_16         { 16 }

sub DATABITS_16X        { 32 }

sub STOPBITS_10         { 1 }

sub STOPBITS_15         { 2 }

sub STOPBITS_20         { 4 }

sub PARITY_NONE         { 256 }

sub PARITY_ODD          { 512 }

sub PARITY_EVEN         { 1024 }

sub PARITY_MARK         { 2048 }

sub PARITY_SPACE        { 4096 }

sub COMMPROP_INITIALIZED        { 0xe73cf52e }

## DCB structure

sub CBR_110                     { 110 }

sub CBR_300                     { 300 }

sub CBR_600                     { 600 }

sub CBR_1200                    { 1200 }

sub CBR_2400                    { 2400 }

sub CBR_4800                    { 4800 }

sub CBR_9600                    { 9600 }

sub CBR_14400                   { 14400 }

sub CBR_19200                   { 19200 }

sub CBR_38400                   { 38400 }

sub CBR_56000                   { 56000 }

sub CBR_57600                   { 57600 }

sub CBR_115200                  { 115200 }

sub CBR_128000                  { 128000 }

sub CBR_256000                  { 256000 }

sub DTR_CONTROL_DISABLE         { 0 }

sub DTR_CONTROL_ENABLE          { 1 }

sub DTR_CONTROL_HANDSHAKE       { 2 }

sub RTS_CONTROL_DISABLE         { 0 }

sub RTS_CONTROL_ENABLE          { 1 }

sub RTS_CONTROL_HANDSHAKE       { 2 }

sub RTS_CONTROL_TOGGLE          { 3 }

sub EVENPARITY                  { 2 }

sub MARKPARITY                  { 3 }

sub NOPARITY                    { 0 }

sub ODDPARITY                   { 1 }

sub SPACEPARITY                 { 4 }

sub ONESTOPBIT                  { 0 }

sub ONE5STOPBITS                { 1 }

sub TWOSTOPBITS                 { 2 }

## Flowcontrol bit mask in DCB

sub FM_fBinary                  { 0x1 }

sub FM_fParity                  { 0x2 }

sub FM_fOutxCtsFlow             { 0x4 }

sub FM_fOutxDsrFlow             { 0x8 }

sub FM_fDtrControl              { 0x30 }

sub FM_fDsrSensitivity          { 0x40 }

sub FM_fTXContinueOnXoff        { 0x80 }

sub FM_fOutX                    { 0x100 }

sub FM_fInX                     { 0x200 }

sub FM_fErrorChar               { 0x400 }

sub FM_fNull                    { 0x800 }

sub FM_fRtsControl              { 0x3000 }

sub FM_fAbortOnError            { 0x4000 }

sub FM_fDummy2                  { 0xffff8000 }

## COMSTAT bit mask

sub BM_fCtsHold         { 0x1 }  

sub BM_fDsrHold         { 0x2 }  

sub BM_fRlsdHold        { 0x4 }  

sub BM_fXoffHold        { 0x8 }  

sub BM_fXoffSent        { 0x10 }  

sub BM_fEof             { 0x20 }      

sub BM_fTxim            { 0x40 }      

sub BM_AllBits          { 0x7f }      

## PurgeComm bit mask

sub PURGE_TXABORT       { 0x1 }  

sub PURGE_RXABORT       { 0x2 }  

sub PURGE_TXCLEAR       { 0x4 }  

sub PURGE_RXCLEAR       { 0x8 }  

## GetCommModemStatus bit mask

sub MS_CTS_ON           { 0x10 }  

sub MS_DSR_ON           { 0x20 }  

sub MS_RING_ON          { 0x40 }  

sub MS_RLSD_ON          { 0x80 }  

## EscapeCommFunction operations

sub SETXOFF             { 0x1 }

sub SETXON              { 0x2 }

sub SETRTS              { 0x3 }

sub CLRRTS              { 0x4 }

sub SETDTR              { 0x5 }

sub CLRDTR              { 0x6 }

sub SETBREAK            { 0x8 }

sub CLRBREAK            { 0x9 }

## ClearCommError bit mask

sub CE_RXOVER           { 0x1 }

sub CE_OVERRUN          { 0x2 }

sub CE_RXPARITY         { 0x4 }

sub CE_FRAME            { 0x8 }

sub CE_BREAK            { 0x10 }

sub CE_TXFULL           { 0x100 }

#### LPT only

# sub CE_PTO            { 0x200 }

# sub CE_IOE            { 0x400 }

# sub CE_DNS            { 0x800 }

# sub CE_OOP            { 0x1000 }

#### LPT only

sub CE_MODE             { 0x8000 }

## GetCommMask bits

sub EV_RXCHAR           { 0x1 }

sub EV_RXFLAG           { 0x2 }

sub EV_TXEMPTY          { 0x4 }

sub EV_CTS              { 0x8 }

sub EV_DSR              { 0x10 }

sub EV_RLSD             { 0x20 }

sub EV_BREAK            { 0x40 }

sub EV_ERR              { 0x80 }

sub EV_RING             { 0x100 }

sub EV_PERR             { 0x200 }

sub EV_RX80FULL         { 0x400 }

sub EV_EVENT1           { 0x800 }

sub EV_EVENT2           { 0x1000 }

## Allowed OVERLAP errors

sub ERROR_IO_INCOMPLETE { 996 }

sub ERROR_IO_PENDING    { 997 }

#### "constant" declarations compatible with ActiveState ####

my $DCBformat="LLLSSSCCCCCCCCS";

my $CP_format1="SSLLLLLLLLLSSLLLLSA*";                   # rs232

my $CP_format6="SSLLLLLLLLLSSLLLLLLLLLLLLLLLLLLLLLLLA*"; # modem

my $CP_format0="SA50LA244";                              # pre-read

my $OVERLAPPEDformat="LLLLL";

my $TIMEOUTformat="LLLLL";

my $COMSTATformat="LLL";

my $cfg_file_sig="Win32API::SerialPort_Configuration_File -- DO NOT EDIT --\n";

sub SHORTsize { 0xffff; }

sub LONGsize { 0xffffffff; }

sub ST_BLOCK    {0}     # status offsets for caller

sub ST_INPUT    {1}

sub ST_OUTPUT   {2}

sub ST_ERROR    {3}     # latched

#### Package variable declarations ####

my @Yes_resp = (

               "YES","Y",

               "ON",

               "TRUE","T",

               "1"

               );

my @binary_opt = (0, 1);

my @byte_opt = (0, 255);

my $Babble = 0;

my $testactive = 0;     # test mode active

## my $null=[];

my $null=0;

my $zero=0;

# Preloaded methods go here.

sub OS_Error { print Win32::FormatMessage ( Win32::GetLastError() ); }

sub get_tick_count { return Win32::GetTickCount(); }

    # test*.t only - suppresses default messages

sub set_no_messages {

    return unless (@_ == 2);

    $testactive = yes_true($_[1]);

}

sub nocarp { return $testactive }

sub internal_buffer { return $RBUF_Size }

sub yes_true {

    my $choice = uc shift;

    my $ans = 0;

    foreach (@Yes_resp) { $ans = 1 if ( $choice eq $_ ) }

    return $ans;

}

sub new {

    my $proto = shift;

    my $class = ref($proto) || $proto;

    my $self  = {};

    my $ok    = 0;              # API return value

    my $hr    = 0;              # temporary hashref

    my $fmask = 0;              # temporary for bit banging

    my $fix_baud = 0;

    my $key;

    my $value;

    my $CommPropBlank = " ";

        # COMMPROP only used during new

    my $CommProperties          = " "x300; # extra buffer for modems

    my $CP_Length               = 0;

    my $CP_Version              = 0;

    my $CP_ServiceMask          = 0;

    my $CP_Reserved1            = 0;

    my $CP_MaxBaud              = 0;

    my $CP_ProvCapabilities     = 0;

    my $CP_SettableParams       = 0;

    my $CP_SettableBaud         = 0;

    my $CP_SettableData         = 0;

    my $CP_SettableStopParity   = 0;

    my $CP_ProvSpec1            = 0;

    my $CP_ProvSpec2            = 0;

    my $CP_ProvChar_start       = 0;

    my $CP_Filler               = 0;

        # MODEMDEVCAPS

    my $MC_ReqSize              = 0;

    my $MC_SpecOffset           = 0;

    my $MC_SpecSize             = 0;

    my $MC_ProvVersion          = 0;

    my $MC_ManfOffset           = 0;

    my $MC_ManfSize             = 0;

    my $MC_ModOffset            = 0;

    my $MC_ModSize              = 0;

    my $MC_VerOffset            = 0;

    my $MC_VerSize              = 0;

    my $MC_DialOpt              = 0;

    my $MC_CallFailTime         = 0;

    my $MC_IdleTime             = 0;

    my $MC_SpkrVol              = 0;

    my $MC_SpkrMode             = 0;

    my $MC_ModOpt               = 0;

    my $MC_MaxDTE               = 0;

    my $MC_MaxDCE               = 0;

    my $MC_Filler               = 0;

    $self->{NAME}     = shift;

    my $quiet         = shift;

    $self->{"_HANDLE"}=CreateFile("$self->{NAME}",

                                  0xc0000000,

                                  0,   

                                  $null,

                                  3,

                                  0x40000000,

                                  $null);

        # device name

        # GENERIC_READ | GENERIC_WRITE

        # no FILE_SHARE_xx

        # no SECURITY_xx

        # OPEN_EXISTING

        # FILE_FLAG_OVERLAPPED

        # template file

    unless ($self->{"_HANDLE"} >= 1) {

        $self->{"_HANDLE"} = 0;

        return 0 if ($quiet);

        return if (nocarp);

        OS_Error;

        carp "can't open device: $self->{NAME}\n";

        return;

    }

    # let Win32 know we allowed room for modem properties

    $CP_Length = 300;

    $CP_ProvSpec1 = COMMPROP_INITIALIZED;

    $CommProperties = pack($CP_format0,

                           $CP_Length,

                           $CommPropBlank,

                           $CP_ProvSpec1,

                           $CommPropBlank);

    $ok=GetCommProperties($self->{"_HANDLE"}, $CommProperties);

    unless ( $ok ) {

        OS_Error;

        carp "can't get COMMPROP block";

        undef $self;

        return;

    }

    ($CP_Length,

     $CP_Version,

     $CP_ServiceMask,

     $CP_Reserved1,

     $self->{"_MaxTxQueue"},

     $self->{"_MaxRxQueue"},

     $CP_MaxBaud,

     $self->{"_TYPE"},

     $CP_ProvCapabilities,

     $CP_SettableParams,

     $CP_SettableBaud,

     $CP_SettableData,

     $CP_SettableStopParity,

     $self->{WRITEBUF},

     $self->{READBUF},

     $CP_ProvSpec1,

     $CP_ProvSpec2,

     $CP_ProvChar_start,

     $CP_Filler)= unpack($CP_format1, $CommProperties);

    if (($CP_Length > 66) and ($self->{"_TYPE"} == PST_RS232)) {

        carp "invalid COMMPROP block length= $CP_Length";

        undef $self;

        return;

    }

    if ($CP_ServiceMask != SP_SERIALCOMM) {

        carp "doesn't claim to be a serial port\n";

        undef $self;

        return;

    }

    if ($self->{"_TYPE"} == PST_MODEM) {

        ($CP_Length,

         $CP_Version,

         $CP_ServiceMask,

         $CP_Reserved1,

         $self->{"_MaxTxQueue"},

         $self->{"_MaxRxQueue"},

         $CP_MaxBaud,

         $self->{"_TYPE"},

         $CP_ProvCapabilities,

         $CP_SettableParams,

         $CP_SettableBaud,

         $CP_SettableData,

         $CP_SettableStopParity,

         $self->{WRITEBUF},

         $self->{READBUF},

         $CP_ProvSpec1,

         $CP_ProvSpec2,

         $CP_ProvChar_start,

         $MC_ReqSize,

         $MC_SpecOffset,

         $MC_SpecSize,

         $MC_ProvVersion,

         $MC_ManfOffset,

         $MC_ManfSize,

         $MC_ModOffset,

         $MC_ModSize,

         $MC_VerOffset,

         $MC_VerSize,

         $MC_DialOpt,

         $MC_CallFailTime,

         $MC_IdleTime,

         $MC_SpkrVol,

         $MC_SpkrMode,

         $MC_ModOpt,

         $MC_MaxDTE,

         $MC_MaxDCE,

         $MC_Filler)= unpack($CP_format6, $CommProperties);

        if ($Babble) {

            printf "\nMODEMDEVCAPS:\n";

            printf "\$MC_ActualSize= %d\n", $CP_ProvChar_start;

            printf "\$MC_ReqSize= %d\n", $MC_ReqSize;

            printf "\$MC_SpecOffset= %d\n", $MC_SpecOffset;

            printf "\$MC_SpecSize= %d\n", $MC_SpecSize;

            if ($MC_SpecOffset) {

                printf "    DeviceSpecificData= %s\n", substr ($CommProperties,

                                         60+$MC_SpecOffset, $MC_SpecSize);

            }

            printf "\$MC_ProvVersion= %d\n", $MC_ProvVersion;

            printf "\$MC_ManfOffset= %d\n", $MC_ManfOffset;

            printf "\$MC_ManfSize= %d\n", $MC_ManfSize;

            if ($MC_ManfOffset) {

                printf "    Manufacturer= %s\n", substr ($CommProperties,

                                         60+$MC_ManfOffset, $MC_ManfSize);

            }

            printf "\$MC_ModOffset= %d\n", $MC_ModOffset;

            printf "\$MC_ModSize= %d\n", $MC_ModSize;

            if ($MC_ModOffset) {

                printf "    Model= %s\n", substr ($CommProperties,

                                         60+$MC_ModOffset, $MC_ModSize);

            }

            printf "\$MC_VerOffset= %d\n", $MC_VerOffset;

            printf "\$MC_VerSize= %d\n", $MC_VerSize;

            if ($MC_VerOffset) {

                printf "    Version= %s\n", substr ($CommProperties,

                                         60+$MC_VerOffset, $MC_VerSize);

            }

            printf "\$MC_DialOpt= %lx\n", $MC_DialOpt;

            printf "\$MC_CallFailTime= %d\n", $MC_CallFailTime;

            printf "\$MC_IdleTime= %d\n", $MC_IdleTime;

            printf "\$MC_SpkrVol= %d\n", $MC_SpkrVol;

            printf "\$MC_SpkrMode= %d\n", $MC_SpkrMode;

            printf "\$MC_ModOpt= %lx\n", $MC_ModOpt;

            printf "\$MC_MaxDTE= %d\n", $MC_MaxDTE;

            printf "\$MC_MaxDCE= %d\n", $MC_MaxDCE;

            $MC_Filler= $MC_Filler;                     # for -w

        }

##        $MC_ReqSize = 250;

        if ($CP_ProvChar_start != $MC_ReqSize) {

            printf "\nARGH, a Bug! The \$CommProperties buffer must be ";

            printf "at least %d bytes.\n", $MC_ReqSize+60;

        }

    }

##    if (1 | $Babble) {

    if ($Babble) {

        printf "\$CP_Length= %d\n", $CP_Length;

        printf "\$CP_Version= %d\n", $CP_Version;

        printf "\$CP_ServiceMask= %lx\n", $CP_ServiceMask;