[33163] in Perl-Users-Digest
Perl-Users Digest, Issue: 4442 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun May 31 03:09:18 2015
Date: Sun, 31 May 2015 00:09:02 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 31 May 2015 Volume: 11 Number: 4442
Today's topics:
Perl callback not firing from XSUB--advice? <kw@codebykevin.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 30 May 2015 13:16:05 -0400
From: Kevin Walzer <kw@codebykevin.com>
Subject: Perl callback not firing from XSUB--advice?
Message-Id: <mkcr6e$fb6$1@dont-email.me>
I am building a Perl extension via the xsub API that includes Perl
callbacks via the perlcall API, and the callbacks are not firing. I
would appreciate some help.
The XS code below does two things:
1. Registers OS-specific events with the operating system, indicating
that my Perl app when fully deployed will respond to those events.
(Specifically, it registers to respond to Apple Events, a Mac-specific
form of IPC.) I expose an xsub at the script level to manage this, and
as far as I can tell it works.
2. Provides a mechanism for actually responding to the IPC calls,
dispatching data to the appropriate Perl subroutine, and then returning
output to the operating system. This part never fires. It is not exposed
to the script level but instead works as an internal function call at
the C level.
Do I need to provide some sort of xsub exposure to the
AEScriptsAEHandler function to get it to run, or some other integration
with the xsub mechanism? Because it is internal plumbing I really don't
want it exposed at the script level, but perhaps I am wrong here.
Advice is appreciated. Code below. --Kevin
-------
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <CoreFoundation/CoreFoundation.h>
#include <Carbon/Carbon.h>
#include <CoreServices/CoreServices.h>
#include <string.h>
#include <unistd.h>
#include <sys/wait.h>
#include <pthread.h>
#include <ctype.h>
#include <stdio.h>
/* Undefine Move macro, this conflicts with Mac OS X QuickDraw API. */
#undef Move
/* Data structures for Apple Events and Perl commands. */
char *_eventclass;
char *_eventid;
char *_perlcmd;
/*Global values.*/
CFStringRef stringeventClass;
CFStringRef stringeventID;
CFStringRef eventFunction;
CFMutableDictionaryRef aeDict;
/* AppleEvent handler for Perl interpreter.*/
OSErr AEScriptsAEHandler(const AppleEvent *theAppleEvent,
AppleEvent *reply, long refCon)
{
OSErr err = noErr;
AEDesc returnData;
AEEventID eventID;
OSType typeCode;
AEDesc directParameter;
fprintf(stdout, "firing\n");
/* Get event ID to look up in CFDictionary. */
err = AEGetAttributePtr(theAppleEvent, keyEventIDAttr, typeType,
NULL, &eventID, sizeof(eventID), NULL );
/* Get direct parameter, convert to char. */
err = AEGetKeyDesc(theAppleEvent, keyDirectObject, typeUTF8Text,
&directParameter);
long size = AEGetDescDataSize(&directParameter);
char *paramstring[size];
AEGetDescData(&directParameter, paramstring, size);
AEDisposeDesc(&directParameter);
/* Get command keyed to eventID from dict and pass to Perl for
execution. */
CFTypeRef scriptName;
stringeventID = UTCreateStringForOSType(eventID);
scriptName = CFDictionaryGetValue(aeDict, stringeventID);
char cmd[5012];
CFStringGetCString (scriptName, cmd, (sizeof cmd),
kCFStringEncodingUTF8);
/* Execute Perl command. */
fprintf(stdout, "Executing command: %s\n", cmd);
dSP;
char *output;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSPpv(paramstring, 0)));
PUTBACK;
output = call_pv(cmd, G_SCALAR);
printf("%s", output, POPs);
SPAGAIN;
PUTBACK;
FREETMPS;
LEAVE;
/* Pass results back to AppleScript, clean up. */
AEPutParamPtr(reply, keyDirectObject, typeUTF8Text, output,
strlen(output)+1);
fprintf(stdout, "the output is %s\n", output);
CFRelease(scriptName);
return err;
}
/*Install Apple Event handlers and map to Perl commands.*/
XS(installeventhandler)
{
dXSARGS;
CFMutableArrayRef copyTypes, pasteTypes;
CFStringRef dataType;
OSErr err;
OSType eventClass;
OSType eventID;
if (items < 3) {
Perl_croak(aTHX_ "Usage: Mac::AEM::installeventhandler(eventClass,
eventID, Perl command)");
}
/* Assign Perl parameters to char values. */
SV* perleventclass = ST(0);
STRLEN len;
_eventclass=SvPV(perleventclass, len);
SV* perleventid = ST(1);
_eventid=SvPV(perleventid, len);
SV* perlcmd = ST(2);
_perlcmd=SvPV(perlcmd, len);
/* Convert chars to CFStringRefs. */
stringeventClass = CFStringCreateWithCString(kCFAllocatorDefault,
_eventclass, kCFStringEncodingUTF8);
stringeventID = CFStringCreateWithCString(kCFAllocatorDefault,
_eventid, kCFStringEncodingUTF8);
eventFunction = CFStringCreateWithCString(kCFAllocatorDefault,
_perlcmd, kCFStringEncodingUTF8);
/* Convert CFStringRefs to OSTypes, which are integers. */
eventClass = UTGetOSTypeFromString(stringeventClass);
eventID = UTGetOSTypeFromString(stringeventID);
/* Create CFDictionary to map event ID's to commands. */
aeDict = CFDictionaryCreateMutable(NULL, 0,
&kCFTypeDictionaryKeyCallBacks, &kCFTypeDictionaryValueCallBacks);
CFDictionarySetValue(aeDict, stringeventID, eventFunction);
/* Finally, install the Apple Event handlers. */
err = AEInstallEventHandler(eventClass, eventID,
NewAEEventHandlerUPP(AEScriptsAEHandler), 0, false);
if (err != noErr) {
fprintf(stdout, "Unable to install custom Apple Events handlers.\n");
} else {
fprintf(stdout, "Installing class: %s, id: %s, command: %s\n",
_eventclass, _eventid, _perlcmd);
}
XSRETURN(1);
}
XS(boot_Mac__AEM) {
newXS("Mac::AEM::installeventhandler", installeventhandler, __FILE__);
}
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V11 Issue 4442
***************************************
