Código Perl:
Ver original#!/usr/bin/perl –w
#
#makes a time intervalo measurement with a sr620 counter
use strict; # programación estricta
use Geotopt; # módulo para leer opciones en los argumentos
use Fcntl
qw(:DEFAULT
:flock); # importamos la función flock() para bloquear accesos a los ficheros
@_ = split ‘/’, $0; # $0 es la ruta completa de este programa # lo dividimos según los delimitadores '/'
my $PROG_NAME = pop @_; # la última parte somos nosotros
my $VERSION;
my $version;
my $help;
my $samples=2;
my $trigger_level = -99.;
my $impedance='';
my $verbose;
my $device="";
my $cmd;
my $answer;
my $imp_value;
my ( $mean, $rel, $std, $min, $max );
my ( $year, $month, $day, $hour, $minu, $sec );
Getopt::Long::Configure ('no_ignore_case_always');
unless ( Getopt::Long::GetOptions ( # si el usuario no nos pasa
'help' => \$help, # alguna de estas opciones
'device=s' => \$device,
'samples=f' => \$samples,
'trigger=f' => \$trigger_level,
'imp=s' => \$impedance,
'V' => \$version,
'v' => \$verbose
)
) {
# nos morimos indicando al usuario cómo obtener ayuda
die "usage: $PROG_NAME -h (for a short help! )\n"; }
( $help ) && help_die(); # si nos pide ayuda se la damos
( $version ) && die "$PROG_NAME - $VERSION\n"; # lo mismo si nos pide número de versión
# check input parameter
# controlamos que el usuario nos haya pasado los parámetros adecuados
# debe indicarnos un dispositivo
( $device eq "" ) and die "FATAL: define device with option –d !!\n"; ( -c
$device ) or die "FATAL: device \"$device\" doesn\'t exist !!\n";
$impedance =~ y/A-Z/a-z/; # la impedancia la pasamos a minúsculas
if ( $impedance eq '50' ) { # si es igual a '50'
$imp_value = 0; # realmente será 0
}
elsif ( $impedance eq '1m' ) { # si es '1m'
$imp_value = 1; # será 1
}
elsif ( $impedance eq 'uhf' ) { # si es 'uhf'
$imp_value = 2; # será 2
}
else {
# y si no, decimos qué valores de impedancia necesitamos
die "FATAL: -I input impedance not 50|1M|UHF !!\n"; }
# ver si el nivel de disparo está dentro del rango (-5,5)
if ( ( $trigger_level < -5. ) or ( $trigger_level > 5. ) ) {
die "FATAL: -t trigger level not in range [-5.0 .. 5.0] !!\n"; }
# el número de muestras no debe superar los 5 millones
if ( $samples > 5e6 ) {
die "FATAL: -s max number of samples = 5e6 !!\n"; }
# y ser más de uno, lógicamente
if ( $samples < 1 ) {
die "FATAL: -s min number of samples = 1 !!\n"; }
# el número de muestras debe ser múltiplo de 1, 2 o 5
my $chk_samples = $samples;
while ( $chk_samples >= 10 ) {
$chk_samples /= 10;
}
if ( ( $chk_samples != 1 ) and ( $chk_samples != 2 ) and ( $chk_samples != 5 ) ) {
die "FATAL: -s number of samples not in step 1,2 or 5 !!\n"; }
# open serial device
# abrimos el dispositivo serie
# cálculo del tiempo máximo
my $timeout = ($samples+2) * 40;
if ( $timeout > 255 ) {
$timeout = 255
}
# llamamos al comando stty con la configuración de velocidad y
# demás parámetros de como queremos que sea la comunicación
system ( "stty 19200 raw – hupcl ignbrk –onlcr –iexten –echo –echoe –echonl -echoctl –echoke –echok min 0 time $timeout –crtscts <$device") and die "Can\'t initialize \"$device\"!\n";
# abrimos el dispositivo en modo lectura/escritura
open SR620
, "+<$device" or die "Can\'t open device \"$device\"!\n";
# lo bloqueamos de forma exclusiva
flock ( SR620
, LOCK_EX
|LOCK_NB
) || die "FATAL: Device \"$device\" already in use!\n";
#initialize sr620 and do measurement
#inicialización y medida
#$cmd = sprintf "*rst; locl 1; term 1,0; levl 1,1.2; armm 1; size %f; term 2,%d; levl 2,%f; mode 0; jttr 0", $samples, $imp_value, $trigger_level;
do { # repetir...
# fichero resultado, lo abrimos en modo añadir
open FILE
, ">>fg5_offset.dat" or die "FATAL: Cant open file!!";
# composición del comando a enviar
# basada en una plantilla
$cmd = sprintf "locl 1; term 1,0; levl 1,1.2; arm 1; size %f; term 2,%d; levl 2,%f; mode 0; jttr 0", $samples, $imp_value, $trigger_level;
( $verbose ) && print "CMD: $cmd\n"; # informamos al usuario print SR620
"$cmd\n"; # y lo mandamos
# otro comando
$cmd =sprintf "autm 0; meas? 0; meas? 1; meas? 2; meas? 3"; ( $verbose ) && print "CMD: $cmd\n"; # ídem print SR620
"$cmd\n"; # ídem $answer = <SR620>; # aquí leemos lo que nos dice
$cmd = sprintf "xall?"; # otro comando ( $verbose ) && print "CMD: $cmd\n"; # ídem $answer = <SR620>; # lo mismo, obtenemos resultado
# si la respuesta comienza con un número o con un '-'
if ( ( defined $answer ) and ( $answer =~ /^\d|-/ ) ) { ( $verbose ) && print $answer; # la mostramos # dividimos la respuesta por sus comas
( $mean, $rel, $std, $min, $max ) = split /,/, $answer;
# si el promedio está definido
# obtenemos la hora y fecha de ahora mismo
($sec,$minu,$hour,$day,$month,$year) = gmtime(time); # y lo sacamos en pantalla
printf "%04d.%02d.%02d %02d:%02d:%02d %.3f %.0f\n", $year+1900, $month+1, $day, $hour, $minu, $sec, $mean*1e9
, $std*1e12
; # y al fichero
printf FILE
"%04d.%02d.%02d %02d:%02d:%02d %.3f %.0f\n", $year+1900, $month+1, $day, $hour, $minu, $sec, $mean*1e9
, $std*1e12
; }
}
else {
# si no, quizás pasó demasiado tiempo
}
$cmd = sprintf "locl 0; size 1; autm 1"; # otro comando print SR620
"$cmd\n"; # que enviamos close FILE
; # y cerramos el fichero } while (1); # ... para siempre
# Mensaje de ayuda
sub help_die {
printf STDERR "usage: $PROG_NAME\n\t-h ( for a short help )\n"; printf STDERR "\t-d serial device\n"; printf STDERR "\t-s number of samples\n"; printf STDERR "\t-t trigger level of input B\n"; printf STDERR "\t-I input impedance of input [50|1M|UHF] B\n"; printf STDERR "\t-v verbose\n"; die "\t-V print program version\n"; }
Había algunos errores. Faltaba un ';', y las comillas simples y dobles estaban todas mal.