path: root/dcopperl/DCOP.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifdef METHOD
#undef METHOD
#endif

#ifdef ref
#undef ref
#endif
#ifdef list
#undef list
#endif
#ifdef do_open
#undef do_open
#endif
#ifdef do_close
#undef do_close
#endif
#ifdef assert
#undef assert
#endif
#ifdef vform
#undef vform
#endif

#include <cassert>

#include <tqpoint.h>
#include <tqrect.h>
#include <tqregexp.h>
#include <tqsize.h>
#include <tqstringlist.h>

#include <dcopclient.h>
#include <dcopref.h>
#include <kdatastream.h>
#include <kurl.h>

int intFromSV(SV *data)
{
    if (!SvOK(data))
        return 0;
    if (!SvIOK(data))
        croak("DCOP: Cannot convert to integer");
    return SvIV(data);
}

SV *intToSV(int data, SV * self = 0)
{
    return newSViv(data);
}

uint uintFromSV(SV *data)
{
    if (!SvOK(data))
        return 0;
    if (!SvIOK(data))
        croak("DCOP: Cannot convert to integer");
    return SvIV(data);
}

SV *uintToSV(uint data, SV * self = 0)
{
    return newSViv(data);
}


bool boolFromSV(SV *data)
{
	if (!SvOK(data))
		return false;
	if (SvIOK(data))
		return SvIV(data);
	if (SvPOK(data))
		return TQCString(SvPV(data, PL_na)).lower() == "true";
	croak("DCOP: Cannot convert to bool");
}

SV *boolToSV(bool data, SV *self = 0)
{
	return newSViv(data ? 1 : 0);
}

TQCString TQCStringFromSV(SV *data)
{
    if (!SvOK(data))
        return TQCString();
    if (!SvPOK(data))
        croak("DCOP: Cannot convert to TQCString");
    return SvPV(data, PL_na);
}

SV *TQCStringToSV(const TQCString &data, SV * self = 0)
{
    return data.isNull() ? &PL_sv_undef : newSVpv(data.data(), 0);
}

TQString TQStringFromSV(SV *data)
{
    if (!SvOK(data))
        return TQString::null;
    if (!SvPOK(data))
        croak("DCOP: Cannot convert to TQString");
    return SvPV(data, PL_na);
}

SV *TQStringToSV(const TQString &data, SV * self = 0)
{
    return data.isNull() ? &PL_sv_undef : newSVpv((char *)data.latin1(), 0);
}

QCStringList QCStringListFromSV(SV *data)
{
    if (!SvROK(data))
        croak("DCOP: Not reference");
    if (SvTYPE(SvRV(data)) != SVt_PVAV)
        croak("DCOP: Not an array reference");
    QCStringList result;
    for (int i = 0; i <= av_len((AV*)SvRV(data)); i++)
        result.append(TQCStringFromSV(av_fetch((AV*)SvRV(data), i, 0)[0]));
    return result;
}

SV *QCStringListToSV(const QCStringList &data, SV * self = 0)
{
    AV *result = newAV();
    for (QCStringList::ConstIterator i = data.begin(); i != data.end(); i++)
        av_push(result, TQCStringToSV(*i));
    return newRV((SV*)result);
}

TQStringList TQStringListFromSV(SV *data)
{
    if (!SvROK(data))
        croak("DCOP: Not reference");
    if (SvTYPE(SvRV(data)) != SVt_PVAV)
        croak("DCOP: Not an array reference");
    TQStringList result;
    for (int i = 0; i <= av_len((AV*)SvRV(data)); i++)
        result.append(TQCStringFromSV(av_fetch((AV*)SvRV(data), i, 0)[0]));
    return result;
}

SV *TQStringListToSV(const TQStringList &data, SV * self = 0)
{
    AV *result = newAV();
    for (TQStringList::ConstIterator i = data.begin(); i != data.end(); i++)
        av_push(result, TQStringToSV(*i));
    return newRV((SV*)result);
}

TQPoint TQPointFromSV(SV *data)
{
    if (!SvROK(data))
        croak("DCOP: Not reference");
    if (SvTYPE(SvRV(data)) != SVt_PVAV)
        croak("DCOP: Not an array reference");
    if (av_len((AV*)SvRV(data)) != 1)
        croak("DCOP: A TQPoint must have exactly 2 components");
    SV **pts = av_fetch((AV*)SvRV(data), 0, 0);
    return TQPoint(intFromSV(pts[0]), intFromSV(pts[1]));
}

SV *TQPointToSV(const TQPoint &data, SV * self = 0)
{
    SV *pts[2] = {
        intToSV(data.x()),
        intToSV(data.y())
    };
    return newRV((SV*)av_make(2, pts));
}

