home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / ext / MacPerl / XL.xs < prev   
Encoding:
Text File  |  1995-10-28  |  5.5 KB  |  298 lines  |  [TEXT/MPS ]
  1. /* $Header: tyrathect:Development:Perl::RCS:missing.c,v 1.2 1994/05/04 02:12:43 neeri Exp $
  2.  *
  3.  *    Copyright (c) 1995 Matthias Neeracher
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log: XL.xs,v $
  9.  */
  10.  
  11. #define MAC_CONTEXT
  12.  
  13. #include "EXTERN.h"
  14. #include "perl.h"
  15. #include "XSUB.h"
  16. #include <Types.h>
  17. #include <HyperXCmd.h>
  18. #include <Resources.h>
  19. #include <TextUtils.h>
  20. #include <XL.h>
  21. #include <strings.h>
  22.  
  23. XLGlue     XLPerlGlue;
  24.  
  25. static void PerlXLGetGlobal(XCmdPtr params)
  26. {
  27.     StringPtr     var    =    (StringPtr) params->inArgs[0];
  28.     char            ch     =     0;
  29.     SV *            sv;
  30.     char *        str;
  31.     STRLEN        len;
  32.     
  33.     if (sv = perl_get_sv(p2cstr(var), FALSE)) {
  34.         str = (char *)SvPV(sv,len);
  35.         PtrToHand(str, (Handle *) ¶ms->outArgs[0], len+1);
  36.     } else
  37.         PtrToHand(&ch, (Handle *) ¶ms->outArgs[0], 1);
  38.         
  39.     c2pstr((char *) var);
  40.     
  41.     params->result = xresSucc;    
  42. }
  43.  
  44. static void PerlXLSetGlobal(XCmdPtr params)
  45. {
  46.     StringPtr     var    =    (StringPtr) params->inArgs[0];
  47.     Handle        val    =     (Handle) params->inArgs[1];
  48.     char            ch     =     0;
  49.     SV *            sv;
  50.     
  51.     HLock(val);
  52.     if (sv = perl_get_sv(p2cstr(var), TRUE))
  53.         sv_setpv(sv, *val);
  54.     c2pstr((char *) var);
  55.     HUnlock(val);
  56.     
  57.     params->result = sv ? xresSucc : xresFail;    
  58. }
  59.  
  60. static void InitPerlXL()
  61. {
  62.     XLCopyGlue(XLPerlGlue, XLDefaultGlue);
  63.     
  64.     XLPerlGlue[xl_GetGlobal]    =    PerlXLGetGlobal;
  65.     XLPerlGlue[xl_SetGlobal]    =    PerlXLSetGlobal;
  66. }
  67.  
  68. typedef struct {
  69.     short        refNum;
  70.     FSSpec    file;
  71. } ResourceFile;
  72.  
  73. typedef struct {
  74.     short                count;
  75.     ResourceFile    file[1];
  76. } ** ResourceFiles;
  77.  
  78. typedef struct {
  79.     short        refNum;
  80.     ResType    type;
  81.     short        id;
  82. } Xternal, ** XternalHdl;
  83.  
  84. static ResourceFiles ResFiles;
  85. static XternalHdl        Xternals;
  86. static int                XternalIndex = 0;
  87. static Boolean            CloseInstalled = false;
  88.  
  89. static void XLCloseResFiles(void)
  90. {
  91.     if (ResFiles) {
  92.         while ((*ResFiles)->count--)
  93.             CloseResFile((*ResFiles)->file[(*ResFiles)->count].refNum);
  94.         
  95.         DisposeHandle((Handle) ResFiles);
  96.         
  97.         ResFiles = nil;
  98.     }
  99.     
  100.     if (Xternals) {
  101.         DisposeHandle((Handle) Xternals);
  102.         
  103.         Xternals = nil;
  104.     }
  105.     
  106.     XternalIndex     =     0;
  107.     CloseInstalled    =    false;
  108. }
  109.  
  110. static ResType SearchTypes[] = {'XCMD', 'XFCN', 0};
  111.  
  112. void XS_MacPerl_MP_CallXL(CV *);
  113.  
  114. static void XLLoadResFile(short refNum) 
  115. {
  116.     Handle            xcmd;
  117.     ResType *        type;
  118.     short                count;
  119.     short                id;
  120.     ResType            rtyp;
  121.     short                oldRes = CurResFile();
  122.     Xternal            x;
  123.     CV *                cv;
  124.     char *            file = __FILE__;
  125.     char                name[256];
  126.     
  127.     if (!CloseInstalled) {
  128.         atexit(XLCloseResFiles);
  129.         CloseInstalled = true;
  130.     }
  131.         
  132.     if (!Xternals)
  133.         Xternals = (XternalHdl) NewHandle(0);
  134.     
  135.     UseResFile(refNum);
  136.     
  137.     for (type = SearchTypes; *type; ++type)
  138.         for (count = Count1Resources(*type); count; --count)
  139.             if (xcmd = Get1IndResource(*type, count)) {
  140.                 getresinfo(xcmd, &id, &rtyp, name);
  141.                 
  142.                 x.refNum = refNum;
  143.                 x.type    = rtyp;
  144.                 x.id        = id;
  145.                 
  146.                 PtrAndHand((Ptr) &x, (Handle) Xternals, sizeof(Xternal));
  147.                 
  148.                 cv = newXS(name, XS_MacPerl_MP_CallXL, file);
  149.                 XSANY.any_i32 = XternalIndex++;
  150.             }
  151.             
  152.     UseResFile(oldRes);
  153. }
  154.  
  155. static OSErr XLTryResLoad(FSSpec * spec)
  156. {
  157.     short                i;
  158.     short                refNum;
  159.     ResourceFile    file;
  160.     
  161.     if (!ResFiles) {
  162.         i = 0;
  163.         
  164.         PtrToHand((Ptr) &i, (Handle *) &ResFiles, sizeof(short));
  165.     }
  166.     
  167.     for (i = (*ResFiles)->count; i--; ) {
  168.         ResourceFile * file = (*ResFiles)->file + i;
  169.         
  170.         if (file->file.vRefNum != spec->vRefNum)
  171.             continue;
  172.         if (file->file.parID != spec->parID)
  173.             continue;
  174.             
  175.         if (EqualString(file->file.name, spec->name, false, true))
  176.             return 0;
  177.     }
  178.     
  179.     refNum = HOpenResFile(spec->vRefNum, spec->parID, spec->name, fsRdPerm);
  180.     
  181.     if (refNum == -1)
  182.         return ResError();
  183.     
  184.     file.refNum = refNum;
  185.     file.file     = *spec;
  186.     
  187.     PtrAndHand((Ptr) &file, (Handle) ResFiles, sizeof(ResourceFile));
  188.     ++(*ResFiles)->count;
  189.     
  190.     XLLoadResFile(refNum);
  191.     
  192.     return 0;
  193. }
  194.  
  195. MODULE = XL    PACKAGE = MacPerl    PREFIX = MP_
  196.  
  197. void
  198. MP_LoadExternals(path)
  199.     char *    path
  200.     CODE:
  201.     {
  202.         int        i;
  203.         AV *        ar;
  204.         OSErr        err;
  205.         char        buf[256];
  206.         FSSpec    spec;
  207.         
  208.         if (strchr(path, ':')) {
  209.             if (!Path2FSSpec(path, &spec))
  210.                 err = XLTryResLoad(&spec);
  211.             else
  212.                 err = fnfErr;
  213.             
  214.             goto done;
  215.         }
  216.             
  217.         ar = GvAVn(incgv);
  218.         for (i = 0; i <= AvFILL(ar); i++) {
  219.             char *libptr = SvPVx(*av_fetch(ar, i, TRUE), na);
  220.             int   colon = (libptr[strlen(libptr)-1] == ':');
  221.             
  222.             if (colon)
  223.                 sprintf(buf, "%s%s", libptr, path);
  224.             else
  225.                 sprintf(buf, "%s:%s", libptr, path);
  226.         
  227.             if (!Path2FSSpec(buf, &spec) && !XLTryResLoad(&spec)) {
  228.                 err = 0;
  229.                 
  230.                 goto done;
  231.             }
  232.         }
  233.         
  234.         err = fnfErr;
  235.     done:
  236.         switch (err) {
  237.         case noErr:
  238.             break;
  239.         case fnfErr:
  240.             croak("MacPerl::LoadExternals(\"%s\"): File not found.", path);
  241.         default:
  242.             croak("MacPerl::LoadExternals(\"%s\"): OS Error (%d).", err);
  243.         }
  244.     }
  245.  
  246. void
  247. MP_CallXL(...)
  248.     CODE:
  249.     {
  250.         dXSI32;
  251.         int                     i;
  252.         short                    resFile;
  253.         struct XCmdBlock    xcmd;
  254.         Xternal                xt;
  255.         Handle                xh;
  256.  
  257.         xcmd.paramCount = items;
  258.         for (i = 0; i < items; ++i) {
  259.             STRLEN    len;
  260.             char *     arg = (char *) SvPV(ST(i), len);
  261.         
  262.             PtrToHand(arg, xcmd.params+i, len+1);
  263.         }
  264.     
  265.         for (i = items; i < 16; ++i)
  266.             xcmd.params[i] = nil;
  267.     
  268.         xcmd.returnValue = nil;
  269.         xcmd.passFlag      = 0;
  270.  
  271.         xt = (*Xternals)[ix];
  272.         resFile = CurResFile();
  273.         UseResFile(xt.refNum);
  274.         
  275.         xh = Get1Resource(xt.type, xt.id);
  276.         
  277.         if (!xh)
  278.             croak("XCMD disppeared. Film at 11!");
  279.             
  280.         XLCall(xh, XLPerlGlue, &xcmd);
  281.     
  282.         UseResFile(resFile);
  283.     
  284.         for (i=0; i<16; ++i)
  285.             if (xcmd.params[i])
  286.                 DisposeHandle(xcmd.params[i]);
  287.         
  288.         if (xcmd.returnValue) {
  289.             HLock(xcmd.returnValue);
  290.             ST(0) = sv_2mortal(newSVpv(*xcmd.returnValue, 0));        
  291.             DisposeHandle(xcmd.returnValue);
  292.         } else
  293.             ST(0) = &sv_undef;
  294.     }
  295.  
  296. BOOT:
  297.         InitPerlXL();
  298.