added functions trb_registertime_read and trb_registertime_read_mem, L.M.

diff --git a/libtrbnet_perl/MYMETA.yml b/libtrbnet_perl/MYMETA.yml
new file mode 100644 (file)
index 0000000..fbd0d24
--- /dev/null
+++ b/libtrbnet_perl/MYMETA.yml
@@ -0,0 +1,22 @@
+---
+abstract: 'Perl extension for the libtrbnet library, also via RPC calls'
+author:
+  - 'Hades DAQ <hadaq@>'
+build_requires:
+  ExtUtils::MakeMaker: 0
+configure_requires:
+  ExtUtils::MakeMaker: 0
+distribution_type: module
+dynamic_config: 0
+generated_by: 'ExtUtils::MakeMaker version 6.57_05'
+license: unknown
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: HADES-TrbNet
+no_index:
+  directory:
+    - t
+    - inc
+requires: {}
+version: 0.01

diff --git a/libtrbnet_perl/TrbNet.xs b/libtrbnet_perl/TrbNet.xs
index 49f97754130567b24c5b546a991a63fb8f0107ff..d3eac6de57d90271a0e39424c3f81341c2a45ca2 100644 (file)
--- a/libtrbnet_perl/TrbNet.xs
+++ b/libtrbnet_perl/TrbNet.xs
@@ -65,6 +65,23 @@ trb_register_read_c(trb_address, reg_address)
           XPUSHs(sv_2mortal(newSVuv(buffer[i])));
        }
 
+void
+trb_registertime_read_c(trb_address, reg_address)
+       U16 trb_address;
+       U16 reg_address;
+     INIT:
+       int status;
+       int i;
+
+     PPCODE:
+       status = trb_registertime_read(trb_address, reg_address, (uint32_t*)buffer, BUFFER_SIZE);
+       if (status <= 0) {
+          XSRETURN_UNDEF;
+       }
+       for (i = 0 ; i < status; i++) {
+          XPUSHs(sv_2mortal(newSVuv(buffer[i])));
+       }
+
 void
 trb_register_read_mem_c(trb_address, reg_address, option, size)
        U16 trb_address;
@@ -84,6 +101,25 @@ trb_register_read_mem_c(trb_address, reg_address, option, size)
           XPUSHs(sv_2mortal(newSVuv(buffer[i])));
        }
 
+void
+trb_registertime_read_mem_c(trb_address, reg_address, option, size)
+       U16 trb_address;
+       U16 reg_address;
+       U16 option;
+       U16 size;
+     INIT:
+       int status;
+       int i;
+
+     PPCODE:
+       status = trb_registertime_read_mem(trb_address, reg_address, option, size, (uint32_t*)buffer, BUFFER_SIZE);
+       if (status <= 0) {
+          XSRETURN_UNDEF;
+       }
+       for (i = 0 ; i < status; i++) {
+          XPUSHs(sv_2mortal(newSVuv(buffer[i])));
+       }
+
 void
 trb_register_write(trb_address, reg_address, value)
        U16 trb_address

diff --git a/libtrbnet_perl/lib/HADES/TrbNet.pm b/libtrbnet_perl/lib/HADES/TrbNet.pm
index 9118d17197480b2a0f8296d0b5c1345cc56e45e7..51108cc7ef73e05306ecc321a13b6e40f969d085 100644 (file)
--- a/libtrbnet_perl/lib/HADES/TrbNet.pm
+++ b/libtrbnet_perl/lib/HADES/TrbNet.pm
@@ -17,20 +17,24 @@ 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_errno
-       trb_error
-       trb_strerror
-       trb_init_ports
-       trb_register_read
-       trb_register_read_c
-       trb_register_read_mem
-       trb_register_read_mem_c
-       trb_register_write
-       trb_read_uid
-       trb_read_uid_c
-       trb_nettrace
-       trb_nettrace_c
-) ] );
+                                   trb_errno
+                                   trb_error
+                                   trb_strerror
+                                   trb_init_ports
+                                   trb_register_read
+                                   trb_registertime_read
+                                   trb_register_read_c
+                                   trb_registertime_read_c
+                                   trb_register_read_mem
+                                   trb_registertime_read_mem
+                                   trb_register_read_mem_c
+                                   trb_registertime_read_mem_c
+                                   trb_register_write
+                                   trb_read_uid
+                                   trb_read_uid_c
+                                   trb_nettrace
+                                   trb_nettrace_c
+                                ) ] );
 
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
@@ -44,70 +48,113 @@ XSLoader::load('HADES::TrbNet', $VERSION);
 # Preloaded methods go her
 
 sub trb_register_read {
-    my ($trb_address, $register_address) = @_;
-    my @res = trb_register_read_c($trb_address, $register_address);
-    return if (! defined $res[0]);
+  my ($trb_address, $register_address) = @_;
+  my @res = trb_register_read_c($trb_address, $register_address);
+  return if (! defined $res[0]);
+
+  my %hash;
+  %hash = @res;
+  return \%hash;
+}
+
+sub trb_registertime_read {
+  my ($trb_address, $register_address) = @_;
+  my @res = trb_registertime_read_c($trb_address, $register_address);
+  return if (! defined $res[0]);
+
+  my %hash;
+  my $len_array = scalar @res;
+  for (my $i = 0; ($i + 3) <= $len_array; $i += 3) {
+    my $trb_address = $res[$i] & 0xffff;
+    $hash{$trb_address}->{'value'} = $res[$i + 1];
+    $hash{$trb_address}->{'time'} = $res[$i + 2];
+  }
 
-    my %hash;
-    %hash = @res;
-    return \%hash;
+  return \%hash;
 }
 
 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 %hash;
