From 9a567ad62504bca6a43aa23910a8a646611f707d Mon Sep 17 00:00:00 2001 From: hadaq Date: Thu, 11 Oct 2012 00:26:38 +0000 Subject: [PATCH] changed code to be able to run with perl 5.12, mt --- cts/cts_gui | 5 +++-- cts/htdocs/cts.pl | 8 ++++---- cts/include/TrbSlicedRegister.pm | 21 +++++++++++---------- 3 files changed, 18 insertions(+), 16 deletions(-) diff --git a/cts/cts_gui b/cts/cts_gui index 2cfb686..6f2868e 100755 --- 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 7a543e3..f62bf1e 100755 --- 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 fd2d7bb..f9ad938 100644 --- 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; -- 2.43.0