Please, how do to write this program for run in Windows XP
Tks.
#!/C:\perl\bin\perl.exe
#===============================================================================
#
# FILE: interfaz1.pl
#
# USAGE: ./interfaz1.pl
#
# DESCRIPTION: Interfaz para el frecuencímetro 1.
# Recoge los datos por el puerto serie (o el conversor USB) y los
# presenta.
#
# REQUIREMENTS: ---
# AUTHOR: Reinoso Guzman
# VERSION: 1.0
# CREATED: 07/01/11 00:53:21
#===============================================================================
use strict;
use warnings;
require 5.003;
use Win32::SerialPort;
$| = 1;
# Abrir el puerto
my $Port = "COM1";
$PortObj = new Win32::SerialPort ($PortName, $quiet)
|| die "Can't open $PortName: $^E\n"; # $quiet is optional
$PortObj->baudrate(9600);
$PortObj->parity("odd");
$PortObj->databits(8);
$PortObj->stopbits(1);
$PortObj->handshake("none");
$PortObj->write_settings;
$PortObj->purge_all();
$PortObj->purge_rx;
open( DEV, "<$PORT" ) || die "Error abriendo $PORT: $_\n";
# Crear la interfaz
my $freq_txt = " No Conectado";
my $mw=tkinit;
$mw->title("Frecuencimetro");
my $freq_lbl = $mw->Label(
-textvariable => \$freq_txt,
-font => "LEDBOARDREVERSED 20",
-anchor => 'e',
-foreground => 'green',
-background => 'black');
$freq_lbl->pack(-expand => 1);
$mw->fileevent(\*DEV, 'readable', [\&update_freq, $freq_lbl]);
$mw->withdraw; # avoid the jumping window bug (perlmonks)
$mw->Popup; # centrar la ventana
# Si nos pasamos un segundo sin recibir, mostramos "no conectado"
$SIG{ALRM} = sub { $freq_txt = " No Conectado"; };
alarm 1;
MainLoop;
# Rutina para actualizar la frecuencia
sub update_freq {
alarm 1;
my $linea = <DEV>;
# Error si no se pudo leer (hemos desconectado el USB)
if (not $linea) {
die "Error de lectura: USB desconectado.\n";
};
my ($valor) = $linea =~ /F:(\d+)/;
if (not defined $valor) {
$freq_txt = " 0.0 kHz";
return;
};
# Redondeo
$valor = int($valor/100 + 0.5); # Redondeo hasta 100Hz
$valor = $valor / 10; # Decimales a partir de kHz
# Lo quitamos si es cero (menos de 100Hz).
if ($valor <= 0) {
$freq_txt = " 0.0 kHz";
return;
};
# Hasta 100Hz, que es un lugar decimal
$valor = sprintf("%.1f", $valor);
# Expresarlo con separador de miles
# (esta linea es de 'Mastering regular expressions')
1 while ($valor =~ s/^(-?\d+)(\d{3})/$1 $2/);
$freq_txt = sprintf("% 13s", "$valor kHz");
}
