/*
 * Copyright (C) 2004-2025 ZNC, see the NOTICE file for details.
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

#include <znc/Chan.h>
#include <znc/FileUtils.h>
#include <znc/IRCSock.h>
#include <znc/Modules.h>
#include <znc/Nick.h>
#include <znc/User.h>
#include <znc/znc.h>

#include "modperl/module.h"
#include "modperl/swigperlrun.h"
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#if defined(__APPLE__) && defined(__MACH__)
#include <crt_externs.h>  // for _NSGetEnviron
#endif

#include "modperl/pstring.h"

using std::set;
using std::vector;

// Allows perl to load .so files when needed by .pm
// For example, it needs to load ZNC.so
extern "C" {
void boot_DynaLoader(pTHX_ CV* cv);
static void xs_init(pTHX) {
    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
}
}

class CModPerl : public CModule {
    PerlInterpreter* m_pPerl;

  public:
    MODCONSTRUCTOR(CModPerl) { m_pPerl = nullptr; }

#define PSTART   \
    dSP;         \
    I32 ax;      \
    int ret = 0; \
    ENTER;       \
    SAVETMPS;    \
    PUSHMARK(SP)
#define PCALL(name)                        \
    PUTBACK;                               \
    ret = call_pv(name, G_EVAL | G_ARRAY); \
    SPAGAIN;                               \
    SP -= ret;                             \
    ax = (SP - PL_stack_base) + 1
#define PEND  \
    ax += 0;  \
    PUTBACK;  \
    FREETMPS; \
    LEAVE
#define PUSH_STR(s) XPUSHs(PString(s).GetSV())
#define PUSH_PTR(type, p)                                                  \
    XPUSHs(SWIG_NewInstanceObj(const_cast<type>(p), SWIG_TypeQuery(#type), \
                               SWIG_SHADOW))

    bool OnLoad(const CString& sArgsi, CString& sMessage) override {
        CString sModPath, sTmp;
        if (!CModules::FindModPath("modperl/startup.pl", sModPath, sTmp)) {
            sMessage = "startup.pl not found.";
            return false;
        }
        sTmp = CDir::ChangeDir(sModPath, "..");
        int argc = 6;
        char* pArgv[] = {"",
                         "-T",
                         "-w",
                         "-I",
                         const_cast<char*>(sTmp.c_str()),
                         const_cast<char*>(sModPath.c_str()),
                         nullptr};
        char** argv = pArgv;
        char*** const pEnviron =
#if defined(__APPLE__) && defined(__MACH__)
            _NSGetEnviron();
#else
            &environ;
#endif
        PERL_SYS_INIT3(&argc, &argv, pEnviron);
        m_pPerl = perl_alloc();
        perl_construct(m_pPerl);
        if (perl_parse(m_pPerl, xs_init, argc, argv, *pEnviron)) {
            sMessage = "Can't initialize perl. ";
            if (SvTRUE(ERRSV)) {
                sMessage += PString(ERRSV);
            }
            perl_free(m_pPerl);
            PERL_SYS_TERM();
            m_pPerl = nullptr;
            DEBUG(__PRETTY_FUNCTION__ << " can't init perl");
            return false;
        }
        PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
        return true;
    }

    EModRet OnModuleLoading(const CString& sModName, const CString& sArgs,
                            CModInfo::EModuleType eType, bool& bSuccess,
                            CString& sRetMsg) override {
        EModRet result = HALT;
        PSTART;
        PUSH_STR(sModName);
        PUSH_STR(sArgs);
        mXPUSHi(eType);
        PUSH_PTR(CUser*, GetUser());
        PUSH_PTR(CIRCNetwork*, GetNetwork());
        PCALL("ZNC::Core::LoadModule");

        if (SvTRUE(ERRSV)) {
            sRetMsg = PString(ERRSV);
            bSuccess = false;
            result = HALT;
            DEBUG("Perl ZNC::Core::LoadModule died: " << sRetMsg);
        } else if (ret < 1 || 2 < ret) {
            sRetMsg = "Error: Perl ZNC::Core::LoadModule returned " +
                      CString(ret) + " values.";
            bSuccess = false;
            result = HALT;
        } else {
            ELoadPerlMod eLPM = static_cast<ELoadPerlMod>(SvUV(ST(0)));
            if (Perl_NotFound == eLPM) {
                result = CONTINUE;  // Not a Perl module
            } else {
                sRetMsg = PString(ST(1));
                result = HALT;
                bSuccess = eLPM == Perl_Loaded;
            }
        }

        PEND;
        return result;
    }

    EModRet OnModuleUnloading(CModule* pModule, bool& bSuccess,
                              CString& sRetMsg) override {
        CPerlModule* pMod = AsPerlModule(pModule);
        if (pMod) {
            EModRet result = HALT;
            CString sModName = pMod->GetModName();
            PSTART;
            XPUSHs(pMod->GetPerlObj());
            PCALL("ZNC::Core::UnloadModule");
            if (SvTRUE(ERRSV)) {
                bSuccess = false;
                sRetMsg = PString(ERRSV);
            } else if (ret < 1 || 2 < ret) {
                sRetMsg = "Error: Perl ZNC::Core::UnloadModule returned " +
                          CString(ret) + " values.";
                bSuccess = false;
                result = HALT;
            } else {
                int bUnloaded = SvUV(ST(0));
                if (bUnloaded) {
                    bSuccess = true;
                    sRetMsg = "Module [" + sModName + "] unloaded";
                    result = HALT;
                } else {
                    result = CONTINUE;  // module wasn't loaded by modperl.
                                        // Perhaps a module-provider written in
                                        // perl did that.
                }
            }
            PEND;
            DEBUG(__PRETTY_FUNCTION__ << " " << sRetMsg);
            return result;
        }
        return CONTINUE;
    }

    EModRet OnGetModInfo(CModInfo& ModInfo, const CString& sModule,
                         bool& bSuccess, CString& sRetMsg) override {
        PSTART;
        PUSH_STR(sModule);
        PUSH_PTR(CModInfo*, &ModInfo);
        PCALL("ZNC::Core::GetModInfo");
        EModRet result = CONTINUE;
        if (SvTRUE(ERRSV)) {
            bSuccess = false;
            sRetMsg = PString(ERRSV);
            DEBUG("Perl ZNC::Core::GetModInfo died: " << sRetMsg);
        } else if (0 < ret) {
            switch (static_cast<ELoadPerlMod>(SvUV(ST(0)))) {
                case Perl_NotFound:
                    result = CONTINUE;
                    break;
                case Perl_Loaded:
                    result = HALT;
                    if (1 == ret) {
                        bSuccess = true;
                    } else {
                        bSuccess = false;
                        sRetMsg = "Something weird happened";
                    }
                    break;
                case Perl_LoadError:
                    result = HALT;
                    bSuccess = false;
                    if (2 == ret) {
                        sRetMsg = PString(ST(1));
                    } else {
                        sRetMsg = "Something weird happened";
                    }
            }
        } else {
            result = HALT;
            bSuccess = false;
            sRetMsg = "Something weird happened";
        }
        PEND;
        return result;
    }

    void OnGetAvailableMods(set<CModInfo>& ssMods,
                            CModInfo::EModuleType eType) override {
        unsigned int a = 0;
        CDir Dir;

        CModules::ModDirList dirs = CModules::GetModDirs();

        while (!dirs.empty()) {
            Dir.FillByWildcard(dirs.front().first, "*.pm");
            dirs.pop();

            for (a = 0; a < Dir.size(); a++) {
                CFile& File = *Dir[a];
                CString sName = File.GetShortName();
                CString sPath = File.GetLongName();
                CModInfo ModInfo;
                sName.RightChomp(3);
                PSTART;
                PUSH_STR(sPath);
                PUSH_STR(sName);
                PUSH_PTR(CModInfo*, &ModInfo);
                PCALL("ZNC::Core::ModInfoByPath");
                if (SvTRUE(ERRSV)) {
                    DEBUG(__PRETTY_FUNCTION__ << ": " << sPath << ": "
                                              << PString(ERRSV));
                } else if (ModInfo.SupportsType(eType)) {
                    ssMods.insert(ModInfo);
                }
                PEND;
            }
        }
    }

    ~CModPerl() override {
        if (m_pPerl) {
            PSTART;
            PCALL("ZNC::Core::UnloadAll");
            PEND;
            perl_destruct(m_pPerl);
            perl_free(m_pPerl);
            PERL_SYS_TERM();
        }
    }
};

#include "modperl/perlfunctions.cpp"

VWebSubPages& CPerlModule::GetSubPages() {
    VWebSubPages* result = _GetSubPages();
    if (!result) {
        return CModule::GetSubPages();
    }
    return *result;
}

void CPerlTimer::RunJob() {
    CPerlModule* pMod = AsPerlModule(GetModule());
    if (pMod) {
        PSTART;
        XPUSHs(GetPerlObj());
        PCALL("ZNC::Core::CallTimer");
        PEND;
    }
}

CPerlTimer::~CPerlTimer() {
    CPerlModule* pMod = AsPerlModule(GetModule());
    if (pMod) {
        PSTART;
        XPUSHs(sv_2mortal(m_perlObj));
        PCALL("ZNC::Core::RemoveTimer");
        PEND;
    }
}

#define SOCKSTART \
    PSTART;       \
    XPUSHs(GetPerlObj())
#define SOCKCBCHECK(OnSuccess)                                  \
    PCALL("ZNC::Core::CallSocket");                             \
    if (SvTRUE(ERRSV)) {                                        \
        Close();                                                \
        DEBUG("Perl socket hook died with: " + PString(ERRSV)); \
    } else {                                                    \
        OnSuccess;                                              \
    }                                                           \
    PEND
#define CBSOCK(Func)                                   \
    void CPerlSocket::Func() {                         \
        CPerlModule* pMod = AsPerlModule(GetModule()); \
        if (pMod) {                                    \
            SOCKSTART;                                 \
            PUSH_STR("On" #Func);                      \
            SOCKCBCHECK();                             \
        }                                              \
    }
CBSOCK(Connected);
CBSOCK(Disconnected);
CBSOCK(Timeout);
CBSOCK(ConnectionRefused);

void CPerlSocket::ReadData(const char* data, size_t len) {
    CPerlModule* pMod = AsPerlModule(GetModule());
    if (pMod) {
        SOCKSTART;
        PUSH_STR("OnReadData");
        XPUSHs(sv_2mortal(newSVpvn(data, len)));
        mXPUSHi(len);
        SOCKCBCHECK();
    }
}
void CPerlSocket::ReadLine(const CString& sLine) {
    CPerlModule* pMod = AsPerlModule(GetModule());
    if (pMod) {
        SOCKSTART;
        PUSH_STR("OnReadLine");
        PUSH_STR(sLine);
        SOCKCBCHECK();
    }
}
Csock* CPerlSocket::GetSockObj(const CString& sHost, unsigned short uPort) {
    CPerlModule* pMod = AsPerlModule(GetModule());
    Csock* result = nullptr;
    if (pMod) {
        SOCKSTART;
        PUSH_STR("_Accepted");
        PUSH_STR(sHost);
        mXPUSHi(uPort);
        SOCKCBCHECK(result = SvToPtr<CPerlSocket>("CPerlSocket*")(ST(0)););
    }
    return result;
}

CPerlSocket::~CPerlSocket() {
    CPerlModule* pMod = AsPerlModule(GetModule());
    if (pMod) {
        PSTART;
        XPUSHs(sv_2mortal(m_perlObj));
        PCALL("ZNC::Core::RemoveSocket");
        PEND;
    }
}

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

GLOBALMODULEDEFS(CModPerl, t_s("Loads perl scripts as ZNC modules"))