SSA for many .fio Files

The following script demonstrates how the SSA procedure is applied to certain .fio files of the current directory.

#!/usr/bin/perl -w
#
# this script does a ssa (single scan analysis, implemented in spectra) for files
# in the working directory that begin with string to be given at program call, e.g.
# 'ssa.pl test' will perfrom a ssa for each '.fio'-file that begin with 'test'
#
# output of script is a file named by the search string with extension
# 'ssa', e.g. 'test.ssa' for given program call 'perl ssa.pl test'
#
# limitations: no error handling, i.e. program terminates if fio-file contains no data
# (no notification, empty output file if first input file conains no data etc.)
#
#
# T. Kracht, A. Rothkirch
#
# September 2005

use strict;
use Spectra;
use GQE;
my ($s, $ssa_status, $cms, $midpoint, $int,
    $bg_int, $fwhm, $peak_x, $peak_y,
    $bg_l, $bg_r);

if( !@ARGV)
{
    print_usage();
    goto finish;
}
#
# the default prefix
#
my $pattern = $ARGV[0];

opendir( D, "./");
my @files = sort readdir(D);
closedir( D);

# define and open output file
open( FH, ">$pattern.ssa");

# write file header: descriptor for columns
print FH "filename, cms, midpoint , integral, bg_int, fwhm, x_pos_at_max, counts_at_max, bg_l, bg_r\n";

# loop over files
foreach my $file (@files)
{
    #
    # select files that begin with pattern given in programm call 
    #
    next if( $file !~ /^$pattern.+\.fio/i);
    #
    # the file may have several columns, we use the
    # assignment 1 -> x, 2 -> y
    #
    $s = SCAN->read( file_name => $file, qw( x 1 y 2));
    ($ssa_status, $cms, $midpoint, $int,
     $bg_int, $fwhm, $peak_x, $peak_y, $bg_l, $bg_r) = $s->ssa();
    if( $ssa_status)
    {
	print "$file, $cms, $midpoint, $int, $bg_int, $fwhm, $peak_x, $peak_y, $bg_l, $bg_r\n";

	#
	# write ssa result to file
	#
	print FH "$file, $cms, $midpoint , $int, $bg_int, $fwhm, $peak_x, $peak_y, $bg_l, $bg_r\n";
	#
	# un-comment the following lines to inspect the data and see the ssa result
	#
	#	$s->display();
	#	Spectra::prtc(); 
	#
    }
    $s->delete();
}
close( FH);

finish:
;
#
#
#
sub print_usage
{
    print << "EOF"

  Usage: 

    ./ssa.pl prefix

EOF
;
}