From 7ce4eb96ea5492dcf1969c19e01c9a392608c6a2 Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Fri, 17 Sep 2010 14:11:00 -0500 Subject: [PATCH] cap5: Support dynamic array sizes through the Perl API. --- src/cap5/CA.pm | 5 ++++- src/cap5/Cap5.xs | 10 +++++----- src/cap5/caget.pl | 11 +++++++---- src/cap5/camonitor.pl | 12 +++++++----- 4 files changed, 23 insertions(+), 15 deletions(-) diff --git a/src/cap5/CA.pm b/src/cap5/CA.pm index b6abee296..19d9f95ae 100644 --- a/src/cap5/CA.pm +++ b/src/cap5/CA.pm @@ -210,7 +210,10 @@ data type requested will be the widened form of the channel's native type fetch all available elements. The element count can be overridden by providing an integer argument in the -range 1 .. C. The data type can also be given as a string naming +range 0 .. C, where zero means use the current length from the +server. Note that the count argument must be an integer; add 0 to it if it is +necessary to convert it from a string. +The optional data type I should be a string naming the desired C type; the actual type used will have the C part widened to one of C, C, C or C. The valid type names are listed in the L under the diff --git a/src/cap5/Cap5.xs b/src/cap5/Cap5.xs index d83674855..c3e4d0e50 100644 --- a/src/cap5/Cap5.xs +++ b/src/cap5/Cap5.xs @@ -782,7 +782,7 @@ void CA_get(SV *ca_ref) { New(0, pch->sdata, count + 1, char); pch->ssize = count; } - status = ca_array_get(DBF_CHAR, count, pch->chan, pch->sdata); + status = ca_array_get(DBF_CHAR, 0, pch->chan, pch->sdata); } else { status = ca_get(best_type(pch), pch->chan, &pch->data); } @@ -818,16 +818,16 @@ void CA_get_callback(SV *ca_ref, SV *sub, ...) { SV *get_sub = newSVsv(sub); int status; chtype type = best_type(pch); - int count = ca_element_count(pch->chan); + int count = 0; int i = 2; const char *croak_msg; while (items > i && SvOK(ST(i))) { if (SvIOK(ST(i))) { - /* Interger => Count arg */ + /* Interger => Count arg, zero means current size */ count = SvIV(ST(i)); - if (count < 1 || count > ca_element_count(pch->chan)) { + if (count < 0 || count > ca_element_count(pch->chan)) { croak_msg = "Requested array size is out of range"; goto exit_croak; } @@ -901,7 +901,7 @@ SV * CA_create_subscription(SV *ca_ref, const char *mask_str, SV *sub, ...) { while (items > i && SvOK(ST(i))) { if (SvIOK(ST(i))) { - /* Interger => Count arg, zero means native size */ + /* Interger => Count arg, zero means current size */ count = SvIV(ST(i)); if (count < 0 || count > ca_element_count(pch->chan)) { croak_msg = "Requested array size is out of range"; diff --git a/src/cap5/caget.pl b/src/cap5/caget.pl index 2e6639179..4f835348a 100644 --- a/src/cap5/caget.pl +++ b/src/cap5/caget.pl @@ -6,10 +6,12 @@ use FindBin qw($Bin); use lib "$Bin/../../lib/perl"; use Getopt::Std; +use Scalar::Util qw(looks_like_number); use CA; -our ($opt_0, $opt_a, $opt_c, $opt_d, $opt_e, $opt_f, $opt_g, $opt_h, $opt_n); +our ($opt_0, $opt_a, $opt_d, $opt_e, $opt_f, $opt_g, $opt_h, $opt_n); our ($opt_s, $opt_S, $opt_t); +our $opt_c = 0; our $opt_F = ' '; our $opt_w = 1; @@ -18,6 +20,9 @@ $Getopt::Std::OUTPUT_HELP_VERSION = 1; HELP_MESSAGE() unless getopts('0:ac:d:e:f:F:g:hnsStw:'); HELP_MESSAGE() if $opt_h; +die "caget: -c option takes a positive number\n" + unless looks_like_number($opt_c) && $opt_c >= 0; + die "No pv name specified. ('caget -h' gives help.)\n" unless @ARGV; @@ -51,9 +56,7 @@ map { if $opt_a; } $rtype{$_} = $type; - my $count = $_->element_count; - $count = +$opt_c if $opt_c && $opt_c <= $count; - $_->get_callback(\&get_callback, $type, $count); + $_->get_callback(\&get_callback, $type, 0+$opt_c); } @chans; my $incomplete = @chans; diff --git a/src/cap5/camonitor.pl b/src/cap5/camonitor.pl index 56c609141..559ec1233 100644 --- a/src/cap5/camonitor.pl +++ b/src/cap5/camonitor.pl @@ -6,9 +6,11 @@ use FindBin qw($Bin); use lib "$Bin/../../lib/perl"; use Getopt::Std; +use Scalar::Util qw(looks_like_number); use CA; -our ($opt_0, $opt_c, $opt_e, $opt_f, $opt_g, $opt_h, $opt_n, $opt_s, $opt_S); +our ($opt_0, $opt_e, $opt_f, $opt_g, $opt_h, $opt_n, $opt_s, $opt_S); +our $opt_c = 0; our $opt_F = ' '; our $opt_w = 1; our $opt_m = 'va'; @@ -18,6 +20,9 @@ $Getopt::Std::OUTPUT_HELP_VERSION = 1; HELP_MESSAGE() unless getopts('0:c:e:f:F:g:hm:nsSw:'); HELP_MESSAGE() if $opt_h; +die "caget: -c option takes a positive number\n" + unless looks_like_number($opt_c) && $opt_c >= 0; + die "No pv name specified. ('camonitor -h' gives help.)\n" unless @ARGV; @@ -45,11 +50,8 @@ sub conn_callback { || (!$opt_S && $type eq 'DBR_CHAR'); $type =~ s/^DBR_/DBR_TIME_/; - my $count = $chan->element_count; - $count = +$opt_c if $opt_c && $opt_c <= $count; - $monitors{$chan} = - $chan->create_subscription($opt_m, \&mon_callback, $type, $count); + $chan->create_subscription($opt_m, \&mon_callback, $type, 0+$opt_c); } }