-    my $k = 0;
-    my $len_array = scalar @res;
-    while ($k < $len_array) {
-       my $len = ($res[$k] >> 16) & 0xffff;
-       my $trb_address = $res[$k] & 0xffff;
-       my @array;
-       $k++;
-
-       for (my $i = 0; $i < $len ; $i++, $k++) {
-           push (@array, $res[$k]);
-       }
-       $hash{$trb_address} = \@array;
+  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 %hash;
+  my $k = 0;
+  my $len_array = scalar @res;
+  while ($k < $len_array) {
+    my $len = ($res[$k] >> 16) & 0xffff;
+    my $trb_address = $res[$k] & 0xffff;
+    my @array;
+    $k++;
+
+    for (my $i = 0; $i < $len ; $i++, $k++) {
+      push (@array, $res[$k]);
     }
+    $hash{$trb_address} = \@array;
+  }
 
-    return \%hash;
+  return \%hash;
 }
 
-sub trb_read_uid {
-    my ($trb_address) = @_;
-    my @res = trb_read_uid_c($trb_address);
-    return if (! defined $res[0]);
-
-    my %hash;
-    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];
-
-       $hash{$uid}->{'trb_address'} = $sender;
-       $hash{$uid}->{'trb_endpoint'} = $endP;
+sub trb_registertime_read_mem {
+  my ($trb_address, $register_address, $option, $size) = @_;
+  my @res = trb_registertime_read_mem_c($trb_address, $register_address,
+                                   $option, $size);
+  return if (! defined $res[0]);
+
+  my %hash;
+  my $k = 0;
+  my $len_array = scalar @res;
+  while ($k < $len_array) {
+    my $len = ($res[$k] >> 16) & 0xffff;
+    my $trb_address = $res[$k] & 0xffff;
+    my @array_val;
+    my @array_time;
+    $k++;
+
+    for (my $i = 0; ($i < $len) && (($k + 1) < $len_array); $i++, $k += 2) {
+      push (@array_val, $res[$k]);
+      push (@array_time, $res[$k + 1]);
     }
+    $hash{$trb_address}->{'value'} = \@array_val;
+    $hash{$trb_address}->{'time'} = \@array_time;
+  }
 
-    return \%hash;
+  return \%hash;
 }
 
-sub trb_nettrace {
-    my ($trb_address) = @_;
-    my @res = trb_nettrace_c($trb_address);
-    return if (! defined $res[0]);
+sub trb_read_uid {
+  my ($trb_address) = @_;
+  my @res = trb_read_uid_c($trb_address);
+  return if (! defined $res[0]);
 
-    my @array;
-    my $c = 0;
-    for (my $i = 0; $i < scalar @res; $i += 2) {
-      $array[$c]->{'address'} = $res[$i];
-      $array[$c]->{'port'} = $res[$i + 1];
-      $c++;
-    }
-    return \@array;
+  my %hash;
+  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];
+
+    $hash{$uid}->{'trb_address'} = $sender;
+    $hash{$uid}->{'trb_endpoint'} = $endP;
+  }
+
+  return \%hash;
+}
+
+sub trb_nettrace {
+  my ($trb_address) = @_;
+  my @res = trb_nettrace_c($trb_address);
+  return if (! defined $res[0]);
+
+  my @array;
+  my $c = 0;
+  for (my $i = 0; $i < scalar @res; $i += 2) {
+    $array[$c]->{'address'} = $res[$i];
+    $array[$c]->{'port'} = $res[$i + 1];
+    $c++;
+  }
+  return \@array;
 }
 
 1;

diff --git a/libtrbnet_perl/test/test_readtime.pl b/libtrbnet_perl/test/test_readtime.pl
new file mode 100755 (executable)
index 0000000..016aef9
--- /dev/null
+++ b/libtrbnet_perl/test/test_readtime.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Data::Dumper;
+
+use HADES::TrbNet;
+
+trb_init_ports() or die "Failed trb_init_ports: ", trb_strerror();
+
+my $ref;
+
+$ref = trb_registertime_read(0xffff, 0x0) or die "trb_registertime_read: ",
+  trb_strerror();
+
+print Dumper $ref;
+
+$ref = trb_registertime_read_mem(0x8001, 0x4031, 0, 5) or die "trb_registertime_read_mem: ",
+  trb_strerror();
+
+print Dumper $ref;
+
+
+exit;
+