From 4337654c0e216077f26b7f0c884585eaf857c3c8 Mon Sep 17 00:00:00 2001
From: Andreas Neiser <neiser@kph.uni-mainz.de>
Date: Tue, 20 May 2014 18:11:15 +0200
Subject: [PATCH] First working version which reads at least temperatures from
 the padiwa...

---
 web/htdocs/padiwa/padiwa.pl | 41 +++++++++++++++++++++++++++++++++++++
 xml-db/get.pl               | 41 +++++++++++++++++++++++++++++++++----
 2 files changed, 78 insertions(+), 4 deletions(-)
 create mode 100755 web/htdocs/padiwa/padiwa.pl

diff --git a/web/htdocs/padiwa/padiwa.pl b/web/htdocs/padiwa/padiwa.pl
new file mode 100755
index 0000000..5c87ef4
--- /dev/null
+++ b/web/htdocs/padiwa/padiwa.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+if ($ENV{'SERVER_SOFTWARE'} =~ /HTTPi/i) {
+  print "HTTP/1.0 200 OK\n";
+  print "Content-type: text/html\r\n\r\n";
+  }
+else {
+  use lib '..';
+  use if (!($ENV{'SERVER_SOFTWARE'} =~ /HTTPi/i)), apacheEnv;
+  print "Content-type: text/html\n\n";
+  }
+
+use CGI ':standard';
+use XML::LibXML;
+use POSIX;
+use CGI::Carp qw(fatalsToBrowser);
+
+use lib qw|../commands htdocs/commands|;
+use xmlpage;
+
+my $page;
+
+$page->{title} = "Padiwa";
+$page->{link}  = "../";
+
+
+my @setup;
+$setup[0]->{name}    = "AnyReg";
+$setup[0]->{cmd}     = "Padiwa-0xfe48:0..3-Status";
+$setup[0]->{period}  = -1;
+$setup[0]->{generic} = 1;
+$setup[0]->{rate}    = 1;
+
+
+xmlpage::initPage(\@setup,$page);
+ 
+
+ 
+
+1;
+
+
diff --git a/xml-db/get.pl b/xml-db/get.pl
index 5c3a95d..2f6fdaf 100755
--- a/xml-db/get.pl
+++ b/xml-db/get.pl
@@ -2,7 +2,7 @@
 use HADES::TrbNet;
 use Storable qw(lock_store lock_retrieve);
 use feature "switch";
-use Time::HiRes qw( time );
+use Time::HiRes qw( time usleep );
 use CGI::Carp qw(fatalsToBrowser);
 
 use if (!defined $ENV{'QUERY_STRING'}), warnings;
@@ -13,7 +13,7 @@ use if (!defined $ENV{'QUERY_STRING'}), Data::TreeDumper;
 use if (!defined $ENV{'QUERY_STRING'}), Getopt::Long;
 
 # use Data::TreeDumper;
-#use Data::Dumper;
+use Data::Dumper;
 my ($db,$data,$once,$slice);
 my $help = 0;
 my $verbose = 0;
@@ -141,7 +141,7 @@ foreach my $req (@request) {
       if @spi_chains==0;
   }
   elsif($db->{'§EntityType'} eq 'SpiEntity') {
-    # no spi range supplied, just use 0 by default
+    # no spi range supplied, just use chain 0 by default
     @spi_chains = (0);
   }
 
@@ -337,7 +337,9 @@ sub register_read {
     when ("TrbNetEntity")  {
       $o =  convert_keys_to_hex(trb_register_read($netaddr, $regaddr));
     }
-    when ("SpiEntity") { $o = { "$netaddr:1" => [1,2,3] }; }
+    when ("SpiEntity") {
+      $o = spi_register_read($netaddr, $regaddr);
+    }
     default {die "EntityType not recognized";}
   }
   return $o;
@@ -368,6 +370,37 @@ sub convert_keys_to_hex {
   return \%h;
 }
 
+sub spi_register_read {
+  # inspired by the simple padiwa.pl
+  my ($netaddr, $regaddr) = @_;
+  $o = {};
+  foreach my $chain (@spi_chains) {
+    # in $cmd, the lower 16 bits are the payload
+    # the upper 16 bits control:
+    # 31..24: select (something like an address)
+    # 23..20: command read=0x0, write=0x8
+    # 19..16: channel/register (something like an address)
+
+    # the lower 4 bits directly map:
+    my $cmd = $regaddr & 0xF;
+    # the next 8 bits need to be shifted
+    $cmd |= (($regaddr >> 4) & 0xFF) << 8;
+    # shift it to the upper 16 bits finally
+    $cmd <<= 16;
+
+    my $c = [$cmd,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1<<$chain,1];
+    trb_register_write_mem($netaddr,0xd400,0,$c,scalar @{$c});
+    usleep(1000);
+    my $res = trb_register_read($netaddr,0xd412);
+    foreach my $board (keys %$res) {
+      my $b = sprintf('%04x:%d', $board, $chain);
+      $o->{$b} = $res->{$board};
+    }
+  }
+
+  return $o;
+}
+
   
 sub generateoutput {
   my ($obj,$name,$slice,$once) = @_;
-- 
2.43.0