From f7001d25abfb673247b7b8670a08f0ccae85a43c Mon Sep 17 00:00:00 2001
From: hadaq <hadaq>
Date: Thu, 9 Feb 2012 14:48:39 +0000
Subject: [PATCH] update

---
 libtrbnet_perl/lib/HADES/TrbNet.pm | 47 ++++++++++++++++-------
 libtrbnet_perl/test/test.pl        | 60 +++++++++++++++++++++++++-----
 2 files changed, 85 insertions(+), 22 deletions(-)

diff --git a/libtrbnet_perl/lib/HADES/TrbNet.pm b/libtrbnet_perl/lib/HADES/TrbNet.pm
index 34b2bc6..2284b0d 100644
--- a/libtrbnet_perl/lib/HADES/TrbNet.pm
+++ b/libtrbnet_perl/lib/HADES/TrbNet.pm
@@ -34,32 +34,54 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
 our @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
 
-#qw(
-#trb_uid init_ports trb_err trb_errnum trb_hash	
-#);
-
 our $VERSION = '0.01';
 
 require XSLoader;
 XSLoader::load('HADES::TrbNet', $VERSION);
 
-# Preloaded methods go here.
+# Preloaded methods go her
 
 sub trb_register_read {
     my ($trb_address, $register_address) = @_;
-    my @a = trb_register_read_c($trb_address, $register_address);
-    #print Dumper \@a;
-    return if (! defined $a[0]);
-    my %h;
-    %h = @a;
-    return \%h;
+    my @res = trb_register_read_c($trb_address, $register_address);
+    return if (! defined $res[0]);
+    
+    my %rh;
+    %rh = @res;
+    return \%rh;
+}
+
+sub trb_register_read_mem {
+    my ($trb_address, $register_address, $option, $size) = @_;
+    my @res = trb_register_read_mem_c($trb_address, $register_address,
+                                      $option, $size);
+    return if (! defined $res[0]);
+    
+    my $rh;
+    my $k = 0;
+    while ($k < scalar @res) {
+       my $len = ($res[$k] >> 16) & 0xffff;
+       my $trb_address = $res[$k] & 0xffff; 
+       my $array = [];
+       $k++;
+       
+       printf "Addr: 0x%04x, Len: %d\n", $trb_address, $len;
+       
+       for (my $i = 0; $i < $len ; $i++, $k++) {
+           push (@$array, $res[$k]);
+       }
+       $rh->{$trb_address} = $array;   
+    }
+    
+    return $rh;
 }
 
 sub trb_read_uid {
     my ($trb_address) = @_;
     my @res = trb_read_uid_c($trb_address);
-    my $rh;
+    return if (! defined $res[0]);
 
+    my $rh;
     for (my $k = 0; $k < scalar @res; $k += 4) {
 	my $uid = ($res[$k] << 32) | $res[$k + 1];
 	my $endP = $res[$k + 2];
@@ -72,7 +94,6 @@ sub trb_read_uid {
     return $rh;
 }
 
-
 1;
 __END__
 # Below is stub documentation for your module. You'd better edit it!
diff --git a/libtrbnet_perl/test/test.pl b/libtrbnet_perl/test/test.pl
index 687d27c..de06482 100755
--- a/libtrbnet_perl/test/test.pl
+++ b/libtrbnet_perl/test/test.pl
@@ -1,26 +1,33 @@
 #!/usr/bin/perl
 use warnings;
-use strict;
+#use strict;
 use Data::Dumper;
 
-use HADES::TrbNet qw(trb_read_uid init_ports trb_error trb_errno trb_strerror trb_register_read trb_read_uid);
+use HADES::TrbNet;
 
-init_ports() or die "Failed init_ports: ", trb_strerror();
+trb_init_ports() or die "Failed trb_init_ports: ", trb_strerror();
 
-my @a = ();
-my $rh_hash;
+my $res;
 
-# Read all UIDs
-my $res = trb_read_uid(0xfffb);
+# Read all UIDs as hash
+$res = trb_read_uid(0xfffb) or die "trb_read_uid: ", trb_strerror();
 foreach my $cur_key (sort {$a <=> $b } keys %$res) {
     printf "uid: 0x%016x  ==> addr: 0x%04x: endpoint: 0x%02x\n", $cur_key,
     $res->{$cur_key}->{'trb_address'}, $res->{$cur_key}->{'trb_endpoint'} ;
 }
-
 #print Dumper $res;
 
+# Read all UIDs as array
+my @res2 = trb_read_uid_c(0xfffb) or die "trb_read_uid: ", trb_strerror();
+#print Dumper @res2;
+foreach my $cur_key (@res2) {
+    printf "0x%08x\n", $cur_key;
+}
+
+
 # Read ADCM's by mem
-my $res = trb_register_read(0xfffb, 0xa000) or die "Failed register_raid: ", trb_strerror();
+$res = trb_register_read(0xfffb, 0xa000)
+    or die "Failed trb_register_read: ", trb_strerror();
 
 foreach my $cur_key (sort {$a <=> $b } keys %$res) {
     printf "address: 0x%04x  ==> value: 0x%08x\n", $cur_key,
@@ -28,5 +35,40 @@ foreach my $cur_key (sort {$a <=> $b } keys %$res) {
 }
 #print Dumper $res;
 
+
+
+# Read all UIDs as array
+my @res3 = trb_register_read_mem_c(0xfffb, 0xa000, 1, 10) or die "trb_register_read_mem_c: ", trb_strerror();
+print Dumper @res3;
+foreach my $cur_key (@res3) {
+    printf "0x%08x\n", $cur_key;
+}
+
+
+# Read read mem test
+$res = trb_register_read_mem(0xfffb, 0xa000, 0, 10) or die "trb_register_read_mem: ", trb_strerror();
+#print Dumper %$res;
+printf "\n\n\n";
+print "Hash content\n";
+foreach my $k (keys %$res) {
+   printf "0x%04x\n", $k;
+   printf "Groesse: ",scalar @$res{$k}, "\n";
+   foreach my $val (@{$res{$k}}) {
+      print " $val";
+   }
+   print "\n";
+}
+#
+#foreach my $cur_key (sort {$a <=> $b } keys %$res) {
+#    printf "0x%04x\n", $cur_key; 
+#    foreach my $val ($res->{$cur_key}) {
+#        printf Dumper $res->{$cur_key};
+#        printf "0x%08x\n", $val;  
+#    }
+#}
+
+
+
+
 exit;
 
-- 
2.43.0