cuurent but unstable

diff --git a/libtrbnet_perl/Makefile.PL b/libtrbnet_perl/Makefile.PL
index 8cc79ca142ea343a1d8d87902bd567301dc8ef6d..0969c913f879f71d5c6b532b5acea5abe6de542e 100644 (file)
--- a/libtrbnet_perl/Makefile.PL
+++ b/libtrbnet_perl/Makefile.PL
@@ -10,6 +10,7 @@ WriteMakefile(
     ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
       (ABSTRACT_FROM  => 'lib/HADES/TrbNet.pm', # retrieve abstract from module
        AUTHOR         => 'Hades DAQ <hadaq@>') : ()),
+   DESTDIR            => '/home/hadaq/depp',
    INC                => '-I../libtrbnet',
    DEFINE             => '',
    LIBS               => '-L../trbnetd -ltrbnet',

diff --git a/libtrbnet_perl/TrbNet.xs b/libtrbnet_perl/TrbNet.xs
index 4cb88b5cba7f1fbdb4643acb28bdd3e1322f9bb2..e131b5227c7a671c05bb038780dab3e4e919d743 100644 (file)
--- a/libtrbnet_perl/TrbNet.xs
+++ b/libtrbnet_perl/TrbNet.xs
@@ -2,32 +2,137 @@
 #include <perl.h>
 #include <XSUB.h>
 #include <assert.h>
+#include <string.h>
 
 #include <trbnet.h>
+#include <trberror.h>
+
+static size_t BUFFER_SIZE = 4194304;
+static U32 buffer[4194304];
 
 /* file : TrbNet.xs */
 
 MODULE = HADES::TrbNet          PACKAGE = HADES::TrbNet
 PROTOTYPES: ENABLE 
 
+
+SV*
+trb_errnum()
+     CODE:
+     RETVAL = newSViv(trb_errno);
+     OUTPUT:
+     RETVAL
+
+void
+trb_err()
+     CODE:
+     trb_error("trb_error");
+     
+
+SV*
+trb_errStr()
+     CODE:
+     RETVAL = newSVpv(trb_strerror(), 0);
+     OUTPUT:
+     RETVAL
+
 int
 init_ports()
-        
+     INIT:
+       int status;
+     PPCODE:
+       status = init_ports();
+               if (status < 0) {
+                  XSRETURN_UNDEF;
+               } else {
+                  XPUSHs(sv_2mortal(newSVuv(1))); 
+        }
+
 void
-trb_uid(trb_address)
+trb_rr(trb_address, reg_address)
+       U16 trb_address
+       U16 reg_address
+     INIT:
+       int status;
+       int i;
+     
+     PPCODE:
+       status = trb_register_read(trb_address,reg_address, buffer, 2);
+       if (status <= 0) {
+          XSRETURN_UNDEF;
+          
+       }
+       XPUSHs(sv_2mortal(newSVuv(buffer[1])));
+       
+void
+trb_ra(trb_address, reg_address)
+       U16 trb_address;
+       U16 reg_address;
+     INIT:
+       int status;
+       int i;
+
+     PPCODE:
+       status = trb_register_read(trb_address,reg_address, buffer, BUFFER_SIZE);
+       if (status <= 0) {
+          XSRETURN_UNDEF;
+       }
+       for (i = 0 ; i < status; i++) {
+          XPUSHs(sv_2mortal(newSVuv(buffer[i])));
+       }
+
+void
+trb_wr(trb_address, reg_address, value)
+       U16 trb_address
+       U16 reg_address
+       U32 value
+     INIT:
+       int status;
+       int i;
+       
+     PPCODE:
+       status = trb_register_write(trb_address,reg_address, value);
+       if (i != -1) {
+                 XSRETURN_UNDEF;
+       }
+       XPUSHs(sv_2mortal(newSVuv(buffer[1])));
+
+void
+trb_uid_c(trb_address)
        U16 trb_address
      INIT:
-       static U32 buf2[1024 * 4];
        int status;
        int i;
        
      PPCODE:
        i = 0;
-       status = trb_read_uid(trb_address, (U32 *)&buf2, 1024 * 4);
+       status = trb_read_uid(trb_address, buffer, BUFFER_SIZE);
        if (status <= 0) {
           XSRETURN_UNDEF;
-          return;
        }
        for (i = 0 ; i < status; i++) {
-          XPUSHs(sv_2mortal(newSVnv(buf2[i])));
+          XPUSHs(sv_2mortal(newSVuv(buffer[i])));
        }
+
+
+
+SV*
+trb_hash_c()
+       INIT:
+       HV * rh;
+       CODE:
+       
+
+       rh = (HV *)sv_2mortal((SV *)newHV());
+       hv_store(rh, "newSVuv", 10, newSVuv(100), 0);
+       hv_store(rh, "duda", 10, newSVuv(200), 0);
+       hv_store(rh, "halloaa", 6, newSVnv(100), 0);
+       hv_store(rh, "dudads", 4, newSVnv(200), 0);
+       hv_store(rh, "hallosd", 6, newSVnv(100), 0);
+       hv_store(rh, "dudadsa", 4, newSVnv(200), 0);
+       hv_store(rh, "halloads", 6, newSVnv(100), 0);
+       hv_store(rh, "dudadwa", 4, newSVnv(200), 0);
+
+       RETVAL = newRV((HV *)rh);
+       OUTPUT:
+       RETVAL

