Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features.

BUG:215923


git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdebindings@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da

13 files changed, 1090 insertions, 0 deletions

diff --git a/dcopperl/AUTHORS b/dcopperl/AUTHORS
new file mode 100644
index 00000000..9f0ed935
--- /dev/null
+++ b/dcopperl/AUTHORS
@@ -0,0 +1 @@
+Malte Starostik <malte@kde.org>
diff --git a/dcopperl/Changes b/dcopperl/Changes
new file mode 100644
index 00000000..1d84f77e
--- /dev/null
+++ b/dcopperl/Changes
@@ -0,0 +1,5 @@
+Revision history for Perl extension DCOP.
+
+0.01  Thu Aug 24 15:46:42 2000
+	- original version; created by h2xs 1.19
+
diff --git a/dcopperl/DCOP.pm b/dcopperl/DCOP.pm
new file mode 100644
index 00000000..ff463362
--- /dev/null
+++ b/dcopperl/DCOP.pm
@@ -0,0 +1,303 @@
+package DCOP;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+use DynaLoader;
+use DCOP::Object;
+
+@ISA = qw(DynaLoader);
+
+$VERSION = '0.01';
+
+bootstrap DCOP $VERSION;
+
+# Returns a DCOP::Object that is logically bound to a specific object of a specific app
+sub createObject
+{
+    my ($self, $app, $obj) = @_;
+    $obj = "default" unless defined $obj;
+    $self = {
+        CLIENT  => $self,
+        APP     => $app,
+        OBJ     => $obj,
+    };
+    bless $self, "DCOP::Object";
+}
+
+# That's it :)
+
+1;
+__END__
+
+=head1 NAME
+
+DCOP - Perl extension for communcation with KDE's DCOP server
+
+=head1 SYNOPSIS
+
+use DCOP;
+
+my $client = new DCOP;
+$client->attach();
+$running_apps = $client->registeredApplications();
+$client->send("kmail", "KMailIface", "checkMail()");
+
+my $kmail = $client->createObject("kmail", "KMailIface");
+$kmail->openComposer("fred@outer.space",
+                     undef,
+                     undef,
+                     "This is a mail initiated by DCOP.pm",
+                     0,
+                     "file:/home/joe/file/with/mail/to/send");
+
+=head1 DESCRIPTION
+
+The Desktop COmmunication Protocol is used by almost every KDE application
+and is a lightweight but powerful IPC mechanism. For more information look at
+
+http://developer.kde.org/documentation/library/2.0-api/dcop/HOWTO.html
+
+This Perl extension can be used to send commands to any currently registered
+DCOP application, as well as query which apps are registered and what
+interfaces with what functions they offer. Additionally you can use DCOP::Object
+to trigger DCOP sends or calls as native methods of DCOP::Object
+(see the secion on Autoload Magic below).
+
+=head2 Creation, Attachment and Registration
+
+Creating a DCOP client is as simple as it gets:
+
+  use DCOP;
+
+  $client = new DCOP;
+
+That's it. Some arguments to new are planned for future releases.
+After creation the client is not attached to the server. The easiest way to
+establish a connection is
+
+  $client->attach();
+
+which registers your DCOP client anonymously.
+To register with a well known name use:
+
+  $client->registerAs("fred");
+NOTE: registerAs is currently disabled
+
+To close the connection, simply call
+
+  $client->detach();
+
+=head2 Hello World!
+
+Now that you have your client registered with the server, either anonymously
+or by name, you can use it to query information about other registered applications.
+To get a list with names of all clients, use:
+
+  $client->registeredApplications();
+
+To retrieve the Qt object hierarchy of an application, call
+
+  $client->remoteObjects($appname);
+
+Similarly you can get a list of supported interfaces with
+
+  $client->remoteIterfaces($appname, $objectname);
+
+And to know what you can do with all these nice interfaces, learn about their functions:
+
+  $client->remoteFunctions($appname, $objectname);
+
+=head2 Let them do something
+
+To simply dispatch a command neglecting its return value, use
+
+  $client->send($appname, $objectname, $function, ...);
+
+If you're interested in the return value, consider call:
+
+  $client->call($appname, $objectname, $function, ...);
+
+=head2 Autoload Magic
+
+A much more intuitive way to use send and call is via DCOP::Object. This class
+is not intended for explicit instantiation and is merely a very small autoload stub.
+To get a DCOP::Object, simply call
+
+  $obj = $client->createObject($appname [, $objectname]);
+
+The returned $obj is a DCOP::Object "bound" to the specified application and object
+(or the app's default object if $objectname is omitted or undef). This DCOP::Object
+has only two known methods, _app() and _object() which return the application and object
+name respectively and are merely for internal use. Any other method you call will be
+looked up in the functions() list of the target object. So, if you created it e.g. with
+
+  $obj = $client->createObject("kmail", "KMailIface");
+
+You can simply invoke
+
+  $obj->checkMail();
+
+instead of
+
+  $client->send("kmail", "KMailIface", "checkMail()");
+
+=head2 Detailed Reference
+
+sub new(); [ class method ]
+
+takes no arguments by now and returns a blessed reference to a new DCOP client.
+
+sub attach();
+
+returns a true value if the attachment succeeded or undef on error.
+
+sub detach();
+
+returns a true value if the client was successfully detached or undef on error.
+
+sub isAttached();
+
+returns true or undef whether the client is attached or not.
+
+sub registerAs($appId [, $addPID]);
+CURRENTLY DISABLED
+
+registers the client with the name $appId or $appId with a number appended if a
+client by that name already exists. If $addPID is true, the PID of the client is
+appended to the appId, seperated by a hyphen. If addPID is ommited, it defaults to
+true. To not add a PID, specify undef or zero.
+registerAs returns the actual appId after the PID or possibly a sequence number has
+been added.
+If you call this method on an already attached or registered client, the old appId will
+be replaced with the new one.
+
+sub isRegistered();
+CURRENTLY DISABLED
+
+like isAttached but returns true only if the client used registerAs.
+
+sub appId();
+
+returns the appId the client is known as or undef if it's not registered or only
+attached anonymously.
+
+sub send($app, $object, $function [, ...])
+
+dispatches a function call without waiting for completion and thus without retrieving
+a return value. Returns true if a matching object has been found or undef otherwise.
+$app is the name of a registered application,
+$object the name of an object implemented by $app or undef for the default object,
+$function is the signature of the function to be called.
+Any following arguments are passed as parameters to the called function.
+Make sure that they match the function's signature in count and types (see Datatypes below)
+or your program will die. (This will be configurable in later versions)
+
+sub call($app, $object, $function [, ...])
+
+like send, but blocks until the called function returns and supplies the return value of that
+function (see Datatypes below). In scalar context, the value returned is the function's return
+value, in list context call returns a two element list with the first item set to the function's
+repturn value and the second set to true or undef according to success or failure of the DCOP call.
+
+
+sub findObject
+
+not really implemented, yet.
+
+sub emitDCOPSignal
+
+dito.
+
+sub isApplicationRegistered($app)
+
+returns true if an application with the given name is known to the DCOP server or otherwise undef.
+
+sub registeredApplications()
+
+returns a reference to an array with the names of all currently registered applications.
+On error it returns undef.
+
+sub remoteObjects($app)
+
+returns a reference to an array with the names of the objects supported by the named application.
+On error it returns undef.
+
+sub remoteInterfaces($app, $object)
+
+returns a reference to an array with the names of the interfaces supported by the given application
+and object. On error it returns undef.
+
+sub remoteFunctions($app, $object)
+
+returns a reference to an array with the names of the functions the specified interface supports.
+The functions are returned as their signatures with parameter names and return type like
+
+  QCStringList functions()
+
+sub normalizeSignature($signature)
+
+removes extraneous whitespace from a function signature.
+
+sub canonicalizeSignature($signature)
+
+mostly for internal use. Calls normalizeSignature and then strips parameter names and
+return type from it.
+
+=head2 Datatypes
+
+The following datatypes are currently supported in arguments to send and call and as
+return values:
+
+=over 4
+
+=item * int
+mapped to scalar
+
+=item * QCString
+mapped to scalar
+
+=item * QString (no Unicode support yet, just latin 1)
+mapped to scalar
+
+=item * QCStringList
+mapped to a reference to an array of scalars.
+
+=item * QStringList
+mapped to a reference to an array of scalars.
+
+=item * QPoint (untested)
+mapped to a reference to a two elemtent array [$x, $y]
+named value support via hash planned.
+
+=item * QSize (untested)
+mapped to a reference to a two elemtent array [$width, $height]
+named value support via hash planned.
+
+=item * QRect (untested)
+mapped to a reference to a four elemtent array [$left, $top, $width, $height]
+named value support via hash planned (including alternative right and bottom / width height)
+
+=item * KURL (only QString url() now)
+mapped to scalar
+
+=item * DCOPRef (partially)
+mapped to DCOP::Object, methods like isNull() missing.
+
+=back
+
+=head1 BUGS
+Most probably many. A lot of memory leaks I fear, but that has to be proven.
+There are many important features missing also. By now, it is not possible to
+use DCOP.pm to receive DCOP messages. That is planned.
+
+=head1 AUTHOR
+
+Malte Starostik, malte@kde.org
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
+
diff --git a/dcopperl/DCOP.xs b/dcopperl/DCOP.xs
new file mode 100644
index 00000000..509366af
--- /dev/null
+++ b/dcopperl/DCOP.xs
@@ -0,0 +1,492 @@
+
+#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 <qpoint.h>
+#include <qrect.h>
+#include <qregexp.h>
+#include <qsize.h>
+#include <qstringlist.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 QCString(SvPV(data, PL_na)).lower() == "true";
+	croak("DCOP: Cannot convert to bool");
+}
+
+SV *boolToSV(bool data, SV *self = 0)
+{
+	return newSViv(data ? 1 : 0);
+}
+
+QCString QCStringFromSV(SV *data)
+{
+    if (!SvOK(data))
+        return QCString();
+    if (!SvPOK(data))
+        croak("DCOP: Cannot convert to QCString");
+    return SvPV(data, PL_na);
+}
+
+SV *QCStringToSV(const QCString &data, SV * self = 0)
+{
+    return data.isNull() ? &PL_sv_undef : newSVpv(data.data(), 0);
+}
+
+QString QStringFromSV(SV *data)
+{
+    if (!SvOK(data))
+        return QString::null;
+    if (!SvPOK(data))
+        croak("DCOP: Cannot convert to QString");
+    return SvPV(data, PL_na);
+}
+
+SV *QStringToSV(const QString &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(QCStringFromSV(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, QCStringToSV(*i));
+    return newRV((SV*)result);
+}
+
+QStringList QStringListFromSV(SV *data)
+{
+    if (!SvROK(data))
+        croak("DCOP: Not reference");
+    if (SvTYPE(SvRV(data)) != SVt_PVAV)
+        croak("DCOP: Not an array reference");
+    QStringList result;
+    for (int i = 0; i <= av_len((AV*)SvRV(data)); i++)
+        result.append(QCStringFromSV(av_fetch((AV*)SvRV(data), i, 0)[0]));
+    return result;
+}
+
+SV *QStringListToSV(const QStringList &data, SV * self = 0)
+{
+    AV *result = newAV();
+    for (QStringList::ConstIterator i = data.begin(); i != data.end(); i++)
+        av_push(result, QStringToSV(*i));
+    return newRV((SV*)result);
+}
+
+QPoint QPointFromSV(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 QPoint must have exactly 2 components");
+    SV **pts = av_fetch((AV*)SvRV(data), 0, 0);
+    return QPoint(intFromSV(pts[0]), intFromSV(pts[1]));
+}
+
+SV *QPointToSV(const QPoint &data, SV * self = 0)
+{
+    SV *pts[2] = {
+        intToSV(data.x()),
+        intToSV(data.y())
+    };
+    return newRV((SV*)av_make(2, pts));
+}
+
+QSize QSizeFromSV(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 QSize must have exactly 2 components");
+    SV **ext = av_fetch((AV*)SvRV(data), 0, 0);
+    return QSize(intFromSV(ext[0]), intFromSV(ext[1]));
+}
+
+SV *QSizeToSV(const QSize &data, SV * self = 0)
+{
+    SV *ext[2] = {
+        intToSV(data.width()),
+        intToSV(data.height())
+    };
+    return newRV((SV*)av_make(2, ext));
+}
+
+QRect QRectFromSV(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 QRect must have exactly 4 components");
+    SV **rc = av_fetch((AV*)SvRV(data), 0, 0);
+    return QRect(intFromSV(rc[0]), intFromSV(rc[1]), intFromSV(rc[2]), intFromSV(rc[3]));
+}
+
+SV *QRectToSV(const QRect &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(QStringFromSV(data));
+}
+
+SV *KURLToSV(const KURL &data, SV * self = 0)
+{
+    return QStringToSV(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(QCStringFromSV(app[0]), QCStringFromSV(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, QCStringToSV(data.app()), 0);
+    hv_store((HV*)SvRV(ref), "OBJ", 3, QCStringToSV(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)
+
+QByteArray mapArgs(const QCString &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());
+    QStringList types = QStringList::split(',', func.mid(p + 1, q - p - 1));
+    QByteArray result;
+    QDataStream s(result, IO_WriteOnly);
+    QStringList::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(QCString)
+        else CHECK_ARG(QString)
+        else CHECK_ARG(QCStringList)
+        else CHECK_ARG(QStringList)
+        else CHECK_ARG(QPoint)
+        else CHECK_ARG(QSize)
+        else CHECK_ARG(QRect)
+        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 QCString &replyType, const QByteArray &replyData, SV *self)
+{
+    if (replyType == "void")
+        return sv_newmortal();
+    QDataStream s(replyData, IO_ReadOnly);
+    CHECK_REPLY(int)
+    else CHECK_REPLY(uint)
+    else CHECK_REPLY(bool)
+    else CHECK_REPLY(QCString)
+    else CHECK_REPLY(QString)
+    else CHECK_REPLY(QCStringList)
+    else CHECK_REPLY(QStringList)
+    else CHECK_REPLY(QPoint)
+    else CHECK_REPLY(QSize)
+    else CHECK_REPLY(QRect)
+    else CHECK_REPLY(KURL)
+    else CHECK_REPLY(DCOPRef)
+    else croak("Sorry, receiving a %s is not implemented", replyType.data());
+}
+
+bool isMultiWordType(const QString &type)
+{
+	return type == "unsigned" || type == "signed" || type == "long";
+}
+
+QCString canonicalizeSignature(const QCString &sig)
+{
+    QCString normal = DCOPClient::normalizeFunctionSignature(sig);
+	int p = normal.find('('), q = normal.find(')');
+	QCString result = normal.left(p + 1);
+	result.remove(0, result.findRev(' ') + 1);
+
+	QStringList params = QStringList::split(',', normal.mid(p + 1, q - p - 1));
+	for (QStringList::ConstIterator it = params.begin(); it != params.end(); ++it)
+	{
+		QStringList words = QStringList::split(' ', (*it).simplifyWhiteSpace());
+		for (QStringList::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
+QCString
+DCOPClient::registerAs(appId, ...)
+        QCString 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
+
+QCString
+DCOPClient::appId()
+    OUTPUT:
+        RETVAL
+
+bool
+DCOPClient::send(app, obj, func, ...)
+        QCString app
+        QCString obj
+        QCString func
+    CODE:
+        func = canonicalizeSignature(func);
+        RETVAL = THIS->send(app, obj, func, DATA(func, 4));
+    OUTPUT:
+        RETVAL
+
+SV*
+DCOPClient::call(app, obj, func, ...)
+        QCString app
+        QCString obj
+        QCString func
+    PPCODE:
+        func = canonicalizeSignature(func);
+        QCString replyType;
+        QByteArray 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, ...)
+        QCString app
+        QCString obj
+        QCString func
+    PPCODE:
+        func = canonicalizeSignature(func);
+        QCString foundApp;
+        QCString foundObj;
+        if (!THIS->findObject(app, obj, func, DATA(func, 4), foundApp, foundObj))
+            XSRETURN_UNDEF;
+        PUSHs(QCStringToSV(foundApp));
+        PUSHs(QCStringToSV(foundObj));
+
+void
+DCOPClient::emitDCOPSignal(obj, signal, ...)
+        QCString obj
+        QCString signal
+    CODE:
+        signal = canonicalizeSignature(signal);
+        THIS->emitDCOPSignal(obj, signal, DATA(signal, 3));
+
+bool
+DCOPClient::isApplicationRegistered(app)
+        QCString app
+    OUTPUT:
+        RETVAL
+
+QCStringList
+DCOPClient::registeredApplications()
+    OUTPUT:
+        RETVAL
+
+QCStringList
+DCOPClient::remoteObjects(app)
+        QCString app
+    OUTPUT:
+        RETVAL
+
+QCStringList
+DCOPClient::remoteInterfaces(app, obj)
+        QCString app
+        QCString obj
+    OUTPUT:
+        RETVAL
+
+QCStringList
+DCOPClient::remoteFunctions(app, obj)
+        QCString app
+        QCString obj
+    OUTPUT:
+        RETVAL
+
+static QCString
+DCOPClient::normalizeFunctionSignature(sig)
+        QCString sig
+    OUTPUT:
+        RETVAL
+
+QCString
+canonicalizeSignature(sig)
+        QCString sig
+    CODE:
+        RETVAL = canonicalizeSignature(sig);
+    OUTPUT:
+        RETVAL
diff --git a/dcopperl/DCOP/Object.pm b/dcopperl/DCOP/Object.pm
new file mode 100644
index 00000000..e98f65b5
--- /dev/null
+++ b/dcopperl/DCOP/Object.pm
@@ -0,0 +1,41 @@
+package DCOP::Object;
+
+use strict;
+use vars qw($VERSION $AUTOLOAD);
+
+$VERSION = '0.01';
+
+sub AUTOLOAD()
+{
+    my $funcname;
+    ($funcname = $AUTOLOAD) =~ s/.*:://;
+    return if $funcname eq 'DESTROY';
+    my $self = shift;
+    foreach my $func (map {DCOP::canonicalizeSignature $_}
+                          @{DCOP::remoteFunctions($self->{CLIENT}, $self->{APP}, $self->{OBJ})})
+    {
+        my $argstr = $func;
+        $argstr =~ s/.*\((.*)\)/$1/;
+        my @args = split /,/, $argstr;
+        next unless $func =~ /^$funcname\(/ && scalar(@args) == scalar(@_);
+        unshift @_, $self->{CLIENT}, $self->{APP}, $self->{OBJ}, "$func";
+        defined wantarray ? goto &DCOP::call : goto &DCOP::send;
+    }
+    die 'Function "', $self->{APP}, '.', $self->{OBJ}, ".$funcname()\" doesn't exist.";
+}
+
+sub _app()
+{
+    my $self = shift;
+    $self->{APP};
+}
+
+sub _object()
+{
+    my $self = shift;
+    $self->{OBJ};
+}
+
+1;
+__END__
+
diff --git a/dcopperl/MANIFEST b/dcopperl/MANIFEST
new file mode 100644
index 00000000..27522a5d
--- /dev/null
+++ b/dcopperl/MANIFEST
@@ -0,0 +1,8 @@
+Changes
+DCOP.pm
+DCOP.xs
+DCOP/Object.pm
+Makefile.PL
+MANIFEST
+test.pl
+typemap
diff --git a/dcopperl/Makefile.PL b/dcopperl/Makefile.PL
new file mode 100644
index 00000000..c22ff234
--- /dev/null
+++ b/dcopperl/Makefile.PL
@@ -0,0 +1,42 @@
+use ExtUtils::MakeMaker;
+use Config;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+print "Trying to find some configuration information...\n";
+my $kde_dirs = $ENV{KDEDIRS} || '/usr/local/kde';
+my $qt_dir = $ENV{QTDIR} || '/usr/lib/qt';
+my $kde_inc = "$kde_dirs/include";
+my $kde_lib = "$kde_dirs/lib";
+my $qt_inc = "$qt_dir/include";
+my $qt_lib = "$qt_dir/lib";
+$kde_inc = undef unless -f "$kde_inc/dcopclient.h"; 
+$kde_lib = undef unless -f "$kde_lib/libDCOP.$Config{dlext}";
+$qt_dir = undef unless -f "$qt_inc/qglobal.h";
+
+print "Path to Qt headers? [$qt_inc]: ";
+chomp $input, $qt_inc = $input if (($input = <>) =~ /\S/);
+print "Path to Qt libraries? [$qt_lib]: ";
+chomp $input, $qt_lib = $input if (($input = <>) =~ /\S/);
+print "Path to KDE headers? [$kde_inc]: ";
+chomp $input, $kde_inc = $input if (($input = <>) =~ /\S/);
+print "Path to KDE libraries? [$kde_lib]: ";
+chomp $input, $kde_lib = $input if (($input = <>) =~ /\S/);
+
+WriteMakefile(
+    NAME	=> 'DCOP',
+    VERSION_FROM => 'DCOP.pm',
+    INC		=> "-I$qt_inc -I$kde_inc",
+    LIBS	=> "-L$qt_lib -lqt-mt -L$kde_lib -lkdecore -lDCOP",
+    XS		=> {'DCOP.xs' => 'DCOP.cpp'},
+    XSOPT	=> '-C++',
+    CCFLAGS	=> '-x c++',
+);
+
+sub MY::xs_c {
+    package MY;
+    my $hack = shift->SUPER::xs_c(@_);
+    $hack =~ s/\.c/.cpp/g;
+    $hack;
+}
+
diff --git a/dcopperl/Makefile.PL.in b/dcopperl/Makefile.PL.in
new file mode 100644
index 00000000..2a8e355b
--- /dev/null
+++ b/dcopperl/Makefile.PL.in
@@ -0,0 +1,28 @@
+use ExtUtils::MakeMaker;
+use Config;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+print "Trying to find some configuration information...\n";
+my $kde_inc = "@kde_includes@";
+my $kde_lib = "@kde_libraries@";
+my $qt_inc = "@qt_includes@";
+my $qt_lib = "@qt_libraries@";
+ 
+WriteMakefile(
+    NAME	=> 'DCOP',
+    VERSION_FROM => '@srcdir@/DCOP.pm',
+    INC		=> "-I$qt_inc -I$kde_inc",
+    LIBS	=> "-L$qt_lib -lqt-mt -L$kde_lib -lkdecore -lDCOP",
+    XS		=> {'DCOP.xs' => 'DCOP.cpp'},
+    XSOPT	=> '-C++',
+    CCFLAGS	=> '-x c++',
+);
+
+sub MY::xs_c {
+    package MY;
+    my $hack = shift->SUPER::xs_c(@_);
+    $hack =~ s/\.c/.cpp/g;
+    $hack;
+}
+
diff --git a/dcopperl/README b/dcopperl/README
new file mode 100644
index 00000000..c2432e8f
--- /dev/null
+++ b/dcopperl/README
@@ -0,0 +1,13 @@
+DCOP Bindings for Perl
+
+This does need some updating, basic functionality already works quite well
+
+To install, follow the usual Perl-Module-Installation-Procedure:
+perl Makefile.PL
+make
+make test
+make install
+
+Documentation is available in perldoc format embedded into DCOP.pm and
+after installation it should be accessible via
+man DCOP
diff --git a/dcopperl/TODO b/dcopperl/TODO
new file mode 100644
index 00000000..9846ee5f
--- /dev/null
+++ b/dcopperl/TODO
@@ -0,0 +1,4 @@
+* Lots of cleanup
+* More data types
+* signals/slots
+* UTF8-safe QString <=> scalar conversions
diff --git a/dcopperl/configure.in.in b/dcopperl/configure.in.in
new file mode 100644
index 00000000..1775534b
--- /dev/null
+++ b/dcopperl/configure.in.in
@@ -0,0 +1,7 @@
+KDE_CHECK_PERL(5.005, dcopperl)
+AC_CONFIG_FILES([ dcopperl/Makefile.PL ], [
+        cd dcopperl
+        perl -I$srcdir Makefile.PL
+        cd ..
+])
+
diff --git a/dcopperl/test.pl b/dcopperl/test.pl
new file mode 100644
index 00000000..0402395e
--- /dev/null
+++ b/dcopperl/test.pl
@@ -0,0 +1,123 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+        print <<EOT;
+Now that you've built the DCOP extension, it's time to run some tests on it.
+The first of them will just run by themselves, after that, there will be
+some interactive ones.
+
+EOT
+print "Loading...";
+}
+
+END {print "failed\n" unless $loaded;}
+use DCOP;
+$loaded = 1;
+print "done\n";
+
+######################### End of black magic.
+
+my $ok;
+
+sub check {
+        my $res = shift;
+        print $res ? "." : "!";
+        $ok = undef unless $res;
+}
+
+my ($client, $desk);
+
+sub attach {
+        $client = new DCOP;
+        check (ref $client) eq "DCOP";
+        check !$client->isAttached();
+        check $client->attach();
+        check $client->isAttached();
+        check $client->detach();
+        check !$client->isAttached();
+# For now, as register is disabled
+        $client->attach();
+}
+
+sub register {
+        check (my $appid = $client->registerAs("perltests"));
+        print "[$appid]";
+        check $client->isRegistered();
+        check $client->appId() eq $appid;
+        check ($appid = $client->registerAs("perltests", undef));
+        print "[$appid]";
+        check $client->isRegistered();
+        check $client->appId() eq $appid;
+}
+
+sub query {
+        check (my $list = $client->registeredApplications());
+        print "[$#$list]";
+        check ($list = $client->remoteObjects("kdesktop"));
+        print "[$#$list]";
+        check ($list = $client->remoteInterfaces("kdesktop", "qt"));
+        print "[$#$list]";
+        check ($list = $client->remoteFunctions("kdesktop", "qt"));
+        print "[$#$list]";
+        check grep /^QCStringList functions\(\)$/, @$list;
+}
+
+sub calls {
+        check (my $list = $client->call("kdesktop", "qt", "objects()"));
+        print "[$#$list]";
+        check grep m#^qt/kdesktop$#, @$list;
+}
+
+sub magic {
+        check ($desk = $client->createObject("kdesktop"));
+        check (ref $desk) eq "DCOP::Object";
+        check (my ($list) = $desk->interfaces());
+        print "[$#$list]";
+        check grep /^KDesktopIface$/, @$list;
+}
+
+sub icons {
+        check scalar $desk->selectAll();
+        sleep 1;
+        check scalar $desk->unselectAll();
+}
+
+sub saver {
+        check ($desk = $client->createObject("kdesktop")) unless defined $desk;
+        check (my ($saver) = $desk->screenSaver());
+        check (ref $saver) eq "DCOP::Object";
+        check scalar $saver->save();
+}
+
+@tests = (
+        ["simple attachments", \&attach],
+#        ["full registration", \&register],
+        ["tree queries", \&query],
+        ["calls", \&calls],
+        ["autoload magic", \&magic],
+        ["more autoload magic", \&icons,
+         "The next test should cause all icons on your desktop to be selected\nand deselected again."],
+        ["DCOPRefs", \&saver,
+         "The next test should activate your screen saver."],
+        );
+
+foreach (@tests) {
+        my ($msg, $test, $confirm) = @{$_};
+        if ($confirm) {
+                print "$confirm\nDo you want this test to be performed? [Y/n]";
+                my $answer = <>;
+                next unless ($answer =~ /^\s*$/ || $answer =~ /^[yY]/);
+        }
+        printf "%-25s", $msg;
+        $ok = 1;
+        &$test();
+        unless ($ok) {
+                print "failed\n";
+                exit 1;
+        }
+        print "passed\n";
+}
+
diff --git a/dcopperl/typemap b/dcopperl/typemap
new file mode 100644
index 00000000..cb7f2420
--- /dev/null
+++ b/dcopperl/typemap
@@ -0,0 +1,23 @@
+TYPEMAP
+DCOPClient *    O_OBJECT
+QCString        T_QCSTRING
+QCStringList    T_QCSTRINGLIST
+
+INPUT
+O_OBJECT
+        if(sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+                $var = ($type)SvIV((SV*)SvRV($arg));
+        else {
+                warn(\"${Package}::$func_name() -- $var is not a blessed SV reference\");
+                XSRETURN_UNDEF;
+        }
+T_QCSTRING
+        $var = QCStringFromSV($arg);
+
+OUTPUT
+O_OBJECT
+        sv_setref_pv( $arg, CLASS, (void*)$var );
+T_QCSTRING
+        sv_setsv($arg, QCStringToSV($var));
+T_QCSTRINGLIST
+        sv_setsv($arg, QCStringListToSV($var));