#!/usr/bin/perl
# Dec 2003 HvH. This Gui runs ddump and makes a compact table out of the returns
#
use Tk;
$prdf_file = "/common/a1/junkdata/rc-0102216-MVD-1.prdf";
#print (" prdf_file (1): $prdf_file\n");
if (open INPUT , "ddump_parser.dat") {
#print (" opening name file \n");
$prdf_file = ; chomp $prdf_file;
#print (" prdf_file (2): $prdf_file\n");
close INPUT;
}
else { print "\n Can't open name file - abort\n";}
my $mw = MainWindow->new;
$mw->title(" ddump parser");
$fileframe = $mw->Frame(-background=>"#eecc00", -width=>700, -height=>90) ->pack;
$file_label = $fileframe->Label(-text=>"Using file:", -background=>white)
-> place(-x=>10, -y=>11);
$file_entry = $fileframe->Entry(-background=>white, -textvariable=>\$prdf_file,
-width=>50)
-> place(-x=>120, -y=>11);
$file_open = $fileframe->Button(-text=>"-> open", -background=>"#dddddd",
-command=>\&open_file)
-> place(-x=>595, -y=>8);
$file_browse = $fileframe->Button(-text=>"or browse", -command=>\&browse_file,
-background=>"#dddddd")
->place(-x=>120, -y=>45);
$mw->Button(-text=>"exit",
-command=>\&ddump_exit
)->pack(-side=>'bottom', -anchor=>'sw');
$mw->Button(-text=>"ddump",
-command=>\&do_ddump
)->pack(-side=>'bottom', -anchor=>'sw');
MainLoop;
#======================================================================#
sub ddump_exit {
#print (" exiting...\n");
open OUTPUT, ">ddump_parser.dat";
#print (" prdf_file (3): $prdf_file\n");
print OUTPUT "$prdf_file\n";
close OUTPUT;
&exit;
} # end ddump_exit
#======================================================================#
sub open_file {
# here we just do test opens to make sure file(s) exist, and assign name(s)
# to prdf_0 and prdf_1
$prdf[0] = ""; $prdf[1] = "";
if ($prdf_file =~ 'MVD-\*') {
$prdf[0] = $`."MVD-0".$';
if (open INPUT , $prdf[0]){
#print (" $prdf[0] exists \n");
close INPUT;
}
else {
#print ("\n Cannot open $prdf[0] \n");
$prdf[0] = "";
}
$prdf[1] = $`."MVD-1".$';
if (open INPUT , $prdf[1]){
#print (" $prdf[1] exists \n");
close INPUT;
}
else {
print ("\n Cannot open $prdf[1] \n");
$prdf[1] = "";
}
}
elsif (open INPUT , $prdf_file){
#print (" $prdf_file exists \n");
$prdf[0] = $prdf_file;
$prdf[1] = "";
close INPUT;
}
else {
print ("\n Cannot open file \n");
}
#print (" file 0: $prdf[0], file 1: $prdf[1].\n")
} # end open_file
#======================================================================#
sub browse_file{
$chosen_file = $fileframe -> getOpenFile();
print ("\n file chosen: $chosen_file [ I DONT THINK THIS WORKS YET ]\n");
} #end browse_file
#======================================================================#
sub do_ddump{
&tm_close;
$coolheader = $mw->Frame(-background=>'#ffff33',
-borderwidth=>'5',
-label=>"Data Dump for the MVD:")->pack(
-expand =>'1',
-fill =>'x',
-side=>'top');
if ($prdf_0 eq "" && $prdf_1 eq "") {&open_file;}
# open the display window where the readback text is shown:
$text_1->destroy() if Tk::Exists($text_1);
$text_1 = $mw->Text(-background=>white, -height=>27, width=>85);
$text_1->pack();
$text_1->insert('end'," ********* Input file: $prdf_file *********** \n");
$text_1->insert('end'," Pkt id ev md fl bc amu ---- userwords ---- lpar dcm");
$text_1->insert('end'," -0- -1- -2 data 253 254 255 \n");
$text_1->insert('end'," -----------------------------------------");
$text_1->insert('end',"-----------------------------------------\n");
$imax = 1;
if ($prdf[1] eq "") {$imax = 0;}
for ($i=0; $i<=$imax; $i++) {
#print ("opening for GRAB: $prdf[$i]\n");
open GRAB, "ddump -f $prdf[$i]|";
$ipack = 0;
$iline = 0;
while () {
$iline++;
$line = $_; chomp $line;
if ($line =~ "Packet") {
$ipack++;
$out[1][$ipack] = substr($line,9,4);
}
if ($line =~ "Detector i") {$out[2][$ipack] = substr($line,29,1);}
if ($line =~ "Event n" ) {$out[3][$ipack] = substr($line,27,3);}
if ($line =~ "Module a" ) {$out[4][$ipack] = substr($line,28,2);}
if ($line =~ "Flag W" ) {$out[5][$ipack] = substr($line,28,2);}
if ($line =~ "Beam C" ) {$out[6][$ipack] = substr($line,28,2);}
if ($line =~ "AMU C" ) {$out[7][$ipack] = substr($line,28,2);
$out[8][$ipack] = substr($line,36,2);}
if ($line =~ "Userword 0") {$out[10][$ipack] = substr($line,21,1);}
if ($line =~ "Userword 1") {$out[11][$ipack] = substr($line,21,1);}
if ($line =~ "Userword 2") {$out[12][$ipack] = substr($line,21,1);}
if ($line =~ "Userword 3") {$out[13][$ipack] = substr($line,21,1);}
if ($line =~ "Userword 4") {$out[14][$ipack] = substr($line,21,1);}
if ($line =~ "Userword 5") {$out[15][$ipack] = substr($line,21,1);}
if ($line =~ "Userword 6") {$out[16][$ipack] = substr($line,21,1);}
if ($line =~ "Userword 7") {$out[17][$ipack] = substr($line,18,4);}
if ($line =~ "Long. P") {$out[18][$ipack] = substr($line,26,4);}
if ($line =~ "DCM Sta" ) {
$out[19][$ipack] = substr($line,26,4);
$isave = $iline;
}
if ($iline-3 == $isave) {
$out[20][$ipack] = substr($line,11,3).substr($line,16,4).substr($line,22,4);
}
if ($iline-34 == $isave) {
$out[21][$ipack] = substr($line,40,4).substr($line,46,4).substr($line,52,4);
}
}
close GRAB;
for ($ip = 1; $ip<=$ipack; $ip++) {
$text_1->insert('end'," $out[ 1][$ip] $out[ 2][$ip]$out[ 3][$ip] $out[ 4][$ip] ");
$text_1->insert('end', "$out[ 5][$ip] $out[ 6][$ip] $out[ 7][$ip] $out[ 8][$ip] ");
$text_1->insert('end', "$out[ 9][$ip] $out[10][$ip] $out[11][$ip] $out[12][$ip] ");
$text_1->insert('end', "$out[13][$ip] $out[14][$ip] $out[15][$ip] $out[16][$ip] ");
$text_1->insert('end', "$out[17][$ip] $out[18][$ip] $out[19][$ip] ");
$text_1->insert('end', "$out[20][$ip] ...$out[21][$ip] \n");
}
} # for loop over 1 or 2 files
} # end of tm_sendread
#==============================================================#
sub tm_close{
# clean up on exit, and disallow multiple copies:
$text_1->destroy() if Tk::Exists($text_1);
$coolheader->destroy() if Tk::Exists($coolheader);
}
#==============================================================#