TQSize TQSizeFromSV(SV *data)
{
    if (!SvROK(data))
        croak("DCOP: Not reference");
    if (SvTYPE(SvRV(data)) != SVt_PVAV)
        croak("DCOP: Not an array reference");
    if (av_len((AV*)SvRV(data)) != 1)
        croak("DCOP: A TQSize must have exactly 2 components");
    SV **ext = av_fetch((AV*)SvRV(data), 0, 0);
    return TQSize(intFromSV(ext[0]), intFromSV(ext[1]));
}

SV *TQSizeToSV(const TQSize &data, SV * self = 0)
{
    SV *ext[2] = {
        intToSV(data.width()),
        intToSV(data.height())
    };
    return newRV((SV*)av_make(2, ext));
}

TQRect TQRectFromSV(SV *data)
{
    if (!SvROK(data))
        croak("DCOP: Not a reference");
    if (SvTYPE(SvRV(data)) != SVt_PVAV)
        croak("DCOP: Not an array reference");
    if (av_len((AV*)SvRV(data)) != 1)
        croak("DCOP: A TQRect must have exactly 4 components");
    SV **rc = av_fetch((AV*)SvRV(data), 0, 0);
    return TQRect(intFromSV(rc[0]), intFromSV(rc[1]), intFromSV(rc[2]), intFromSV(rc[3]));
}

SV *TQRectToSV(const TQRect &data, SV * self = 0)
{
    SV *rc[4] = {
        intToSV(data.left()),
        intToSV(data.top()),
        intToSV(data.width()),
        intToSV(data.height())
    };
    return newRV((SV*)av_make(4, rc));
}

KURL KURLFromSV(SV *data)
{
    return KURL(TQStringFromSV(data));
}

SV *KURLToSV(const KURL &data, SV * self = 0)
{
    return TQStringToSV(data.url());
}

DCOPRef DCOPRefFromSV(SV *data)
{
    if (!sv_isa(data, "DCOP::Object"))
        croak("DCOP: Not a DCOP::Object");
    SV **app = hv_fetch((HV*)SvRV(data), "APP", 3, 0);
    SV **obj = hv_fetch((HV*)SvRV(data), "OBJ", 3, 0);
    return DCOPRef(TQCStringFromSV(app[0]), TQCStringFromSV(obj[0]));
}

SV *DCOPRefToSV(const DCOPRef &data, SV * self)
{
    SV *ref = newRV((SV*)newHV());
    hv_store((HV*)SvRV(ref), "CLIENT", 6, SvREFCNT_inc(self), 0);
    hv_store((HV*)SvRV(ref), "APP", 3, TQCStringToSV(data.app()), 0);
    hv_store((HV*)SvRV(ref), "OBJ", 3, TQCStringToSV(data.object()), 0);
    return sv_bless(ref, gv_stashpv("DCOP::Object", 0));
}