diff --git a/libtrbnet_perl/lib/HADES/TrbNet.pm b/libtrbnet_perl/lib/HADES/TrbNet.pm
index e3a9b064cbd0cd8160915230e1fc97ff4ab36aee..e38c8907919d9d6d56be3b7aafe8b6ee6b1434c5 100644 (file)
--- a/libtrbnet_perl/lib/HADES/TrbNet.pm
+++ b/libtrbnet_perl/lib/HADES/TrbNet.pm
@@ -3,6 +3,7 @@ package HADES::TrbNet;
 use 5.010000;
 use strict;
 use warnings;
+use Data::Dumper;
 
 require Exporter;
 
@@ -16,14 +17,21 @@ our @ISA = qw(Exporter);
 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
 # will save memory.
 our %EXPORT_TAGS = ( 'all' => [ qw(
+       trb_errnum
+       trb_err
+       trb_errStr
        init_ports
+       trb_rr
+       trb_ra
+       trb_wr
        trb_uid
+       trb_hash
 ) ] );
 
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
 our @EXPORT = qw(
-       
+trb_uid init_ports trb_err trb_errnum trb_hash 
 );
 
 our $VERSION = '0.01';
@@ -33,6 +41,41 @@ XSLoader::load('HADES::TrbNet', $VERSION);
 
 # Preloaded methods go here.
 
+
+sub trb_hash {
+    my ($trb_address, $register_address) = @_;
+    my @a = trb_ra($trb_address, $register_address);
+    my %h;
+    #print Dumper %h;
+    %h = @a;
+    return \%h;
+
+}
+
+sub trb_uid {
+    my ($trb_address) = @_;
+    my @res = trb_uid_c($trb_address);
+
+    my $rh;
+
+    for (my $k = 0; $k < scalar @res; $k += 4) {
+       my $uid = ($res[$k] << 32) | $res[$k + 1];
+       my $endP = $res[$k + 2];
+       my $sender =  $res[$k + 3];
+       
+       $rh->{$uid}->{'trb_addr'} = $sender;
+       $rh->{$uid}->{'trb_endpoint_nr'} = $endP;
+    }
+
+    #my %h;
+    #print Dumper %h;
+    #%h = @a;
+    return $rh;
+
+}
+
+
+
 1;
 __END__
 # Below is stub documentation for your module. You'd better edit it!
@@ -46,7 +89,7 @@ HADES::TrbNet - Perl extension for the libtrbnet library, also via RPC calls
  #!/usr/bin/perl
  use warnings; 
  use strict;
- use HADES::TrbNet qw(trb_rr trb_wr init_ports);
+ use HADES::TrbNet qw(trb_rr trb_wr init_ports trb_strerror);
 
  my $connect_status = &init_ports();
  my @res; my $res;

diff --git a/libtrbnet_perl/test/test.pl b/libtrbnet_perl/test/test.pl
index 9456e286d0a016792917e10e4d2f8b7bb8fcb129..939d6f4121b7228cf8f865ca7d3a0989062ba57d 100755 (executable)
--- a/libtrbnet_perl/test/test.pl
+++ b/libtrbnet_perl/test/test.pl
@@ -4,16 +4,33 @@ use strict;
 use Data::Dumper;
 #use Data::HexDump;
 
-use HADES::TrbNet qw(trb_uid init_ports);
+use HADES::TrbNet; # qw(trb_uid init_ports trb_err trb_errnum trb_hash);
 
-my $connect_status = init_ports();
+init_ports() or die "Failed init_ports: ", trb_errStr();
 
-my @res = trb_uid(0xffff);
+my @a = ();
+my $rh_hash;
+foreach (1..1) {
+    $rh_hash = trb_hash(0xffff, 0x0);
+    push @a, $rh_hash;
+}
+#print Dumper $rh_hash;
+foreach my $cur_key (keys %$rh_hash) {
+#    printf "addr: 0x%04x: 0x%08x\n", $cur_key, $rh_hash->{$cur_key};
+}
+
+#print %$rh_hash;
+
+#exit 0;
 
-#print Dumper \@res;
-for (my $k = 0; $k < scalar @res; $k += 4) {
-       my $uid = ($res[$k] << 32) | $res[$k + 1];
-    my $endP = $res[$k + 2];
-    my $sender =  $res[$k + 3]; 
-    printf "0x%04x  0x%016x  0x%02x\n",  $sender, $uid , $endP;
+
+my $res = trb_uid(0xfffb);
+foreach my $cur_key (sort {$a <=> $b } keys %$res) {
+    printf "uid: 0x%016x  ==> addr: 0x%08x: endpoint: 0x%02x\n", $cur_key,
+    $res->{$cur_key}->{'trb_addr'}, $res->{$cur_key}->{'trb_endpoint_nr'} ;
 }
+
+
+#print Dumper $res;
+exit;
+