home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / MacPerl5 / MPScript.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-10-29  |  17.9 KB  |  890 lines  |  [TEXT/MPS ]
  1. /*********************************************************************
  2. Project    :    MacPerl            -    Real Perl Application
  3. File        :    MPScript.c        -    Handle scripts
  4. Author    :    Matthias Neeracher
  5. Language    :    MPW C
  6.  
  7. $Log: MPScript.c,v $
  8. Revision 1.2  1994/05/04  02:54:19  neeri
  9. Always keep the right resource file in front.
  10.  
  11. Revision 1.1  1994/02/27  23:01:56  neeri
  12. Initial revision
  13.  
  14. Revision 0.2  1993/10/14  00:00:00  neeri
  15. Run front window
  16.  
  17. Revision 0.1  1993/08/17  00:00:00  neeri
  18. Set up correct default directory
  19.  
  20. *********************************************************************/
  21.  
  22. #define ORIGINAL_WRAPPER
  23.  
  24. #include <AERegistry.h>
  25. #include <String.h>
  26. #include <TFileSpec.h>
  27. #include <sys/types.h>
  28. #include <ctype.h>
  29. #include <stdio.h>
  30. #include <fcntl.h>
  31. #include <unistd.h>
  32. #include <Signal.h>
  33. #include <StandardFile.h>
  34. #include <Resources.h>
  35. #include <PLStringFuncs.h>
  36. #include <LowMem.h>
  37. #include <FragLoad.h>
  38. #include <AEBuild.h>
  39. #include <AEStream.h>
  40. #include <AESubDescs.h>
  41. #include <OSA.h>
  42.  
  43. #include "MPScript.h"
  44. #include "MPWindow.h"
  45. #include "MPAppleEvents.h"
  46. #include "MPAEVTStream.h"
  47. #include "MPFile.h"
  48. #include "MPSave.h"
  49. #include "MPMain.h"
  50. #include "icemalloc.h"
  51.  
  52. pascal Boolean GetScriptFilter(CInfoPBPtr pb)
  53. {
  54.     switch (GetDocTypeFromInfo(pb)) {
  55.     case kPreferenceDoc:
  56.         /* We don't want preference files here. */
  57.     case kUnknownDoc:
  58.         return true;
  59.     default:
  60.         return false;
  61.     }
  62. }
  63.  
  64. #if USESROUTINEDESCRIPTORS
  65. RoutineDescriptor    uGetScriptFilter = 
  66.         BUILD_ROUTINE_DESCRIPTOR(uppFileFilterProcInfo, GetScriptFilter);
  67. #else
  68. #define uGetScriptFilter *(FileFilterUPP)&GetScriptFilter
  69. #endif
  70.  
  71. void PopupOffending(AEDesc * repl)
  72. {
  73.     OSErr                        err;
  74.     AEDesc                    target;
  75.     short                        line;
  76.     DescType                    type;
  77.     Size                        size;
  78.     FSSpec                    file;
  79.     
  80.     if (AEGetParamPtr(repl, kOSAErrorOffendingObject, typeFSS, &type, &file, sizeof(FSSpec), &size))
  81.         return;
  82.     if (AEGetKeyDesc(repl, kOSAErrorRange, typeWildCard, &target))
  83.         return;
  84.     err = AEGetKeyPtr(&target, keyOSASourceStart, typeShortInteger, &type, &line, sizeof(short), &size);
  85.     AEDisposeDesc(&target);
  86.     if (err)
  87.         return;
  88.     IssueJumpCommand(&file, nil, line);
  89. }
  90.  
  91. static void SendScriptEvent(
  92.     DescType argType, 
  93.     Ptr         argPtr, 
  94.     Handle    argHdl,
  95.     Size         argSize, 
  96.     Boolean    syntax)
  97. {
  98.     OSErr                    err;
  99.     AppleEvent            cmd, repl;
  100.     AEAddressDesc        addr;
  101.     AEStream                aes;
  102.     
  103.     if (err = MakeSelfAddress(&addr))
  104.         goto failedAddress;
  105.         
  106.     if (err = 
  107.         AECreateAppleEvent(
  108.             kAEMiscStandards, kAEDoScript, &addr, 
  109.             kAutoGenerateReturnID, kAnyTransactionID, 
  110.             &cmd)
  111.     )
  112.         goto failedAppleEvent;
  113.     
  114.     if (err = AEStream_OpenEvent(&aes, &cmd))
  115.         goto failedStream;
  116.     
  117.     err = AEStream_WriteKey(&aes, keyDirectObject);
  118.     
  119.     if (!err)
  120.         if (argHdl) {
  121.             AEDesc    arg;
  122.             
  123.             arg.descriptorType    =    argType;
  124.             arg.dataHandle            =    argHdl;
  125.             
  126.             err = AEStream_WriteAEDesc(&aes, &arg);
  127.         } else
  128.             err = AEStream_WriteDesc(&aes, argType, argPtr, argSize);
  129.     
  130.     if (!err)    
  131.         if (syntax)
  132.             err = AEStream_WriteKeyDesc(
  133.                         &aes, 'CHCK', typeBoolean, (Ptr) &syntax, sizeof(Boolean));
  134.         else {
  135.             if (gDebug)
  136.                 err =    AEStream_WriteKeyDesc(
  137.                             &aes, 'DEBG', typeBoolean, (Ptr) &gDebug, sizeof(Boolean));
  138.             if (!err && gWarnings)
  139.                 err =    AEStream_WriteKeyDesc(
  140.                             &aes, 'WARN', typeBoolean, (Ptr) &gWarnings, sizeof(Boolean));
  141.         }
  142.     
  143.     if (err)
  144.         AEStream_Close(&aes, nil);
  145.     else 
  146.         err = AEStream_Close(&aes, &cmd);
  147.     
  148.     if (err)
  149.         goto failedStream;
  150.         
  151.     if (AESend(&cmd, &repl,
  152.             kAEWaitReply+kAEAlwaysInteract, kAENormalPriority, kAEDefaultTimeout,
  153.             nil, nil)
  154.     && !gQuitting
  155.     ) 
  156.         PopupOffending(&repl);
  157.  
  158.     AEDisposeDesc(&repl);
  159. failedStream:
  160.     AEDisposeDesc(&cmd);
  161. failedAppleEvent:
  162.     AEDisposeDesc(&addr);
  163. failedAddress:
  164.     ;
  165. }
  166.  
  167. pascal void DoScriptMenu(short theItem)
  168. {
  169.     StandardFileReply    reply;
  170.     Point                    where;
  171.     Boolean                debug;
  172.     
  173.     where.h = where.v = -1;
  174.  
  175.     BuildSEList();
  176.     
  177.     switch (theItem) {
  178.     case pmRun:
  179.         StandardGetFile(&uGetScriptFilter, MacPerlFileTypeCount, MacPerlFileTypes, &reply);
  180.         if (reply.sfGood)
  181.             SendScriptEvent(typeFSS, (Ptr) &reply.sfFile, nil, sizeof(FSSpec), false);
  182.         break;
  183.     case pmRunFront:
  184.         {
  185.             DPtr    doc = DPtrFromWindowPtr(FrontWindow());
  186.             
  187.             if (!doc || doc->kind != kDocumentWindow)
  188.                 break;
  189.             
  190.             if (doc->dirty || !doc->u.reg.everSaved) {
  191.                 if (doc->u.reg.everSaved)
  192.                     strcpy(gPseudoFileName, FSp2FullPath(&doc->theFSSpec));
  193.                 else
  194.                     getwtitle(FrontWindow(), gPseudoFileName);
  195.  
  196.                 SendScriptEvent(
  197.                     typeChar, nil, (*doc->theText)->hText, 
  198.                     GetHandleSize((*doc->theText)->hText),
  199.                     false);
  200.             } else {
  201.                 gPseudoFileName[0] = 0;
  202.                 SendScriptEvent(typeFSS, (Ptr) &doc->theFSSpec, nil, sizeof(FSSpec), false);
  203.             }
  204.         }
  205.         break;
  206.     case pmCheckSyntax:
  207.         {
  208.             DPtr    doc = DPtrFromWindowPtr(FrontWindow());
  209.             
  210.             if (!doc || doc->kind != kDocumentWindow)
  211.                 break;
  212.             
  213.             if (doc->dirty || !doc->u.reg.everSaved) {
  214.                 if (doc->u.reg.everSaved)
  215.                     strcpy(gPseudoFileName, FSp2FullPath(&doc->theFSSpec));
  216.                 else
  217.                     getwtitle(FrontWindow(), gPseudoFileName);
  218.  
  219.                 SendScriptEvent(
  220.                     typeChar, nil, (*doc->theText)->hText, 
  221.                     GetHandleSize((*doc->theText)->hText),
  222.                     true);
  223.             } else {
  224.                 gPseudoFileName[0] = 0;
  225.                 SendScriptEvent(typeFSS, (Ptr) &doc->theFSSpec, nil, sizeof(FSSpec), true);
  226.             }
  227.         }
  228.         break;
  229.     case pmWarnings:
  230.         gWarnings = !gWarnings;
  231.         CheckItem(myMenus[perlM], pmWarnings, gWarnings);
  232.         break;
  233.     case pmDebug:
  234.         gDebug = !gDebug;
  235.         CheckItem(myMenus[perlM], pmDebug, gDebug);
  236.         break;
  237.     }
  238. }
  239.  
  240. typedef void (*atexitfn)();
  241.  
  242. void MP_Exit(int status)
  243. {
  244.     if (gRunningPerl)
  245.         longjmp(gExitPerl, -status-1);
  246.     else {
  247.         exit(status);
  248.     }
  249. }
  250.  
  251. static atexitfn     PerlExitFn[20];
  252. static int            PerlExitCnt;
  253.  
  254. int MP_AtExit(atexitfn func)
  255. {
  256.     if (gRunningPerl)
  257.         PerlExitFn[PerlExitCnt++] = func;
  258.     else {
  259.         return atexit(func);
  260.     }
  261.         
  262.     return 0;
  263. }
  264.  
  265. static char **        PerlArgs;
  266. static int            PerlArgMax;
  267. static char **        PerlEnviron;
  268. static Handle        PerlEnvText;
  269.  
  270. char * MP_GetEnv(const char * var)
  271. {
  272.     char **     env;
  273.     
  274.     for (env = PerlEnviron; *env; ++env)
  275.         if (!strcmp(*env, var))
  276.             return *env + strlen(*env) + 1;
  277.         
  278.     return nil;
  279. }
  280.  
  281. pascal void InitPerlEnviron()
  282. {
  283.     gDebugLogName     = "Dev:Console:Debug Log";
  284.     gExit                = MP_Exit;
  285.     gAtExit            = MP_AtExit;
  286.     gGetEnv            = MP_GetEnv;
  287.     gAlwaysExtract    = true;
  288.     gHandleEvent    = HandleEvent;
  289. }
  290.  
  291. Handle MakeLibraries()
  292. {
  293.     char        end = 0;
  294.     int        libCount;
  295.     short        resFile;
  296.     Handle    libs;
  297.     Str255    lib;
  298.  
  299.     PtrToHand("PERL5LIB", &libs, 9);
  300.     
  301.     resFile = CurResFile();
  302.     UseResFile(gPrefsFile);
  303.     
  304.     for (libCount = 1; ; ++libCount) {
  305.         GetIndString(lib, LibraryPaths, libCount);
  306.         
  307.         if (!lib[0])
  308.             break;
  309.         
  310.         if (lib[1] == ':') {
  311.             char *    libpath;
  312.             FSSpec    libspec;
  313.         
  314.             libspec.vRefNum    =     gAppVol;
  315.             libspec.parID        =    gAppDir;
  316.             memcpy(libspec.name+1, lib+2, *libspec.name = *lib-1);
  317.         
  318.             libpath  = FSp2FullPath(&libspec);
  319.             memcpy(lib+1, libpath, *lib = strlen(libpath));
  320.         }
  321.             
  322.         if (libCount > 1)
  323.             PtrAndHand(",", libs, 1);
  324.         
  325.         PtrAndHand(lib+1, libs, lib[0]);
  326.     }
  327.     PtrAndHand(&end, libs, 1);
  328.     
  329.     UseResFile(resFile);
  330.     
  331.     return libs;
  332. }
  333.  
  334. /* Build environment from AEDescriptor passed in 'ENVT' parameter */
  335.  
  336. void MakePerlEnviron(AEDesc * desc)
  337. {
  338.     Handle        envText  = MakeLibraries();
  339.     int            index;
  340.     int            libOffset= 9;
  341.     int            totalLength;
  342.     int            envCount = 1;
  343.     void *         curName;
  344.     void *         curValue;
  345.     long            curNameLen;
  346.     long            curValueLen;
  347.     char *        text;
  348.     AEKeyword    key;
  349.     AESubDesc    strings;
  350.     AESubDesc    cur;    
  351.     
  352.     if (desc) {
  353.         HLock(desc->dataHandle);
  354.         AEDescToSubDesc(desc, &strings); 
  355.         
  356.         for (index = 0; !AEGetNthSubDesc(&strings, ++index, &key, &cur); ) {
  357.             curName = AEGetSubDescData(&cur, &curNameLen);
  358.             
  359.             if (AEGetNthSubDesc(&strings, ++index, &key, &cur))
  360.                 curValue = nil;
  361.             else
  362.                 curValue = AEGetSubDescData(&cur, &curValueLen);
  363.             
  364.             if (!memcmp(curName, "PERL5LIB", 9)) {
  365.                 if (curValue) {
  366.                     Munger(envText, libOffset, nil, 0, curValue, curValueLen+1);
  367.                     (*envText)[libOffset+curValueLen] = ',';
  368.                 }
  369.             } else {
  370.                 ++envCount;
  371.                 
  372.                 totalLength = GetHandleSize(envText);
  373.                 
  374.                 PtrAndHand(curName, envText, curNameLen+1);
  375.                 
  376.                 (*envText)[totalLength+curNameLen] = 0;
  377.                 
  378.                 if (curValue) {
  379.                     PtrAndHand(curValue, envText, curValueLen+1);
  380.                 
  381.                     (*envText)[totalLength+curNameLen+curValueLen+1] = 0;
  382.                 } else {
  383.                     PtrAndHand(curName, envText, 1);
  384.                 
  385.                     (*envText)[totalLength+curNameLen+1] = 0;
  386.                 }
  387.             }
  388.         }
  389.     }
  390.     
  391.     if (PerlEnvText) {
  392.         DisposePtr((Ptr) PerlEnviron);
  393.         DisposeHandle(PerlEnvText);
  394.     }
  395.  
  396.     MoveHHi(PerlEnvText = envText);
  397.     HLock(envText);
  398.         
  399.     PerlEnviron                 = (char **) NewPtr((envCount+1) * sizeof(char *));
  400.     PerlEnviron[envCount]     = nil;
  401.     text                            = *envText;
  402.     
  403.     while (envCount--) {
  404.         PerlEnviron[envCount]    = text;
  405.         text                           += strlen(text) + 1;
  406.         text                           += strlen(text) + 1;
  407.     }
  408. }
  409.  
  410. void CleanupPerl()
  411. {
  412.     int i;
  413.     extern FILE * _lastbuf;
  414.  
  415.     UseResFile(gAppFile);
  416.  
  417.     // Borrowed from GUSI
  418.     
  419.     // Close stdio files (necessary to flush buffers)
  420.     // This implementation is not nice, but who cares ?
  421.     // In case you wonder, _iob is defined in <stdio.h>
  422.  
  423.     fwalk(fflush);
  424.     fwalk(fclose);
  425.  
  426.     // Close all files
  427.  
  428.     for (i = 0; i<FD_SETSIZE; ++i)
  429.         close(i);
  430.  
  431.     while (PerlExitCnt)
  432.         PerlExitFn[--PerlExitCnt]();
  433.  
  434.     UseResFile(gAppFile);
  435.  
  436.     free_pool_memory('PERL');
  437.  
  438.     freopen("Dev:Console", "r", stdin);
  439.     freopen("Dev:Console", "w", stdout);
  440.     freopen("Dev:Console", "w", stderr); 
  441. }
  442.  
  443. enum {
  444.     extractDone            = -6,
  445.     extractSyntax        = -5,
  446.     extractWarn            = -4,
  447.     extractDir            = -3,
  448.     extractCpp            = -2,
  449.     extractDebug         = -1
  450. };
  451.  
  452. typedef char * (*ArgExtractor)(void * data, int index);
  453.  
  454. pascal Boolean RunScript(ArgExtractor extractor, void * data)
  455. {
  456.     int        ArgC;
  457.     char    *    res;
  458.     int        i;
  459.     int         DynamicArgs;
  460.     int        returnCode;
  461.     
  462.     ArgC            = 1;
  463.     PerlArgMax    = 20;
  464.     PerlArgs     = malloc(PerlArgMax * sizeof(char *));
  465.     PerlArgs[0]    = "MacPerl";
  466.     
  467.     {
  468.         char        path[256];
  469.     
  470.         strcpy(path, extractor(data, extractDir));
  471.         chdir(path);
  472.     }
  473.     
  474.     if ((res = extractor(data, extractSyntax)) && *res == 'y')
  475.         PerlArgs[ArgC++] = "-c";
  476.  
  477.     if (((res = extractor(data, extractWarn)) && *res == 'y') || gWarnings)
  478.         PerlArgs[ArgC++] = "-w";
  479.  
  480.     if (((res = extractor(data, extractDebug)) && *res == 'y') || gDebug)
  481.         PerlArgs[ArgC++] = "-d";
  482.  
  483.     if ((res = extractor(data, extractCpp)) && *res == 'y')
  484.         PerlArgs[ArgC++] = "-P";
  485.  
  486.     DynamicArgs = ArgC;
  487.     
  488.     if (res = extractor(data, 1)) {
  489.         if (gPerlPrefs.checkType && !gPseudoFile) 
  490.             PerlArgs[ArgC++] = "-x";
  491.         
  492.         DynamicArgs         = ArgC;
  493.         
  494.         PerlArgs[ArgC++]     = res;
  495.     
  496.         for (i=2; PerlArgs[ArgC] = extractor(data, i); ++i)
  497.             if (++ArgC == PerlArgMax) {
  498.                 PerlArgMax    += 20;
  499.                 PerlArgs     = realloc(PerlArgs, PerlArgMax * sizeof(char *));
  500.             }
  501.     }
  502.     
  503.     extractor(data, extractDone);
  504.     
  505.     UseResFile(gAppFile);
  506.     
  507.     PerlArgs[ArgC] =  nil;
  508.     gRunningPerl     =  true;
  509.     gPerlQuit        =    0;
  510.     gFirstErrorLine= -1;
  511.     
  512.     ShowWindowStatus();
  513.     
  514.     signal(SIGINT, exit);
  515.     
  516.     if (!(returnCode = setjmp(gExitPerl))) {
  517.         run_perl(ArgC, PerlArgs, PerlEnviron);
  518.         /* Noone here gets out alive */
  519.     }    
  520.  
  521.     for (i=DynamicArgs; PerlArgs[i]; ++i)
  522.         DisposPtr(PerlArgs[i]);
  523.  
  524.     free(PerlArgs);
  525.  
  526.     CleanupPerl();
  527.     gRunningPerl = false;
  528.     
  529.     if (gScriptFile != gAppFile) {
  530.         CloseResFile(gScriptFile);
  531.         
  532.         gScriptFile = gAppFile;
  533.     }
  534.     
  535.     ShowWindowStatus();
  536.     
  537.     ++gCompletedScripts;
  538.     
  539.     switch (gPerlQuit) {
  540.     case 3:
  541.         if (gCompletedScripts > 1)
  542.             break;
  543.         /* Otherwise, we were the cause of MacPerl being run, let's quit */
  544.     case 2:
  545.         DoQuit(kAEAsk);
  546.     }
  547.     
  548.     return returnCode == -1;
  549. }
  550.  
  551. char * MakePath(char * path)
  552. {
  553.     char * retarg = NewPtr(strlen(path)+1);
  554.     
  555.     if (retarg)        
  556.         strcpy(retarg, path);
  557.             
  558.     return retarg;
  559. }
  560.  
  561. char * AEExtractor(void * data, int index)
  562. {
  563.     static Boolean            hasParams = false;
  564.     static AEDesc            params;
  565.     static AESubDesc        paramList;
  566.     static int                scriptIndex;
  567.     
  568.     AppleEvent *     event;
  569.     AESubDesc        sd;
  570.     AEKeyword        noKey;
  571.     AEDesc            desc;
  572.     FSSpec            script;
  573.     FSSpec            arg;
  574.     Size                size;
  575.     char *            retarg;
  576.     DescType            type;
  577.     Boolean            flag;
  578.     
  579.     event = (AppleEvent *) data;
  580.     
  581.     if (!hasParams) {
  582.         AEGetParamDesc(event, keyDirectObject, typeAEList, ¶ms);
  583.         AEDescToSubDesc(¶ms, ¶mList);
  584.         hasParams = true;
  585.         scriptIndex = 0; 
  586.         
  587.         if (gRuntimeScript)
  588.             gPseudoFile = gRuntimeScript;
  589.         else
  590.             while (!AEGetNthSubDesc(¶mList, ++scriptIndex, &noKey, &sd)) {
  591.                 if (!AESubDescToDesc(&sd, typeFSS, &desc)) {
  592.                     script = **(FSSpec **) desc.dataHandle;
  593.                     
  594.                     AEDisposeDesc(&desc);
  595.                     
  596.                     break;
  597.                 } 
  598.                 if (AESubDescToDesc(&sd, typeChar, &desc))
  599.                     continue;
  600.                 if ((*desc.dataHandle)[0] == '-') {
  601.                     AEDisposeDesc(&desc);
  602.                     
  603.                     continue;
  604.                 } else {
  605.                     if (!gPseudoFileName[0])
  606.                         strcpy(gPseudoFileName, "<AppleEvent>");
  607.                     gPseudoFile = desc.dataHandle;
  608.                     
  609.                     break;
  610.                 }
  611.             }
  612.     }
  613.     
  614.     switch (index) {
  615.     case extractDone:
  616.         gRuntimeScript = nil;
  617.  
  618.         if (hasParams)
  619.             AEDisposeDesc(¶ms);
  620.             
  621.         hasParams        = false;
  622.  
  623.         return nil;
  624.     case extractDir:
  625.         if (gPseudoFile) {
  626.             script.vRefNum    =    gAppVol;
  627.             script.parID    =    gAppDir;
  628.         } else {
  629.             short    res    = CurResFile();
  630.             
  631.             gScriptFile = HOpenResFile(script.vRefNum, script.parID, script.name, fsRdPerm);
  632.             
  633.             if (gPseudoFile    =     Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  634.                 strcpy(gPseudoFileName, FSp2FullPath(&script));
  635.                 
  636.                 DetachResource(gPseudoFile);
  637.             }
  638.  
  639.             UseResFile(res);
  640.         } 
  641.         
  642.         FSpUp(&script);
  643.         
  644.         return FSp2FullPath(&script);
  645.     case extractDebug:
  646.         if (AEGetParamPtr(event, 'DEBG', typeBoolean, &type, (Ptr) &flag, 1, &size))
  647.             return nil;
  648.         else
  649.             return flag ? "y" : "n";
  650.     case extractCpp:
  651.         if (AEGetParamPtr(event, 'PREP', typeBoolean, &type, (Ptr) &flag, 1, &size))
  652.             return nil;
  653.         else
  654.             return flag ? "y" : "n";
  655.     case extractSyntax:
  656.         if (AEGetParamPtr(event, 'CHCK', typeBoolean, &type, (Ptr) &flag, 1, &size))
  657.             return nil;
  658.         else
  659.             return flag ? "y" : "n";
  660.     case extractWarn:
  661.         if (AEGetParamPtr(event, 'WARN', typeBoolean, &type, (Ptr) &flag, 1, &size))
  662.             return nil;
  663.         else
  664.             return flag ? "y" : "n";
  665.     default:
  666.         /* A runtime script inserts itself at the beginning */
  667.         if (gRuntimeScript)
  668.             --index;
  669.         
  670.         if (index == scriptIndex && gPseudoFile)
  671.             return MakePath("Dev:Pseudo");
  672.         
  673.         /* End of list ? */
  674.         if (AEGetNthSubDesc(¶mList, index, &noKey, &sd))
  675.             return nil;
  676.  
  677.         if (!AESubDescToDesc(&sd, typeFSS, &desc)) {
  678.             arg = **(FSSpec **) desc.dataHandle;
  679.             
  680.             AEDisposeDesc(&desc);
  681.             
  682.             /* A file, convert to a path name */
  683.             retarg = FSp2FullPath(&arg);
  684.             
  685.             return MakePath(retarg);
  686.         } else if (!AESubDescToDesc(&sd, typeChar, &desc)) {
  687.             size         = GetHandleSize(desc.dataHandle);
  688.             retarg     = NewPtr(size+1);
  689.             
  690.             if (retarg) {
  691.                 retarg[size] = 0;
  692.             
  693.                 memcpy(retarg, *desc.dataHandle, size);
  694.             }
  695.                     
  696.             AEDisposeDesc(&desc);
  697.             
  698.             return retarg;
  699.         }
  700.         
  701.         return nil;
  702.     }            
  703. }
  704.  
  705. char * StupidExtractor(void * data, int index)
  706. {
  707.     FSSpec    *        spec;
  708.     FSSpec            dir;
  709.     char *            retarg;
  710.     char *            path;
  711.     
  712.     spec = (FSSpec *) data;
  713.     
  714.     switch (index) {
  715.     case extractDone:
  716.     case extractDebug:
  717.     case extractCpp:
  718.         return nil;
  719.     case extractDir:
  720.         dir = *spec;
  721.         
  722.         {
  723.             short    res    = CurResFile();
  724.             
  725.             gScriptFile = HOpenResFile(dir.vRefNum, dir.parID, dir.name, fsRdPerm);
  726.             
  727.             if (gPseudoFile    =     Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  728.                 strcpy(gPseudoFileName, FSp2FullPath(spec));
  729.                 
  730.                 DetachResource(gPseudoFile);
  731.             }
  732.             
  733.             UseResFile(res);
  734.         } 
  735.         
  736.         FSpUp(&dir);
  737.         
  738.         return FSp2FullPath(&dir);
  739.     default:
  740.         if (index > 1)
  741.             return nil;
  742.  
  743.         if (gPseudoFile)
  744.             return "Dev:Pseudo";
  745.             
  746.         path = FSp2FullPath(spec);
  747.         retarg = NewPtr(strlen(path)+1);
  748.             
  749.         strcpy(retarg, path);
  750.             
  751.         return retarg;
  752.     }            
  753. }
  754.  
  755. void AddErrorDescription(AppleEvent * reply)
  756. {
  757.     OSErr            err;
  758.     AliasHandle    file;
  759.     AEStream        aes;
  760.     AEDesc      newDesc;
  761.     short            line;
  762.  
  763.     if (gFirstErrorLine == -1 || reply->descriptorType == typeNull) 
  764.         return;
  765.     
  766.     line = (short) gFirstErrorLine;
  767.     
  768.     if (NewAlias(nil, &gFirstErrorFile, &file)) 
  769.         return;
  770.         
  771.     HLock((Handle) file);
  772.     err = AEPutParamPtr(
  773.                 reply, kOSAErrorOffendingObject, 
  774.                 typeAlias, (Ptr) *file, GetHandleSize((Handle) file));
  775.     DisposHandle((Handle) file);
  776.         
  777.     if (err)
  778.         return;
  779.         
  780.     if (AEStream_Open(&aes))
  781.         return;
  782.         
  783.     if (AEStream_OpenRecord(&aes, typeAERecord)
  784.     ||     AEStream_WriteKeyDesc(&aes, keyOSASourceStart, typeShortInteger, (Ptr) &line, 2)
  785.     ||     AEStream_WriteKeyDesc(&aes, keyOSASourceEnd, typeShortInteger, (Ptr) &line, 2)
  786.     ||     AEStream_CloseRecord(&aes)
  787.     ||     AEStream_Close(&aes, &newDesc)
  788.     ) {
  789.         AEStream_Close(&aes, nil);
  790.     } else {
  791.         AEPutParamDesc(reply, kOSAErrorRange, &newDesc)    ;
  792.         AEDisposeDesc(&newDesc);
  793.     }
  794. }
  795.  
  796. pascal OSErr DoScript(const AppleEvent *event, AppleEvent *reply, long refCon)
  797. {
  798. #if !defined(powerc) && !defined(__powerc)
  799. #pragma unused (refCon)
  800. #endif
  801.     Boolean    ranOK;
  802.     OSType    mode;
  803.     DescType    typeCode;
  804.     Size        size;
  805.     AEDesc    env;
  806.     
  807.     if (gRunningPerl) {
  808.         const AppleEvent * e[2];
  809.         
  810.         e[0] = event;
  811.         e[1] = reply;
  812.         
  813.         PtrAndHand((Ptr) e, (Handle) gWaitingScripts, 8);
  814.         
  815.         return AESuspendTheCurrentEvent(event);
  816.     }
  817.  
  818.     if (AEGetParamPtr(event, 'MODE', typeEnumerated, &typeCode, &mode, 4, &size))
  819.         mode = 'LOCL';
  820.     
  821.     switch (mode) {
  822.     case 'RCTL':                
  823.         if (reply) {    /* Return immediately from initial request */
  824.             AEDuplicateDesc(event, &gDelayedScript);
  825.             
  826.             return 0;
  827.         }
  828.  
  829.         /* Fall through on delayed request */ 
  830.     case 'BATC':
  831.         freopen("Dev:AEVT", "r", stdin);
  832.         freopen("Dev:AEVT", "w", stdout);
  833.         freopen("Dev:AEVT:diag", "w", stderr); 
  834.         
  835.         Relay(event, nil, mode);
  836.     }
  837.     
  838.     if (AEGetParamDesc(event, 'ENVT', typeAEList, &env))
  839.         MakePerlEnviron(nil);
  840.     else {
  841.         MakePerlEnviron(&env);
  842.         AEDisposeDesc(&env);
  843.     }
  844.         
  845.     ranOK = RunScript(AEExtractor, (void *) event);
  846.     
  847.     switch (mode) {
  848.     case 'RCTL':
  849.         /* Provoke controller to send last data event */
  850.         if (!gQuitting)
  851.             FlushAEVTs(nil);
  852.         break;
  853.     case 'BATC':
  854.     case 'LOCL':    
  855.         /* Get output data into reply event */
  856.         FlushAEVTs(reply);
  857.         
  858.         if (gPerlReply) {
  859.             HLock(gPerlReply);
  860.             AEPutParamPtr(
  861.                         reply, keyDirectObject,
  862.                         typeChar, *gPerlReply, GetHandleSize(gPerlReply));
  863.             DisposeHandle(gPerlReply);
  864.             gPerlReply = nil;
  865.         }
  866.         
  867.         AddErrorDescription(reply);
  868.     }
  869.     
  870.     return ranOK ? 0 : (gSyntaxError ? 1 : 2);
  871. }
  872.  
  873. pascal Boolean DoRuntime()
  874. {
  875.     short        message;
  876.     short        count;
  877.     FSSpec    spec;
  878.     
  879.     if (gRuntimeScript = Get1NamedResource('TEXT', (StringPtr) "\p!")) {
  880.         spec.vRefNum     =     gAppVol;
  881.         spec.parID        =    gAppDir;
  882.         PLstrcpy(spec.name, LMGetCurApName());
  883.         strcpy(gPseudoFileName, FSp2FullPath(&spec));
  884.         
  885.         DetachResource(gRuntimeScript);
  886.     }
  887.  
  888.     return false;
  889. }
  890.