view release on metacpan or  search on metacpan

lib/Device/Modem.pm  view on Meta::CPAN

package Device::Modem;
our $VERSION = '1.59';
$VERSION = eval $VERSION;

BEGIN {

    if( index($^O, 'Win') >= 0 ) {   # MSWin32 (and not darwin, cygwin, ...)

        require Win32::SerialPort;
        Win32::SerialPort->import;

        # Import line status constants from Win32::SerialPort module
        *Device::Modem::MS_CTS_ON  = *Win32::SerialPort::MS_CTS_ON;
        *Device::Modem::MS_DSR_ON  = *Win32::SerialPort::MS_DSR_ON;
        *Device::Modem::MS_RING_ON = *Win32::SerialPort::MS_RING_ON;
        *Device::Modem::MS_RLSD_ON = *Win32::SerialPort::MS_RLSD_ON;

    } else {

        require Device::SerialPort;
        Device::SerialPort->import;

        # Import line status constants from Device::SerialPort module
        *Device::Modem::MS_CTS_ON = *Device::SerialPort::MS_CTS_ON;
        *Device::Modem::MS_DSR_ON = *Device::SerialPort::MS_DSR_ON;
        *Device::Modem::MS_RING_ON = *Device::SerialPort::MS_RING_ON;
        *Device::Modem::MS_RLSD_ON = *Device::SerialPort::MS_RLSD_ON;

    }
}

use strict;
use Carp ();

# Constants definition
use constant CTRL_Z => chr(26);
use constant CR => "\r";

# Connection defaults
$Device::Modem::DEFAULT_PORT = index($^O, 'Win') >= 0 ? 'COM1' : '/dev/modem';
$Device::Modem::DEFAULT_INIT_STRING = 'S7=45 S0=0 L1 V1 X4 &c1 E1 Q0';
$Device::Modem::BAUDRATE = 19200;
$Device::Modem::DATABITS = 8;
$Device::Modem::STOPBITS = 1;
$Device::Modem::HANDSHAKE= 'none';
$Device::Modem::PARITY   = 'none';
$Device::Modem::TIMEOUT  = 500;     # milliseconds
$Device::Modem::READCHARS= 130;
$Device::Modem::WAITCMD  = 200;     # milliseconds

# Setup text and numerical response codes
@Device::Modem::RESPONSE = ( 'OK', undef, 'RING', 'NO CARRIER', 'ERROR', undef, 'NO DIALTONE', 'BUSY' );
$Device::Modem::STD_RESPONSE = qr/^(OK|ERROR|COMMAND NOT SUPPORT)$/m;

#%Device::Modem::RESPONSE = (
#	'OK'   => 'Command executed without errors',
#	'RING' => 'Detected phone ring',
#	'NO CARRIER'  => 'Link not established or disconnected',
#	'ERROR'       => 'Invalid command or command line too long',
#	'NO DIALTONE' => 'No dial tone, dialing not possible or wrong mode',
#	'BUSY'        => 'Remote terminal busy'
#);

# object constructor (prepare only object)
sub new {
    my($proto,%aOpt) = @_;                  # Get reference to object
    # Options of object
    my $class = ref($proto) || $proto;      # Get reference to class

    $aOpt{'ostype'} = $^O;                  # Store OSTYPE in object
    $aOpt{'ostype'} = 'windoze' if index( $aOpt{'ostype'}, 'Win' ) >= 0;

    # Initialize flags array
    $aOpt{'flags'} = {};

    # Start as not connected
    $aOpt{'CONNECTED'} = 0;

    $aOpt{'port'} ||= $Device::Modem::DEFAULT_PORT;

    # Instance log object
    $aOpt{'log'} ||= 'file';

    # Force logging to file if this is windoze and user requested syslog mechanism
    $aOpt{'log'} = 'file' if( $aOpt{'ostype'} eq 'windoze' && $aOpt{'log'} =~ /syslog/i );
    $aOpt{'loglevel'} ||= 'warning';

    if( ! ref $aOpt{'log'} ) {
        my($method, @options) = split ',', delete $aOpt{'log'};
        my $logclass = 'Device/Modem/Log/'.ucfirst(lc $method).'.pm';
        my $package = 'Device::Modem::Log::'.ucfirst lc $method;
        eval { require $logclass; };
        unless($@) {
            $aOpt{'_log'} = $package->new( $class, @options );
        } else {
            print STDERR "Failed to require Log package: $@\n";
        }
    } else {

        # User passed an already instanced log object
        $aOpt{'_log'} = $aOpt{'log'};
    }

    if( ref $aOpt{'_log'} && $aOpt{'_log'}->can('loglevel') ) {
        $aOpt{'_log'}->loglevel($aOpt{'loglevel'});
    }

    bless \%aOpt, $class;                   # Instance $class object
}

sub attention {
    my $self = shift;
    $self->log->write('info', 'sending attention sequence...');

    # Send attention sequence
    $self->atsend('+++');

    # Wait for response
    $self->answer();
}