Make modperl support AddServerDependentCapability

include/znc/Modules.h

@@ -1327,7 +1327,7 @@ class CModule {
      *  stopped supporting it. Note that it's not a strict toggle: e.g.
      *  sometimes client will disable the cap even when it was already disabled
      *  for that client.
-     *  For python modules, this function accepts 3 parameters:
+     *  For perl and python modules, this function accepts 3 parameters:
      *  name, server callback, client callback; signatures of the callbacks are
      *  the same as of the virtual functions you'd implement in C++.
      */
@@ -1414,8 +1414,9 @@ class CModule {
                             const CString& sContext = "") const;
 #endif
 
-    // Default implementations of several CAP callbacks to make
+    // Default implementations of several callbacks to make
     // AddServerDependentCapability work in modpython/modperl.
+    // Don't worry about existence of these functions.
     bool InternalServerDependentCapsOnServerCap302Available(
         const CString& sCap, const CString& sValue);
     void InternalServerDependentCapsOnServerCapResult(const CString& sCap,

modules/modperl.cpp

@@ -374,6 +374,41 @@ CPerlSocket::~CPerlSocket() {
     }
 }
 
+CPerlCapability::~CPerlCapability() {
+    SvREFCNT_dec(m_serverCb);
+    SvREFCNT_dec(m_clientCb);
+}
+
+void CPerlCapability::OnServerChangedSupport(CIRCNetwork* pNetwork, bool bState) {
+    PSTART;
+    PUSH_PTR(CIRCNetwork*, pNetwork);
+    mXPUSHi(bState);
+    PUTBACK;
+    ret = call_sv(m_serverCb, G_EVAL | G_ARRAY);
+    SPAGAIN;
+    SP -= ret;
+    ax = (SP - PL_stack_base) + 1;
+    if (SvTRUE(ERRSV)) {
+        DEBUG("Perl hook OnServerChangedSupport died with: " + PString(ERRSV));
+    }
+    PEND;
+}
+
+void CPerlCapability::OnClientChangedSupport(CClient* pClient, bool bState) {
+    PSTART;
+    PUSH_PTR(CClient*, pClient);
+    mXPUSHi(bState);
+    PUTBACK;
+    ret = call_sv(m_clientCb, G_EVAL | G_ARRAY);
+    SPAGAIN;
+    SP -= ret;
+    ax = (SP - PL_stack_base) + 1;
+    if (SvTRUE(ERRSV)) {
+        DEBUG("Perl hook OnServerChangedSupport died with: " + PString(ERRSV));
+    }
+    PEND;
+}
+
 template <>
 void TModInfo<CModPerl>(CModInfo& Info) {
     Info.SetWikiPage("modperl");

modules/modperl/modperl.i

@@ -189,6 +189,10 @@ class MCString : public std::map<CString, CString> {};
 	bool ExistsNV(const CString& sName) {
 		return $self->EndNV() != $self->FindNV(sName);
 	}
+    void AddServerDependentCapability(const CString& sName, SV* serverCb,
+                                      SV* clientCb) {
+        $self->AddServerDependentCapability(sName, std::make_unique<CPerlCapability>(serverCb, clientCb));
+	}
 }
 
 %extend CModules {

modules/modperl/module.h

@@ -216,6 +216,20 @@ inline CPerlSocket* CreatePerlSocket(CPerlModule* pModule, SV* perlObj) {
     return new CPerlSocket(pModule, perlObj);
 }
 
+class ZNC_EXPORT_LIB_EXPORT CPerlCapability : public CCapability {
+  public:
+    CPerlCapability(SV* serverCb, SV* clientCb)
+        : m_serverCb(newSVsv(serverCb)), m_clientCb(newSVsv(clientCb)) {}
+    ~CPerlCapability();
+
+    void OnServerChangedSupport(CIRCNetwork* pNetwork, bool bState) override;
+    void OnClientChangedSupport(CClient* pClient, bool bState) override;
+
+  private:
+    SV* m_serverCb;
+    SV* m_clientCb;
+};
+
 inline bool HaveIPv6() {
 #ifdef HAVE_IPV6
     return true;

test/integration/tests/core.cpp

@@ -556,7 +556,7 @@ TEST_F(ZNCTest, CAP302LSValue) {
 
 class AllLanguages : public ZNCTest, public testing::WithParamInterface<int> {};
 
-INSTANTIATE_TEST_CASE_P(LanguagesTests, AllLanguages, testing::Values(1, 2));
+INSTANTIATE_TEST_CASE_P(LanguagesTests, AllLanguages, testing::Values(1, 2, 3));
 
 TEST_P(AllLanguages, ServerDependentCapInModule) {
     auto znc = Run();
@@ -607,6 +607,24 @@ TEST_P(AllLanguages, ServerDependentCapInModule) {
                     "DISABLED_ZNC_PERL_PYTHON_TEST") == "1") {
                 return;
             }
+            znc->CanLeak();
+            InstallModule("testmod.pm", R"(
+                package testmod;
+                use base 'ZNC::Module';
+                sub OnLoad {
+                    my $self = shift;
+                    my $listen = $self->AddServerDependentCapability('testcap', sub {
+                        my ($net, $state) = @_;
+                        $self->PutModule('Server changed support: ' . ($state ? 'true' : 'false'));
+                    }, sub {
+                        my ($client, $state) = @_;
+                        $self->PutModule('Client changed support: ' . ($state ? 'true' : 'false'));
+                    });
+                    return 1;
+                }
+                1;
+            )");
+            client.Write("znc loadmod modperl");
             break;
     }
     client.Write("znc loadmod testmod");