use Win32API::CommPort qw(:PARAM :STAT 0.19);
use Win32::SerialPort;

my $comm_port = 'COM1';

# serielle Schnittstelle initialisieren
my $serial_port = new Win32::SerialPort($comm_port) or do
{ log_write error => qq~Kann "$comm_port" nicht öffnen.~;
  exit;
};
$serial_port->handshake('rts');
$serial_port->baudrate(9600);
$serial_port->databits(7);
$serial_port->parity('even');
$serial_port->parity_enable(1);   # Paritätsprüfung einschalten
$serial_port->stopbits(2);
$serial_port->buffers(4096, 4096);
$serial_port->error_char(0xff);   # zum Paritätsfehler erkennen
$serial_port->write_settings or do
{ log_write error => qq~Kann Settingdaten nicht zu "$comm_port" schreiben.~;
  exit;
};

# alle Puffer löschen
$serial_port->purge_all;
$serial_port->reset_error;
# Portstatus
for (@nc_prog)   # NC-Programme übertrage ich da
{ # Zeilenende formatieren
  s/\n/\x0D\x0A\x0D/g;
  my $start = time;
  while (length $_)
  { my ($blocking_flags, $in_bytes, $out_bytes, $latch_error_flags) = $serial_port->status
    or do
    { log_write error => qq~Portstatus "Status von $comm_port" konnte nicht gelesen werden.~;
      exit;
    };
    if (time > $start + TIMEOUT_COM_T)
    { # Timeout
      $blocking_flags & BM_fCtsHold and return qq~"$comm_port" blockiert: wartet wegen CTS.~;
      $blocking_flags & BM_fDsrHold and return qq~"$comm_port" blockiert: wartet wegen DSR.~;
      $blocking_flags & BM_fRlsdHold and return qq~"$comm_port" blockiert: wartet wegen Rlsd.~;
      $blocking_flags & BM_fXoffHold and return qq~"$comm_port" blockiert: wartet wegen Xoff.~;
      $blocking_flags & BM_fXoffSent and return qq~"$comm_port" blockiert: Xoff gesendet.~;
      $blocking_flags & BM_fEof and return qq~"$comm_port" blockiert: Eof.~;
      $blocking_flags & BM_fTxim and return qq~"$comm_port" blockiert: Txim.~;
      $blocking_flags and return qq~"$comm_port" blockiert.~;
      return "Konnte Daten nicht innerhalb von @{[TIMEOUT_COM_T]} s zur Maschine senden.";
    }
    $latch_error_flags & CE_RXOVER and return qq~RXOVER-Fehler: "$comm_port".~;
    $latch_error_flags & CE_OVERRUN and return qq~OVERRUN-Fehler: "$comm_port".~;
    $latch_error_flags & CE_TXFULL and return qq~TXFULL-Fehler: "$comm_port".~;
    $latch_error_flags & CE_MODE and return qq~MODE-Fehler: "$comm_port".~;
    $latch_error_flags & CE_RXPARITY and return qq~Paritäts-Fehler: "$comm_port".~;
    $latch_error_flags & CE_FRAME and return qq~Frame-Fehler: "$comm_port".~;
    $latch_error_flags & CE_BREAK and return qq~Break-Fehler: "$comm_port".~;
    $latch_error_flags and return qq~Übertragungsfehler: "$comm_port".~;
    # Timeoutzeit verstreichen lassen
    redo if $blocking_flags;
    # Daten senden und gesendete Anzahl abschneiden
    substr $_, 0, $serial_port->write($_), '';
  }
}