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

diff --git a/cts/cts_gui b/cts/cts_gui
index 2cfb6866b294dbe8d8b46967247bdfde6825afc9..6f2868e410b52c5b12de982aa6050118ab96282d 100755 (executable)
--- a/cts/cts_gui
+++ b/cts/cts_gui
@@ -1,6 +1,7 @@
 #!/bin/bash
 if [ $2 > 0 ]; then
-   host=`hostname`
+#   host='localhost'
+   host='cbmpc011_2'
    port="1234"
    
    echo "Trying to kill processes 'cts' and 'dhttpi'"
@@ -26,4 +27,4 @@ if [ $2 > 0 ]; then
 else
    xterm -fn "-misc-fixed-medium-r-normal--8-*-*-*-*-*-iso8859-15" \
       +sb -geometry 200x100 +aw +bc -bg LightCoral -j -e ./cts_gui 1 1
-fi;
\ No newline at end of file
+fi;

diff --git a/cts/htdocs/cts.pl b/cts/htdocs/cts.pl
index 7a543e3b504c67b5fe70f3f4e420a880e82bb5a0..f62bf1ec5743bf375aff0dec4b9b31a8c71393c0 100755 (executable)
--- a/cts/htdocs/cts.pl
+++ b/cts/htdocs/cts.pl
@@ -5,7 +5,7 @@ use lib "./include/";
 
 use Cts;
 use CtsConfig;
-use JSON::PP;
+use JSON;
 
 sub connectToCTS {
    my $endpoint = shift;
@@ -23,7 +23,7 @@ my $cts = connectToCTS( CtsConfig->getDefaultEndpoint );
 my $query = $ENV{'QUERY_STRING'};
 
 if ($query eq "init") {
-   print JSON::PP->new->allow_blessed->convert_blessed->encode({
+   print JSON::XS->new->allow_blessed->convert_blessed->encode({
       'registers' => $cts->getRegisters,
       'properties' => $cts->getProperties
    });
@@ -39,7 +39,7 @@ if ($query eq "init") {
       $result{$key} = $op eq "read" ? $reg->read() : $reg->format();
    }
    
-   print JSON::PP->new->allow_blessed->convert_blessed->encode(\%result);
+   print JSON::XS->new->allow_blessed->convert_blessed->encode(\%result);
 } elsif ($query =~ /^write,([\w\d_,\.\[\]]+)$/) {
    my @values = split /,/, $1;
    my $regs = {};
@@ -58,7 +58,7 @@ if ($query eq "init") {
       }
    }
    
-   foreach my $key (keys $regs) {
+   foreach my $key (keys %$regs) {
       my $reg = $cts->getRegisters->{$key};
       #next unless defined $reg;
       $reg->write($regs->{$key});

diff --git a/cts/include/TrbSlicedRegister.pm b/cts/include/TrbSlicedRegister.pm
index fd2d7bba17da0be2733cb4297e233e35d7cf57e9..f9ad9389101b6bb1aa7b9fb582c65bdd6d30edb1 100644 (file)
--- a/cts/include/TrbSlicedRegister.pm
+++ b/cts/include/TrbSlicedRegister.pm
@@ -38,7 +38,7 @@ sub format {
    
    my $cache = {};
    
-   foreach my $key (keys $self->{'_keys'}) {
+   foreach my $key (keys %{$self->{'_keys'}}) {
       my $tmp;
       my $reg = $self->{'_keys'}{$key};
       
@@ -72,7 +72,7 @@ sub read {
    
    my $cache = {};
    
-   foreach my $key (keys $self->{'_keys'}) {
+   foreach my $key (keys %{$self->{'_keys'}}) {
       my $tmp;
       my $reg = $self->{'_keys'}{$key};
       
@@ -104,18 +104,19 @@ sub write {
    if (ref $values) {
       my $valuesPerReg = {};
       
-      foreach my $key (keys $values) {
+      foreach my $key (keys %$values) {
          $valuesPerReg->{$self->{'_keys'}{$key}} = $values->{$key};
       }
       
-      foreach my $reg (keys $valuesPerReg) {
+      foreach my $reg (keys %$valuesPerReg) {
          $reg->write( $valuesPerReg->{$reg} );
       }
    } else {
       if (%{$self->{'_keys'}} > 1) {
          warnings::warn("TrbSlicedRegister->write(): Scalar values are supported for exclusively defintions, containing only one slice");
       } else {
-         $self->{'_keys'}{ (keys $self->{'_keys'})[0] }->write( $values );
+        $self->{'_keys'}{ (keys %{$self->{'_keys'}})[0] }->write( $values );
+         #$self->{'_keys'}{ (keys %{$self->{'_keys'})[0]->write( $values )};
       }
    }
 }
@@ -127,7 +128,7 @@ sub getAddresses {
    my $self = shift;
    my %addresses = ();
    
-   foreach my $key (keys $self->{'_keys'}) {
+   foreach my $key (keys %{$self->{'_keys'}}) {
       $addresses{$self->{'_keys'}{$key}->getAddress} = 1;
    }
    
@@ -139,7 +140,7 @@ sub getAddress {
    #  returns single address used by a randomly chosen slices
    
    my $self = shift;
-   my @keys= (keys $self->{'_keys'});
+   my @keys= (keys %{$self->{'_keys'}});
    
    return $self->{'_keys'}->{ $keys[0] }->getAddress;
 }
@@ -148,7 +149,7 @@ sub getSliceNames {
    # TrbSlicedRegister->getSliceNames()
    #  returns an array reference containing all Slicenames
    my $self = shift;
-   return [sort keys $self->{'_keys'}];
+   return [sort keys %{$self->{'_keys'}}];
 }
 
 sub getAccessMode { 
@@ -161,7 +162,7 @@ sub getAccessMode {
    my $read = 1;
    my $write = 1;
 
-   foreach my $key (keys $self->{'_keys'}) {
+   foreach my $key (keys %{$self->{'_keys'}}) {
       my $mode = $self->{'_keys'}{$key}->getAccessMode();
       
       if ($mode eq "ro") {$write = 0;}
@@ -183,4 +184,4 @@ sub TO_JSON {return %{ $_[0] };}
 
 sub getOptions {{}}
 
-1;
\ No newline at end of file
+1;