cap5: Add replace_access_rights_event() channel method

src/ca/client/perl/CA.pm

@@ -4,7 +4,7 @@
 use strict;
 use warnings;
 
-my $version = '0.5';
+my $version = '0.6';
 
 
 package CA;
@@ -316,6 +316,19 @@ channel; see the C<new> constructor for details.  If I<SUB> is C<undef> any
 existing handler is removed, otherwise the new subroutine will be used for all
 future connection events on this channel.
 
+
+=item change_access_rights_event( I<SUB> )
+
+This method replaces, adds or cancels an access rights handler subroutine for
+the channel, which will be called if the client's right to read from or write
+to the channel changes. If I<SUB> is C<undef> any existing handler is removed,
+otherwise the new subroutine will be used for all future rights change events
+on this channel.
+
+The arguments passed to I<SUB> are the channel object and a pair of scalar
+values for read and write permissions respectively, that are true when the
+access is permitted, false when it is not.
+
 =back
 
 
@@ -636,9 +649,9 @@ not follow this pattern, but are still printable strings.
 
 =over
 
-=item [1] R3.14 Channel Access Reference Manual by Jeffrey O. Hill
+=item [1] R3.15 Channel Access Reference Manual by Jeffrey O. Hill
 
-L<http://www.aps.anl.gov/epics/base/R3-14/12-docs/CAref.html>
+L<http://www.aps.anl.gov/epics/base/R3-15/0-docs/CAref.html>
 
 =back
 

src/ca/client/perl/Cap5.xs

@@ -519,6 +519,46 @@ void CA_change_connection_event(SV *ca_ref, SV *sub) {
     }
 }
 
+/* CA::replace_access_rights_event($ca_ref, \$sub) */
+
+static
+void rights_handler(struct access_rights_handler_args arha) {
+    CA_channel *pch = ca_puser(arha.chid);
+
+    PERL_SET_CONTEXT(p5_ctx);
+    {
+        dSP;
+
+        SvSetSV(ERRSV, &PL_sv_undef);
+
+        PUSHMARK(SP);
+        XPUSHs(pch->chan_ref);
+        XPUSHs(arha.ar.read_access ? &PL_sv_yes : &PL_sv_no);
+        XPUSHs(arha.ar.write_access ? &PL_sv_yes : &PL_sv_no);
+        PUTBACK;
+
+        call_sv(pch->rights_sub, G_EVAL | G_VOID | G_DISCARD | G_KEEPERR);
+
+        if (SvTRUE(ERRSV))
+            croak(NULL);
+    }
+}
+
+void CA_replace_access_rights_event(SV *ca_ref, SV *sub) {
+    CA_channel *pch = (CA_channel *)SvIV(SvRV(ca_ref));
+    caCh *handler = &rights_handler;
+    int status;
+
+    if (! replace_handler(sub, &pch->rights_sub, (long *)&handler))
+        return;
+
+    status = ca_change_connection_event(pch->chan, handler);
+
+    if (status != ECA_NORMAL) {
+        croak("%s", get_error_msg(status));
+    }
+}
+
 
 /* CA::put($ca_ref, @values) */
 
@@ -1265,6 +1305,11 @@ CA_change_connection_event (ca_ref, sub)
 	SV *	ca_ref
 	SV *	sub
 
+void
+CA_replace_access_rights_event (ca_ref, sub)
+	SV *	ca_ref
+	SV *	sub
+
 void
 CA_put (ca_ref, val, ...)
 	SV *	ca_ref