From 02b099c42d9e35fcce87b32a40c0e29a768e2b78 Mon Sep 17 00:00:00 2001 From: hadaq Date: Wed, 10 Oct 2012 22:54:50 +0000 Subject: [PATCH] changed code to be able to run with perl 5.12, mt --- cts/CtsConfig.pm | 4 +-- cts/CtsPlugins/CtsModStatic.pm | 2 +- cts/cts | 61 +++++++++++++++++----------------- cts/include/Cts.pm | 10 ++++-- cts/include/CtsBaseModule.pm | 4 +-- cts/include/TrbNet.pm | 4 +-- cts/include/TrbRegister.pm | 12 ++++--- 7 files changed, 51 insertions(+), 46 deletions(-) diff --git a/cts/CtsConfig.pm b/cts/CtsConfig.pm index 553665c..5863cc4 100644 --- a/cts/CtsConfig.pm +++ b/cts/CtsConfig.pm @@ -2,7 +2,7 @@ package CtsConfig; #default cts endpoint. can be overriden by a command line parameter sub getDefaultEndpoint { - return 0xf3c0; + return 0x8000; } -1; \ No newline at end of file +1; diff --git a/cts/CtsPlugins/CtsModStatic.pm b/cts/CtsPlugins/CtsModStatic.pm index d63aa56..cfd7e53 100755 --- a/cts/CtsPlugins/CtsModStatic.pm +++ b/cts/CtsPlugins/CtsModStatic.pm @@ -159,4 +159,4 @@ sub init { $prop->{'trb_compiletime'} = $trb->read(0x40); } -1; \ No newline at end of file +1; diff --git a/cts/cts b/cts/cts index a20cce8..15728de 100755 --- a/cts/cts +++ b/cts/cts @@ -24,7 +24,8 @@ use lib "./include"; use Time::HiRes qw(usleep gettimeofday tv_interval); - use JSON::PP; + #use JSON::PP; + use JSON; use FileHandle; @@ -171,15 +172,15 @@ sub commandList { # commandList ($cts); # returns a two-dimensional array compatible to the printTable-format my $cts = shift; - - my @keys = sort keys $cts->getRegisters; + + my @keys = sort keys %{$cts->getRegisters}; my $data = [ ['Key', 'R/W', 'Module', 'Address', 'Slices'], '-' ]; - my @mods = sort keys $cts->getModules; + my @mods = sort keys %{$cts->getModules}; my $index = 0; $index++ until $mods[$index] eq 'Static'; @@ -189,21 +190,20 @@ sub commandList { unshift @mods, "Static" } - foreach my $modType (@mods) { my $mod = $cts->getModules->{$modType}; my $modName = ""; - + $modName = sprintf("0x%02x - ", $modType) if looks_like_number($modType); $modName .= $mod->moduleName; - - foreach my $reg (sort keys $mod->getRegisters) { + + foreach my $reg (sort keys %{$mod->getRegisters}) { next if substr($reg, 0, 1) eq "_"; - + my $slices = join(", ", @{$cts->getRegisters->{$reg}->getSliceNames}); $slices = substr($slices, 0, 40) . "..." if length($slices) > 43; - - push $data, [ + + push @$data, [ $reg, $cts->getRegisters->{$reg}->getAccessMode(), $modName, @@ -253,18 +253,18 @@ sub commandRead { sprintf("0x%08x", $values->{'_raw'}) ]; - foreach my $sliceKey (sort keys $values) { + foreach my $sliceKey (sort keys %$values) { next if substr($sliceKey, 0, 1) eq "_"; - push $columns, $sliceKey; - push $columns, $values->{$sliceKey}; - push $data, $columns; + push @$columns, $sliceKey; + push @$columns, $values->{$sliceKey}; + push @$data, $columns; $columns = ['', '', '']; } } else { - push $data, [$key, 'Key not found']; + push @$data, [$key, 'Key not found']; } } @@ -314,7 +314,7 @@ sub commandWrite { } } - foreach my $key (keys $values) { + foreach my $key (keys %$values) { $cts->getRegisters->{$key}->write( $values->{$key} ); } @@ -341,7 +341,7 @@ sub commandMonitor { if ($reg->getOptions->{'monitorrate'}) { $trb->addPrefetchRegister($reg); - if ( scalar keys $reg->getDefinitions == 1 ) { + if ( scalar keys %{$reg->getDefinitions} == 1 ) { push @rateRegs, $key; push @slices, @{$reg->getSliceNames()}[0]; } else { @@ -406,10 +406,10 @@ sub commandMonitor { } } - push $tab, [$label, $regKey, sprintf("0x%04x", $reg->getAddress), shift @dispValues]; + push @$tab, [$label, $regKey, sprintf("0x%04x", $reg->getAddress), shift @dispValues]; while (my $val = shift @dispValues) { - push $tab, [' ', ' ', ' ', $val]; + push @$tab, [' ', ' ', ' ', $val]; } } @@ -453,8 +453,8 @@ sub commandMonitor { $rate = " " x (12 - length($rate)) . $rate; my $value = " " x (12 - length($cur->{'value'}{$slice})) . $cur->{'value'}{$slice}; - - push $tab, [$label, $regKey, + + push @$tab, [$label, $regKey, sprintf("0x%04x", $cts->getRegisters->{$regKey}->getAddress), $rate , $value]; } @@ -464,7 +464,7 @@ sub commandMonitor { if ($filename) { # store json - my $json = JSON::PP->new->encode({ + my $json = JSON::XS->new->encode({ 'time' => $time, 'servertime' => time2str('%Y-%m-%d %H:%M', time), 'interval' => $interval, @@ -472,21 +472,20 @@ sub commandMonitor { 'rates' => $rates, 'monitor' => $monData }); - + open FH, ">$filename/dump.js"; print FH $json; close FH; - + # generate plot - shift $plotData if $#{ $plotData } > 30; - push $plotData, [ + shift @$plotData if $#{ $plotData } > 30; + push @$plotData, [ $time, $rates->{'cts_cnt_trg_asserted.value'}{'rate'}, $rates->{'cts_cnt_trg_edges.value'}{'rate'}, $rates->{'cts_cnt_trg_accepted.value'}{'rate'} ] if $rates->{'cts_cnt_trg_asserted.value'}; - - + if ($#{ $plotData } > 4) { open FH, ">$filename/plot.data"; foreach (@{$plotData}) { @@ -536,7 +535,7 @@ sub connectToCTS { my $trb; eval {require "TrbNet.pm"}; $trb = TrbNet->new($endpoint); - + return Cts->new($trb); } @@ -628,4 +627,4 @@ for(my $i=0; $i < @ARGV; $i++) { print "Command missing\n"; help(); -exit; \ No newline at end of file +exit; diff --git a/cts/include/Cts.pm b/cts/include/Cts.pm index cc7cf2e..83e4df6 100644 --- a/cts/include/Cts.pm +++ b/cts/include/Cts.pm @@ -99,11 +99,15 @@ sub _loadModule { my $mod = eval { (my $file = $module) =~ s|::|/|g; + #print "require: CtsPlugins/$file.pm\n"; require "CtsPlugins/$file.pm"; - - return $module->new($self, $address); + #print "require: CtsPlugins/$file.pm worked: module: $module\n"; + my $ret = $module->new($self, $address); + #print "return of module -> new (self, address: $address => $ret\n"; + return $ret; }; + #print "return of eval module -> new (self, address: $address: $@\n"; $self->{'_modules'}{$modKey} = $mod if $mod; return $mod; } @@ -147,4 +151,4 @@ sub getExportRegisters { return \@regs; } -1; \ No newline at end of file +1; diff --git a/cts/include/CtsBaseModule.pm b/cts/include/CtsBaseModule.pm index 8b03904..0bc67f6 100644 --- a/cts/include/CtsBaseModule.pm +++ b/cts/include/CtsBaseModule.pm @@ -31,7 +31,7 @@ sub register { my $cts = $self->{'_cts'}; foreach my $hash ('_properties', '_registers') { - foreach my $key (keys $self->{$hash}) { + foreach my $key (keys %{$self->{$hash}}) { #unless (substr($key,0,1) eq "_") { $cts->{$hash}{$key} = $self->{$hash}{$key} #} @@ -53,4 +53,4 @@ sub getRegisters { return $_[0]->{'_registers'}; } -1; \ No newline at end of file +1; diff --git a/cts/include/TrbNet.pm b/cts/include/TrbNet.pm index c136bbd..f37f069 100644 --- a/cts/include/TrbNet.pm +++ b/cts/include/TrbNet.pm @@ -102,7 +102,7 @@ sub flushWriteCache { my $cache = $self->{'_write_cache'}; if ($cache) { - foreach my $address (keys $cache) { + foreach my $address (keys %$cache) { trb_register_write($self->getEndpoint, $address, $cache->{$address}) or die(trb_strerror); } } @@ -113,7 +113,7 @@ sub flushWriteCache { sub prefetch { my $self = shift; my $withTime = shift; - my @addresses = sort keys $self->{'_prefetch'}; + my @addresses = sort keys %{$self->{'_prefetch'}}; $self->{'_prefetch'}{$_} = 0 for (@addresses); my $maxUnneededAddresses = 3; diff --git a/cts/include/TrbRegister.pm b/cts/include/TrbRegister.pm index bcdbd69..b6fbf3e 100644 --- a/cts/include/TrbRegister.pm +++ b/cts/include/TrbRegister.pm @@ -33,6 +33,8 @@ use POSIX; use Data::Dumper; +use TrbNet; + sub new { # TrbRegister->new( $address, $trb, [$defs], [$accessmode] ) # Creates a new TrbRegister description. If $defs is not provided, @@ -59,7 +61,7 @@ sub new { $options = $options ? { %{$def_options}, %{$options} } : $def_options; # default values - $defs = {'value' => {'lower' => 0, 'len' => 32}} unless keys $defs; + $defs = {'value' => {'lower' => 0, 'len' => 32}} unless keys %$defs; my $self = { '_trb' => $trb, @@ -72,7 +74,7 @@ sub new { }; # check values passed - foreach my $key (keys $defs) { + foreach my $key (keys %$defs) { my $def = $defs->{$key}; # optional values @@ -122,7 +124,7 @@ sub read { my $sliced_result = {'_raw' => $unsliced}; - foreach my $key (keys $self->{'_defs'}) { + foreach my $key (keys %{$self->{'_defs'}}) { $sliced_result->{$key} = ($unsliced >> $self->{'_defs'}{$key}{'lower'}) # shift & ((1 << $self->{'_defs'}{$key}{'len'}) - 1); # and mask } @@ -249,11 +251,11 @@ sub format { sub getAddress {return $_[0]->{'_address'}} sub getAccessMode {return $_[0]->{'_accessmode'}} -sub getSliceNames {return [sort keys $_[0]->{'_defs'}]} +sub getSliceNames {return [sort keys %{$_[0]->{'_defs'}}]} sub getDefinitions{return $_[0]->{'_defs'}} sub getOptions {return $_[0]->{'_options'}} sub TO_JSON {return {%{ $_[0] }};} -1; \ No newline at end of file +1; -- 2.43.0