From a9d990a23e9b90a2e749b68864044cbb96a80d41 Mon Sep 17 00:00:00 2001 From: Jan Michel Date: Tue, 5 Nov 2024 14:58:43 +0100 Subject: [PATCH] Get rid of switch/when in get.pl --- xml-db/database/Mimosis.xml | 2 +- xml-db/get.pl | 160 +++++++++++++++++++----------------- 2 files changed, 84 insertions(+), 78 deletions(-) diff --git a/xml-db/database/Mimosis.xml b/xml-db/database/Mimosis.xml index f996e47..9207e56 100644 --- a/xml-db/database/Mimosis.xml +++ b/xml-db/database/Mimosis.xml @@ -137,7 +137,7 @@ - + First I2C register diff --git a/xml-db/get.pl b/xml-db/get.pl index ea7bc3a..5dea63a 100755 --- a/xml-db/get.pl +++ b/xml-db/get.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use HADES::TrbNet; use Storable qw(lock_store retrieve lock_retrieve); -use feature "switch"; +# use feature "switch"; use Time::HiRes qw( time usleep ); use if (defined $ENV{'QUERY_STRING'}), CGI::Carp => qw(fatalsToBrowser); @@ -11,7 +11,7 @@ use if (!defined $ENV{'QUERY_STRING'}), Text::TabularDisplay; use if (!defined $ENV{'QUERY_STRING'}), Data::Dumper; use if (!defined $ENV{'QUERY_STRING'}), Data::TreeDumper; use if (!defined $ENV{'QUERY_STRING'}), Getopt::Long; -no warnings 'experimental::smartmatch'; +# no warnings 'experimental::smartmatch'; # use Data::TreeDumper; # use Data::Dumper; @@ -27,7 +27,7 @@ my @RegisterDump; my ($file,$entity,$netaddr,@spi_chains,$name, $style, $storefile, $rates, $cache, $isInline, $olddata); my $lastboards; -$ENV{'DAQOPSERVER'}="localhost:7" unless (defined $ENV{'DAQOPSERVER'}); +$ENV{'DAQOPSERVER'}="localhost" unless (defined $ENV{'DAQOPSERVER'}); die "can not connect to trbnet-daemon on $ENV{'DAQOPSERVER'}: ".trb_strerror() unless (defined &trb_init_ports()); @@ -234,49 +234,61 @@ sub FormatPretty { my $t = ""; $ret = "<$cont "; if ($readable) { - for ($obj->{format}) { - when ("boolean") { - if ($obj->{errorflag}) { - $ret .= "$cl".($value?"true":"false"); - } else { - $ret .= "$cl".($value?"true":"false"); - } - } - when ("float") { $ret .= sprintf("$cl%.2f",$value);} - when ("integer") { $t = sprintf("%i",$value); - $t =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/ /g;#  - $ret .= $cl.$t; - } - when ("unsigned") { $t = sprintf("%u",$value); - $t =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/ /g;#  - $ret .= $cl.$t; - } - when ("signed") { $t = sprintf("%i",$value); - $t =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/ /g;#  - $ret .= $cl.$t;} #$ret .= sprintf("$cl%d",$value); - when ("binary") { $t = sprintf("%0".$obj->{bits}."b",$value); - $t =~ s/(?<=\d)(?=(?:\d\d\d\d)+\b)/ /g;#  - $ret .= $cl.$t; - } - when ("bitmask") { my $tmp = sprintf("%0".$obj->{bits}."b",$value); - $tmp =~ s/(?<=\d)(?=(?:\d\d\d\d)+\b)/ /g;#  - $tmp =~ s/0/\□\;/g; - $tmp =~ s/1/\■\;/g; - $tmp =~ s/\s/ /g;#  - - $ret .= $cl.$tmp; + if ($obj->{format} eq "boolean") { + if ($obj->{errorflag}) { + $ret .= "$cl".($value?"true":"false"); + } else { + $ret .= "$cl".($value?"true":"false"); } - when ("time") {require Date::Format; $ret .= Date::Format::time2str('>%Y-%m-%d %H:%M',$value);} - when ("hex") {$ret .= sprintf($cl."0x%0".(int(($obj->{bits}+3)/4))."x",$value);} - when ("enum") { my $t = sprintf("%x",$value); - if (exists $obj->{enumItems}->{$t}) { - $ret .= $cl.$obj->{enumItems}->{$t} - } else { - $ret .= $cl."0x".$t; - } + } + elsif ($obj->{format} eq "float") { + $ret .= sprintf("$cl%.2f",$value); + } + elsif ($obj->{format} eq "integer") { + $t = sprintf("%i",$value); + $t =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/ /g;#  + $ret .= $cl.$t; + } + elsif ($obj->{format} eq "unsigned") { + $t = sprintf("%u",$value); + $t =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/ /g;#  + $ret .= $cl.$t; + } + elsif ($obj->{format} eq "signed") { + $t = sprintf("%i",$value); + $t =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/ /g;#  + $ret .= $cl.$t;} #$ret .= sprintf("$cl%d",$value); + elsif ($obj->{format} eq "binary") { + $t = sprintf("%0".$obj->{bits}."b",$value); + $t =~ s/(?<=\d)(?=(?:\d\d\d\d)+\b)/ /g;#  + $ret .= $cl.$t; + } + elsif ($obj->{format} eq "bitmask") { + my $tmp = sprintf("%0".$obj->{bits}."b",$value); + $tmp =~ s/(?<=\d)(?=(?:\d\d\d\d)+\b)/ /g;#  + $tmp =~ s/0/\□\;/g; + $tmp =~ s/1/\■\;/g; + $tmp =~ s/\s/ /g;#  + + $ret .= $cl.$tmp; + } + elsif ($obj->{format} eq "time") { + require Date::Format; $ret .= Date::Format::time2str('>%Y-%m-%d %H:%M',$value); + } + elsif ($obj->{format} eq "hex") { + $ret .= sprintf($cl."0x%0".(int(($obj->{bits}+3)/4))."x",$value); + } + elsif ($obj->{format} eq "enum") { + my $t = sprintf("%x",$value); + if (exists $obj->{enumItems}->{$t}) { + $ret .= $cl.$obj->{enumItems}->{$t} + } else { + $ret .= $cl."0x".$t; } - default {$ret .= sprintf(">%08x",$value);} - } + } + else { + $ret .= sprintf(">%08x",$value); + } } else { $ret .= $cl." "; } @@ -286,25 +298,23 @@ sub FormatPretty { $ret .= sprintf("$name (Bit $range) - raw: 0x%x
$cstr",$rawvalue); } else { - for ($obj->{format}) { - when ("boolean") {$ret = $value?"true":"false";} - when ("float") {$ret = sprintf("%.2f",$value);} - when ("integer") {$ret = sprintf("%i",$value);} - when ("unsigned") {$ret = sprintf("%u",$value);} - when ("signed") {$ret = sprintf("%d",$value);} - when ("binary") {$ret = sprintf("%b",$value);} - when ("bitmask") {$ret = sprintf("%0".$obj->{bits}."b",$value);} - when ("time") {require Date::Format; $ret = Date::Format::time2str('%Y-%m-%d %H:%M',$value);} - when ("hex") {$ret = sprintf("0x%0".int(($obj->{bits}+3)/4)."x",$value);} - when ("enum") { my $t = sprintf("%x",$value); - if (exists $obj->{enumItems}->{$t}) { - $ret = $obj->{enumItems}->{$t} - } else { - $ret = "0x".$t; - } - } - default {$ret = sprintf("0x%08x",$value);} - } + if ($obj->{format} eq "boolean") {$ret = $value?"true":"false";} + elsif ($obj->{format} eq "float") {$ret = sprintf("%.2f",$value);} + elsif ($obj->{format} eq "integer") {$ret = sprintf("%i",$value);} + elsif ($obj->{format} eq "unsigned") {$ret = sprintf("%u",$value);} + elsif ($obj->{format} eq "signed") {$ret = sprintf("%d",$value);} + elsif ($obj->{format} eq "binary") {$ret = sprintf("%b",$value);} + elsif ($obj->{format} eq "bitmask") {$ret = sprintf("%0".$obj->{bits}."b",$value);} + elsif ($obj->{format} eq "time") {require Date::Format; $ret = Date::Format::time2str('%Y-%m-%d %H:%M',$value);} + elsif ($obj->{format} eq "hex") {$ret = sprintf("0x%0".int(($obj->{bits}+3)/4)."x",$value);} + elsif ($obj->{format} eq "enum") { my $t = sprintf("%x",$value); + if (exists $obj->{enumItems}->{$t}) { + $ret = $obj->{enumItems}->{$t} + } else { + $ret = "0x".$t; + } + } + else {$ret = sprintf("0x%08x",$value);} $ret .= " ".$obj->{unit} if exists $obj->{unit}; } return $ret; @@ -360,28 +370,24 @@ sub requestdata { sub register_read { my ($netaddr, $regaddr) = @_; - for ($db->{'§EntityType'}) { - when ("TrbNetEntity") { - return convert_keys_to_hex(trb_register_read($netaddr, $regaddr)); + if ($db->{'§EntityType'} eq "TrbNetEntity") { + return convert_keys_to_hex(trb_register_read($netaddr, $regaddr)); } - when ("SpiEntity") { - return spi_register_read($netaddr, $regaddr); + elsif ($db->{'§EntityType'} eq "SpiEntity") { + return spi_register_read($netaddr, $regaddr); } - default {die "EntityType not recognized";} - } + else {die "EntityType not recognized";} } sub register_read_mem { my ($netaddr, $regaddr, $start, $size) = @_; - for ($db->{'§EntityType'}) { - when ("TrbNetEntity") { - $o = convert_keys_to_hex(trb_register_read_mem($netaddr, $regaddr, $start, $size)); + if ($db->{'§EntityType'} eq "TrbNetEntity") { + $o = convert_keys_to_hex(trb_register_read_mem($netaddr, $regaddr, $start, $size)); } - when ("SpiEntity") { - die "Reading SpiEntity Memory not implemented yet..."; + elsif ($db->{'§EntityType'} eq "SpiEntity") { + die "Reading SpiEntity Memory not implemented yet..."; } - default {die "EntityType not recognized";} - } + else {die "EntityType not recognized";} #die Dumper($o); return $o; } -- 2.43.0