epics/epics-base
0
0
Fork 0
Code Issues Pull Requests Projects Wiki Activity

cap5: Support dynamic array sizes through the Perl API.

Browse Source
This commit is contained in:
Andrew Johnson
2010-09-17 14:11:00 -05:00
parent 85c2877746
commit 7ce4eb96ea
4 changed files with 23 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/cap5/CA.pm
View File

@@ -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<element_count>. The data type can also be given as a string naming
range 0 .. C<element_count>, 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<TYPE> should be a string naming
the desired C<DBR_xxx_yyy> type; the actual type used will have the C<yyy> part
widened to one of C<STRING>, C<CHAR>, C<LONG> or C<DOUBLE>. The valid type
names are listed in the L<Channel Access Reference Manual|/"SEE ALSO"> under the

10
src/cap5/Cap5.xs
View File

@@ -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";

11
src/cap5/caget.pl
View File

@@ -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;

12
src/cap5/camonitor.pl
View File

@@ -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);
}
}