# // Yes, defines *are* ugly...
#define CHECK_ARG(t)                \
    if ((*it) == #t)                \
        s << t##FromSV(data[i]);

#define CHECK_REPLY(t)              \
    if (replyType == #t)            \
    {                               \
        t r;                        \
        s >> r;                     \
        return t##ToSV(r, self);    \
    }

#define DATA(func, argn) mapArgs(func, &ST(argn), items - argn)

TQByteArray mapArgs(const TQCString &func, SV **data, int n)
{
    int p = func.find('('),
        q = func.find(')');
    if (p == -1 || q == -1 || q < p)
        croak("DCOP: Invalid function signature \"%s\"", func.data());
    TQStringList types = TQStringList::split(',', func.mid(p + 1, q - p - 1));
    TQByteArray result;
    TQDataStream s(result, IO_WriteOnly);
    TQStringList::ConstIterator it = types.begin();
    for (int i = 0; i < n; ++i, ++it)
    {
        if (it == types.end())
            croak("DCOP: Too many (%d) arguments to function \"%s\"", n, func.data());
        CHECK_ARG(int)
        else CHECK_ARG(uint)
        else CHECK_ARG(bool)
        else CHECK_ARG(TQCString)
        else CHECK_ARG(TQString)
        else CHECK_ARG(QCStringList)
        else CHECK_ARG(TQStringList)
        else CHECK_ARG(TQPoint)
        else CHECK_ARG(TQSize)
        else CHECK_ARG(TQRect)
        else CHECK_ARG(KURL)
        else CHECK_ARG(DCOPRef)
        else
            croak("DCOP: Sorry, passing a %s is not implemented", (*it).latin1());
    }
    if (it != types.end())
        croak("DCOP: Too few (%d) arguments to function \"%s\"", n, func.data());
    return result;
}

SV* mapReply(const TQCString &replyType, const TQByteArray &replyData, SV *self)
{
    if (replyType == "void")
        return sv_newmortal();
    TQDataStream s(replyData, IO_ReadOnly);
    CHECK_REPLY(int)
    else CHECK_REPLY(uint)
    else CHECK_REPLY(bool)
    else CHECK_REPLY(TQCString)
    else CHECK_REPLY(TQString)
    else CHECK_REPLY(QCStringList)
    else CHECK_REPLY(TQStringList)
    else CHECK_REPLY(TQPoint)
    else CHECK_REPLY(TQSize)
    else CHECK_REPLY(TQRect)
    else CHECK_REPLY(KURL)
    else CHECK_REPLY(DCOPRef)
    else croak("Sorry, receiving a %s is not implemented", replyType.data());
}

bool isMultiWordType(const TQString &type)
{
	return type == "unsigned" || type == "signed" || type == "long";
}

TQCString canonicalizeSignature(const TQCString &sig)
{
    TQCString normal = DCOPClient::normalizeFunctionSignature(sig);
	int p = normal.find('('), q = normal.find(')');
	TQCString result = normal.left(p + 1);
	result.remove(0, result.findRev(' ') + 1);

	TQStringList params = TQStringList::split(',', normal.mid(p + 1, q - p - 1));
	for (TQStringList::ConstIterator it = params.begin(); it != params.end(); ++it)
	{
		TQStringList words = TQStringList::split(' ', (*it).simplifyWhiteSpace());
		for (TQStringList::ConstIterator wi = words.begin(); wi != words.end(); ++wi)
			if (!isMultiWordType(*wi))
			{
				result += *wi;
				break;
			}
		if (it != params.fromLast())
			result += ',';
	}
	result += ')';

	return result;
}

MODULE = DCOP           PACKAGE = DCOP

PROTOTYPES: ENABLE

DCOPClient *
DCOPClient::new()
    OUTPUT:
        RETVAL

void
DCOPClient::DESTROY()

bool
DCOPClient::attach()
    OUTPUT:
        RETVAL

bool
DCOPClient::detach()
    OUTPUT:
        RETVAL

bool
DCOPClient::isAttached()
    OUTPUT:
        RETVAL

#if 0
TQCString
DCOPClient::registerAs(appId, ...)
        TQCString appId
    PREINIT:
        bool addPID = true;
    CODE:
        if (items > 3)
            croak("Usage: DCOP::registerAs(THIS, appId [, addPID])");
        if (items == 3)
            addPID = SvIV(ST(2));
        RETVAL = THIS->registerAs(appId, addPID);
    OUTPUT:
        RETVAL

bool
DCOPClient::isRegistered()
    OUTPUT:
        RETVAL

#endif

TQCString
DCOPClient::appId()
    OUTPUT:
        RETVAL

bool
DCOPClient::send(app, obj, func, ...)
        TQCString app
        TQCString obj
        TQCString func
    CODE:
        func = canonicalizeSignature(func);
        RETVAL = THIS->send(app, obj, func, DATA(func, 4));
    OUTPUT:
        RETVAL

SV*
DCOPClient::call(app, obj, func, ...)
        TQCString app
        TQCString obj
        TQCString func
    PPCODE:
        func = canonicalizeSignature(func);
        TQCString replyType;
        TQByteArray replyData;
        bool success;
        if ((success = THIS->call(app, obj, func, DATA(func, 4), replyType, replyData)))
            PUSHs(mapReply(replyType, replyData, ST(0)));
        else
            PUSHs(&PL_sv_undef);
        if (GIMME_V == G_ARRAY)
            PUSHs(success ? &PL_sv_yes : &PL_sv_no);

SV*
DCOPClient::findObject(app, obj, func, ...)
        TQCString app
        TQCString obj
        TQCString func
    PPCODE:
        func = canonicalizeSignature(func);
        TQCString foundApp;
        TQCString foundObj;
        if (!THIS->findObject(app, obj, func, DATA(func, 4), foundApp, foundObj))
            XSRETURN_UNDEF;
        PUSHs(TQCStringToSV(foundApp));
        PUSHs(TQCStringToSV(foundObj));

void
DCOPClient::emitDCOPSignal(obj, signal, ...)
        TQCString obj
        TQCString signal
    CODE:
        signal = canonicalizeSignature(signal);
        THIS->emitDCOPSignal(obj, signal, DATA(signal, 3));

bool
DCOPClient::isApplicationRegistered(app)
        TQCString app
    OUTPUT:
        RETVAL

QCStringList
DCOPClient::registeredApplications()
    OUTPUT:
        RETVAL

QCStringList
DCOPClient::remoteObjects(app)
        TQCString app
    OUTPUT:
        RETVAL

QCStringList
DCOPClient::remoteInterfaces(app, obj)
        TQCString app
        TQCString obj
    OUTPUT:
        RETVAL

QCStringList
DCOPClient::remoteFunctions(app, obj)
        TQCString app
        TQCString obj
    OUTPUT:
        RETVAL

static TQCString
DCOPClient::normalizeFunctionSignature(sig)
        TQCString sig
    OUTPUT:
        RETVAL

TQCString
canonicalizeSignature(sig)
        TQCString sig
    CODE:
        RETVAL = canonicalizeSignature(sig);
    OUTPUT:
        RETVAL