use strict;
use warnings;
use Win32::SerialPort;
use Term::ReadKey;

my ($char, $num, $run);

my $port = Win32::SerialPort->new('COM1')
    or die "Oops!\n";

$| = 1;

# Fehlermeldungen einschalten
$port->error_msg(1); 
$port->user_msg(1);

# Parameter setzen
$port->baudrate(19200)    || die "baudrate geht nicht\n";
$port->parity('none')	    || die "parity geht nicht\n";
$port->databits(8)        || die "databits geht nicht\n";
$port->stopbits(1)        || die "stopbits geht nicht\n";
$port->handshake("rts") 	|| die "handshake geht nicht\n";
# defined, weil "0" ein legaler Rueckgabewert ist
defined $port->parity_enable('T')	|| die "parity_enable geht nicht\n";

# Wartezeit fuer Lesen eines Zeichens
$port->read_char_time(1);
# Wartezeit fuer Lese-Overhead
$port->read_const_time(10);

# Setup fuer dummes Terminal,
# kann je nach Anwendung variieren
$port->stty_icrnl(1);
$port->stty_ocrnl(0);  #
$port->stty_onlcr(0);  #
$port->stty_opost(1);

# Signalhandler fuer Stg-C
$SIG{INT}  = sub { $run = 0 };

$port->are_match("BUSY","CONNECT",
                  "OK","NO DIALTONE",
                  "ERROR","RING",
                  "NO CARRIER","NO ANSWER");

print "Modem einstellen\n";
WriteData($port, "ATX4E0\r");
# unter Linux auch: $port->write("ATE0X4\r");

# Wait one second for a response
printf "Antwort: %s\n", WaitFor($port, 1); 

print "Starte Wahlvorgang\n";
WriteData($port, "ATDT123456789\r"); 
# unter Linux auch: $port->write("ATDT5551234\r"); 

printf "Antwort: %s\n", WaitFor($port, 30);

$port -> close();
undef $port;


sub WaitFor # $port, $timeout
  {
  # Warte auf Antwortstring, der in are_match definiert ist
  my $port = shift;
  my $gotit = '';
  my $timeout = 10 * shift;  # Wartezeit in 1/10 s   
  $port->lookclear;          # Puffer loeschen
  while(1) 
    {
    unless (defined ($gotit = $port->lookfor))
      {
      # Antwort undefiniert
      return('>>> undefined'); 
      }
    if ($gotit ne '') 
      {
      # Es wurde etwas gefunden
      my ($found, @junk) = $port->lastlook;
      return($gotit . $found);
      }
    if ($port->reset_error)
      {
      # Kommunikations abbruch
      return('>>> reset error'); 
      }
     if ($timeout <= 0)
      {
      # Zeit abgelaufen
      return('>>> timeout'); 
      }
    # etwas warten, $timeout runterzaehlen
    $timeout--;
    select(undef, undef, undef, 0.1);
    }
  }


sub WriteData # $port, $data
  {
  # Sendefunktion
  my ($num, $char, $cc);
  my $port = shift;
  my $string = shift;
  for $char (split(//, $string))
    {
    # Behandlung von Carriage Return und Line Feed
	  $char =~ s/\r/\n/ogs if ($port->stty_ocrnl);
	  $char =~ s/\n/\r\n/ogs if ($port->stty_opost && $port->stty_onlcr);
	  # Zeichen auf der seriellen Schnittstelle ausgeben
    $port->write($char);
    ($num, $cc) = $port->read(1);
    if ($num > 0)
      {
      # Behandlung von Carriage Return und Line Feed
  	  $cc =~ s/\r/\n/ogs if ($port->stty_icrnl);
	    # auf dem Bildschirm ausgeben
	    print $cc;
      }
    }
  }