changed code to be able to run with perl 5.12, mt

diff --git a/cts/CtsConfig.pm b/cts/CtsConfig.pm
index 553665c6b904ea1dfeb2029f759d6b7981b6351e..5863cc4983fa0c98590185511ec504d9f4bc4603 100644 (file)
--- 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 d63aa56fd6e8ff531c4ed2bc61af53a0e4f1a9e1..cfd7e53fdf50c88f974a2b81a46ee13896118fb6 100755 (executable)
--- 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 a20cce88d3282df79d564c789d01015c60308767..15728de5aeaee901aa7e9c619f75aee82d3704d4 100755 (executable)
--- 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 cc7cf2e63bf2f07d263b338e2117a54b4c82b4d5..83e4df61dfc012b80ea9e489725bbbabd9c61bff 100644 (file)
--- 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 8b03904f2d36ec6f1eda5ea1959f0b4e63fb32f5..0bc67f69f503ac6b693e0f32613803b5edb2ec2b 100644 (file)
--- 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 c136bbdb0e6bb5e6d04806179250c2122d8a99b1..f37f069be5a120a64f86011a9c5245fa7ea62dc5 100644 (file)
--- 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 bcdbd69c5377d9c5188dc4343ff6be3ec1df3493..b6fbf3e859636306466ec61933f60035b052c6eb 100644 (file)
--- 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;