--- /dev/null
+#!/usr/bin/perl -w
+
+use English;
+use strict;
+use Getopt::Long;
+use Data::Dumper;
+use FileHandle;
+use feature "switch";
+
+my $SensorHeaderLength = 7;
+
+my $Statistics;
+my $PMap;
+
+
+###############################################################################
+## Configuration ##############################################################
+###############################################################################
+
+
+my $file;
+my $opt_help = 0;
+my $opt_verb = 0;
+my $opt_debug = 0;
+my $opt_frameinfo = 0;
+my $totalevents = 1E9;
+my $mode = "";
+
+GetOptions ('h|help' => \$opt_help,
+ 'f|file=s' => \$file,
+ 'v|verb' => \$opt_verb,
+ 'i|info' => \$opt_frameinfo,
+ 'd|debug' => \$opt_debug,
+ 'e|events=i' => \$totalevents);
+
+
+
+
+if($opt_help) {
+ printf("Usage: unpack_hld.pl \n");
+ printf("[-h|--help] Show this help\n");
+ printf("-f|--file <file> Path to hld file\n");
+ printf("[-v|--verb] Dump hld file content\n");
+ printf("[-i|--info] Show frame information\n");
+ printf("[-d|--debug] More debugging output\n");
+ printf("\n");
+ exit;
+ }
+
+
+
+###############################################################################
+## HLD Reader #################################################################
+###############################################################################
+
+
+if(&checkArgs()){
+ exit(0);
+}
+
+my @evtHeader_list = ();
+my $evtHeader_aref = \@evtHeader_list;
+
+my @subEvtHeader_list = ();
+my $subEvtHeader_aref = \@subEvtHeader_list;
+
+my @data_list = ();
+my $data_aref = \@data_list;
+
+my $fh = new FileHandle("$file", "r");
+
+while(1){
+ @evtHeader_list = ();
+
+ &getEvtHeader($fh,$evtHeader_aref);
+ &printEvtHeader($evtHeader_aref) if($opt_verb);
+
+ my $evtSize = $evtHeader_aref->[0];
+ if (!defined $evtSize || $evtSize < 0x10) {last;}
+
+ #- If the size is only 32 Bytes -> goto to
+ # the next Event Header since there are no subevents
+ next unless defined $evtSize;
+ next if($evtSize == 32);
+
+ my $size_cntr = 32; # Bytes
+
+ while($evtSize > $size_cntr){
+
+ @subEvtHeader_list = ();
+
+ my $decoding = &getSubEvtHeader($fh,$subEvtHeader_aref);
+ &printSubEvtHeader($subEvtHeader_aref) if($opt_verb);
+
+ my $subEvtSize = $subEvtHeader_aref->[0];
+
+ $size_cntr = $size_cntr + $subEvtSize;
+
+ #- If the size is only 16 Bytes -> goto to
+ # the next Sub Event Header since there are no subevents
+ next if($subEvtSize == 16);
+
+ @data_list = ();
+ &getSubEvtData($fh, $data_aref, $subEvtSize, $decoding);
+ &printData($data_aref) if($opt_verb);
+
+ my $paddedSize = &padding($fh, $subEvtSize);
+
+ $size_cntr = $size_cntr + $paddedSize;
+
+ #----------> User function <---------
+ &analyzeData($evtHeader_aref, $subEvtHeader_aref, $data_aref);
+ }
+}
+
+WriteResults();
+
+$fh->close();
+
+exit(0);
+
+####################### END OF MAIN ###################
+
+sub printEvtHeader()
+{
+ my ($data_aref) = @_;
+
+ print "\n";
+
+ printf("size: %08x ", $data_aref->[0]);
+ printf("decoding: %08x ", $data_aref->[1]);
+ printf("id: %08x ", $data_aref->[2]);
+ printf("seqNr: %08x\n", $data_aref->[3]);
+
+ my $year = (($data_aref->[4] >> 16) & 0xff) + 1900;
+ my $mon = (($data_aref->[4] >> 8) & 0xff) + 1;
+ my $mday = ($data_aref->[4] >> 0) & 0xff;
+
+ my $hour = ($data_aref->[5] >> 16) & 0xff;
+ my $min = ($data_aref->[5] >> 8) & 0xff;
+ my $sec = ($data_aref->[5] >> 0) & 0xff;
+
+ printf("date: %04d-%02d-%02d ", $year, $mon, $mday);
+ printf("time: %02d:%02d:%02d ", $hour, $min, $sec);
+ printf("runNr: %08x ", $data_aref->[6]);
+ printf("expId: %08x\n", $data_aref->[7]);
+}
+
+sub printSubEvtHeader()
+{
+ my ($data_aref) = @_;
+
+ print "\n";
+
+ printf("size: %08x ", $data_aref->[0]);
+ printf("decoding: %08x ", $data_aref->[1]);
+ printf("id: %08x ", $data_aref->[2]);
+ printf("trigNr: %08x\n", $data_aref->[3]);
+}
+
+sub printData()
+{
+ my ($data_aref) = @_;
+
+ my $cntr = 0;
+
+ print "\n";
+
+ foreach my $word (@$data_aref){
+ printf("%08x ", $word);
+
+ $cntr++;
+
+ print "\n" if( ($cntr%4) == 0);
+ }
+}
+
+sub getEvtHeader()
+{
+ my ($fh, $data_aref) = @_;
+
+ my @tmp_list;
+
+ foreach my $i (1..8){
+ my $header;
+
+ read($fh, $header, 4);
+ &checkEndOfFile($fh, $header);
+
+ push(@tmp_list, $header);
+ }
+
+ my $decoding = unpack("V*", $tmp_list[1]);
+ unless(defined $decoding) {
+ printf "This seems to be the end\n" if $opt_verb;
+ return -1;
+ }
+
+ if($opt_debug){
+ if(&getEndianess($decoding)){
+ printf("\n Event Decoding: %08x Byte Order: Little Endian\n", $decoding);
+ }
+ else{
+ printf("\n Event Decoding: %08x Byte Order: Big Endian\n", $decoding);
+ }
+ }
+
+ foreach my $tmp (@tmp_list){
+ my $word;
+
+ if(&getEndianess($decoding)){
+ $word = unpack("V*", $tmp); # Small Endian
+ }
+ else{
+ $word = unpack("N*", $tmp); # Big Endian
+ }
+
+ push(@$data_aref, $word);
+ }
+}
+
+sub getSubEvtHeader()
+{
+ my ($fh, $data_aref) = @_;
+
+ my @tmp_list;
+
+ foreach my $i (1..4){
+ my $header;
+
+ read($fh, $header, 4);
+ &checkEndOfFile($fh, $header);
+
+ push(@tmp_list, $header);
+ }
+
+ my $decoding = unpack("V*", $tmp_list[1]);
+
+ if($opt_debug){
+ if(&getEndianess($decoding)){
+ printf("\n SubEvent Decoding: %08x Byte Order: Little Endian\n", $decoding);
+ }
+ else{
+ printf("\n SubEvent Decoding: %08x Byte Order: Big Endian\n", $decoding);
+ }
+ }
+
+ foreach my $tmp (@tmp_list){
+ my $word;
+
+ if(&getEndianess($decoding)){
+ $word = unpack("V*", $tmp); # Small Endian
+ }
+ else{
+ $word = unpack("N*", $tmp); # Big Endian
+ }
+
+ push(@$data_aref, $word);
+ }
+
+ return &getEndianess($decoding);
+}
+
+sub getEndianess()
+{
+ my ($decoding) = @_;
+
+ # Return values:
+ # 0 : Big Endian
+ # 1 : Little Endian
+ #
+ # Usually (when sent by GbE-FPGAs) Event Headers are Little Endian
+ # SubEvent Headers and data are Big Endian
+
+ my $retVal = 0;
+
+ if(defined($decoding) && ($decoding & 0x000000ff) > 0){
+ $retVal = 1; # This is Little Endian
+ }
+
+ return $retVal;
+}
+
+sub getSubEvtData()
+{
+ my ($fh, $data_aref, $size, $decoding) = @_;
+
+ #- Subtract subevent header size and devide by word size
+ my $nrOfWords = ($size - 16)/4;
+
+ foreach my $i (1..$nrOfWords){
+
+ my $tmp;
+ read($fh, $tmp, 4);
+ &checkEndOfFile($fh, $tmp);
+
+ my $word;
+
+ if(&getEndianess($decoding)){
+ $word = unpack("V*", $tmp); # Little Endian
+ }
+ else{
+ $word = unpack("N*", $tmp); # Big Endian
+ }
+
+ push(@$data_aref, $word);
+ }
+}
+
+sub padding()
+{
+ my ($fh, $size) = @_;
+
+ my $retVal = 0; # Size of the padded word
+
+ #- Check 64-bit (8-Byte) alignment
+ unless( ($size%8) == 0){
+ my $tmp;
+ read($fh, $tmp, 4);
+
+ my $word;
+ $word = unpack("V*", $tmp); # Little Endian
+
+ unless($word == 0){
+ #- Padding word is not zero
+
+ printf("\n Padding word is not zero: %08x! \n", $word) if($opt_debug);
+ #$fh->close();
+ #exit(0);
+ }
+
+ $retVal = 4; # Bytes
+ }
+
+ return $retVal;
+}
+
+sub checkEndOfFile()
+{
+ my ($fh, $tmp) = @_;
+
+ unless( defined $tmp){
+ #- The end of the file
+ print "\n End of file\n";
+ $fh->close();
+ exit(0);
+ }
+}
+
+sub checkArgs()
+{
+ my $retVal = 0;
+
+ unless( defined $file){
+ print "\n You must provide a path to the hld file!\n";
+ print " Read help.\n";
+ $retVal = 1;
+ }
+
+ return $retVal;
+}
+
+
+
+
+
+
+
+###############################################################################
+## MVD Unpacker ###############################################################
+###############################################################################
+
+
+
+sub analyzeData() {
+ my ($evtHeader, $subEvtHeader, $data) = @_;
+ my $EvtId = $evtHeader->[3];
+ my $pos = 0;
+ my $time = 0;
+ my $SubEvtSize = $subEvtHeader->[1]/4-6;
+
+ SSELoop: while(1) { #Loop over SubSubEvents
+
+ #Read SubSubEvent Header
+ my $RocId = $data->[$pos] & 0xffff;
+ my $RocLength = ($data->[$pos]>>16) & 0xffff;
+ if($RocId == 0x5555) {last;}
+ my $RocEnd = $pos + $RocLength;
+ $pos++;
+
+ SensLoop: while(1) { #Loop over Sensors
+ #Read Sensor Header
+ my $SensorHead = $data->[$pos++];
+ my $SensorId = $data->[$pos++] & 0xffff;
+ my $SensorStatus = $data->[$pos++];
+ my $SensorError = $data->[$pos++];
+ my $SensorDebug = $data->[$pos++];
+ my $SensorTime = sprintf("%08x%08x",$data->[$pos+1],$data->[$pos]);
+ $pos+= 2;
+
+ printf("ID\t%8x\tStatus\t%08x\tError\t%08x\tDebug\t%08x\tTime\t%s\n",
+ $SensorId, $SensorStatus, $SensorError, $SensorDebug, $SensorTime) if $opt_frameinfo;
+
+ #Could it be...?
+ if($SensorHead != 0xffffffff) {
+ #Something is really wrong with data. Skip SubEvent!
+ printf("Broken Sensor Header\n") if $opt_frameinfo;
+ $Statistics->{$SensorId}->{Broken}++;
+ last SSELoop;
+ }
+
+ #Check Status Word
+ my $SensorIsValid = 0;
+ if($SensorStatus == 0xf000000f) {
+ $SensorIsValid = 1;
+ $Statistics->{$SensorId}->{Valid}++;
+ }
+ else {
+ $SensorIsValid = 0;
+ $Statistics->{$SensorId}->{Broken}++;
+ }
+
+ if($SensorIsValid){
+ #Hey Sensor, tell me who you are!
+ my $SensorDummy = $data->[$pos++];
+ my $SensorNumber = $data->[$pos++];
+ my $SensorLength = $data->[$pos++] & 0xffff;
+
+ printf("\t\t\tHeader\t%08x\tFrame\t%08x\tLength\t%i\n",
+ $SensorDummy, $SensorNumber, $SensorLength) if $opt_frameinfo;
+
+ my $FrameEndPos = $pos + $SensorLength;
+ my ($i, $d, $line, $column, $pixels, $statecnt, $ovf) = (0,0,0,0,0,0,0);
+ while(1) {
+ #Disentangle 16 Bit words
+ if($i++%2) {$d = $data->[$pos++] & 0xffff;}
+ else {$d = ($data->[$pos] >> 16) & 0xffff;}
+
+ #Is new line?
+ if($statecnt-- == 0) {
+ $ovf += $d >> 15;
+ $line = ($d >> 4) & 0x7FF;
+ $statecnt = $d & 0xF;
+ }
+ else {
+ $pixels = ($d & 0x3) + 1;
+ $column = ($d >> 2) & 0x7FF;
+ printf("\t$line, $column x $pixels\n") if $opt_frameinfo;
+
+ $PMap->{$SensorId}->[$line]->[$column]++;
+ $PMap->{$SensorId}->[$line]->[$column+1]++ if $pixels > 1;
+ $PMap->{$SensorId}->[$line]->[$column+2]++ if $pixels > 2;
+ $PMap->{$SensorId}->[$line]->[$column+3]++ if $pixels > 3;
+ }
+
+ last if $pos >= $FrameEndPos;
+ }
+
+
+ #Read end of frame marker without check
+ $pos++;
+ }
+ if($pos >= $RocEnd){
+ last SensLoop;
+ }
+ }
+ }
+ }
+
+
+sub WriteResults {
+
+
+ foreach my $id (keys $Statistics) {
+ #No frames? No plot!
+ if(!defined $Statistics->{$id}->{Valid}) {next;}
+
+ my $fn = "gnuplot";
+ $fh = new FileHandle ("|$fn") or die "error: no gnuplot";
+ $fh->autoflush(1);
+
+ print $fh "set terminal pngcairo;\n";
+ print $fh "set palette model RGB;\n";
+ print $fh "set xrange [0:1152];\n";
+ print $fh "set yrange [0:576];\n";
+ print $fh "set cbrange [0:20000];\n";
+ print $fh "set palette defined ( 0 'white', 1 'red', 5 'black', 10 'blue', 20000 'green');\n";
+ my $s = sprintf("%04x",$id);
+ print $fh "set output './image_recalibrated_$s.png';\n";
+ print $fh "plot '-' matrix with image\n";
+
+
+ for(my $y = 0; $y < 576; $y++) {
+ my $l = "";
+ for(my $x = 0; $x < 1152; $x++) {
+ if (defined $PMap->{$id}->[$y]->[$x]) {
+ $l .= $PMap->{$id}->[$y]->[$x]." " ;
+ }
+ else {
+ $l .= "0 ";
+ }
+ }
+ print $fh $l."\n";
+ }
+ print $fh "e\nexit\n";
+ $fh->close();
+ }
+
+
+ }
+