home *** CD-ROM | disk | FTP | other *** search
/ World of A1200 / World_Of_A1200.iso / programs / system / filerexx / txt / simplerexx.mod < prev    next >
Text File  |  1995-02-27  |  4KB  |  184 lines
  1. (*************************************************************************
  2.  
  3. :Program.    SimpleRexx.mod
  4. :Contents.   simple rexx interface for use with ARexxBox
  5. :Author.     Hartmut Goebel [hG]
  6. :Copyright.  Copyright © 1990 by Hartmut Goebel
  7. :Copyright.  original 'C' definitions copyright © 1990 by Martin Balzer
  8. :Language.   Oberon-2
  9. :Translator. Amiga Oberon V2.43
  10. :History.    V1.0, 31 Aug 1992 [hG]
  11. :History.    V1.02 24 Oct 1992 [hG]
  12. :Date.       24 Oct 1992 01:52:38
  13.  
  14. *************************************************************************)
  15.  
  16. (* $StackChk- $NilChk- $RangeChk- $CaseChk- $OvflChk- $ReturnChk- $ClearVars- *)
  17.  
  18. MODULE SimpleRexx;
  19.  
  20.  
  21. IMPORT
  22.   BT  := BasicTypes,
  23.   e   := Exec,
  24.   d   := Dos,
  25.   pf  := Printf,
  26.          RVI,
  27.   rx  := Rexx,
  28.   rxs := RexxSysLib,
  29.   y   := SYSTEM,
  30.   str := Strings;
  31.  
  32. CONST
  33.   RexxExtension * = "";
  34.   RexxPortBaseName = "FILEREXX";
  35.  
  36. TYPE
  37.   RexxHostPtr * = POINTER TO RexxHost;
  38.   RexxHost * = STRUCT
  39.     port     *: e.MsgPortPtr;
  40.     (* name     -: ARRAY 80 OF CHAR; *)
  41.     replies  *: LONGINT;
  42.     (* rdargs   *: d.RDArgsPtr; *)
  43.     (* flags    *: LONGSET; *)
  44.     (* userdata *: e.APTR; *)
  45.   END;
  46.  
  47.  
  48. PROCEDURE ReplyRexxCommand*(rxmsg: rx.RexxMsgPtr;
  49.                             primary: LONGINT;
  50.                             secondary: e.ADDRESS;
  51.                             result: e.STRPTR);
  52. VAR
  53.   buf: ARRAY 16 OF CHAR;
  54.   rc2: e.STRPTR;
  55.  
  56. BEGIN
  57.   (* Ist OPTIONS RESULTS gesetzt? *)
  58.   IF rx.rxfResult IN rx.ActionFlags(rxmsg.action) THEN
  59.     (* Ja, also Resultat generieren *)
  60.  
  61.     IF primary = 0 THEN
  62.       (* Primärer Resultcode = 0 bedeutet Resultat-String in result oder gar nix *)
  63.        IF result = NIL THEN
  64.          secondary := NIL;
  65.        ELSE
  66.          secondary := rxs.CreateArgstring(result^,str.Length(result^))
  67.        END;
  68.     ELSE
  69.      (* Primär # 0: Fehlercode in primary, Zweitcode _oder_ String in secondary *)
  70.       IF primary > 0 THEN
  71.         (* secondary ist Code *)
  72.         pf.SPrintf1(buf,"%ld", secondary );
  73.         rc2 := y.ADR(buf);
  74.       ELSE
  75.         (* secondary ist String *)
  76.         primary := -primary;
  77.         rc2 := y.VAL(e.STRPTR,secondary);
  78.       END;
  79.  
  80.       (* Rexx-Variable setzen (amiga.lib) *)
  81.       IF RVI.SetRexxVar(rxmsg,"RC2", rc2^, str.Length(result^))#0 THEN END;
  82.  
  83.       secondary := NIL;
  84.     END
  85.   ELSIF primary < 0 THEN
  86.     (* User will zwar kein Result, aber Fehlercode darf nicht <0 sein *)
  87.     primary := -primary;
  88.   END;
  89.  
  90.   rxmsg.result1 := primary;
  91.   rxmsg.result2 := secondary;
  92.   e.ReplyMsg(rxmsg);
  93. END ReplyRexxCommand;
  94.  
  95.  
  96. PROCEDURE FreeRexxCommand*(rxmsg: rx.RexxMsgPtr);
  97. BEGIN
  98.   IF (rxmsg.result1 = 0) & (rxmsg.result2 # 0) THEN
  99.     rxs.DeleteArgstring(rxmsg.result2); END;
  100.  
  101.   IF rxmsg.stdin # NIL THEN
  102.     d.OldClose(rxmsg.stdin); END;
  103.  
  104.   IF (rxmsg.stdout # NIL) & (rxmsg.stdout # rxmsg.stdin) THEN
  105.     d.OldClose(rxmsg.stdout); END;
  106.  
  107.   rxs.DeleteArgstring(rxmsg.args[0]);
  108.   rxs.DeleteRexxMsg(rxmsg);
  109. END FreeRexxCommand;
  110.  
  111.  
  112. PROCEDURE CreateRexxCommand*(host: RexxHost;
  113.                              buff: ARRAY OF CHAR;
  114.                                fh: d.FileHandlePtr): rx.RexxMsgPtr;
  115. VAR
  116.   rxCmdMsg: rx.RexxMsgPtr;
  117. BEGIN
  118.   rxCmdMsg := rxs.CreateRexxMsg(host.port,RexxExtension,host.port.node.name^);
  119.   IF rxCmdMsg = NIL THEN
  120.     RETURN NIL;
  121.   END;
  122.  
  123.   rxCmdMsg.args[0] := rxs.CreateArgstring(buff,str.Length(buff));
  124.   IF rxCmdMsg.args[0] = NIL THEN
  125.     rxs.DeleteRexxMsg(rxCmdMsg);
  126.     RETURN NIL;
  127.   END;
  128.  
  129.   rxCmdMsg.action := rx.rxComm + rx.rxResult;
  130.   rxCmdMsg.stdin  := fh;
  131.   rxCmdMsg.stdout := fh;
  132. END CreateRexxCommand;
  133.  
  134.  
  135. PROCEDURE CommandToRexx*(host: RexxHost;
  136.                      rxCmdMsg: rx.RexxMsgPtr): rx.RexxMsgPtr;
  137. VAR
  138.   rexxport: e.MsgPortPtr;
  139. BEGIN
  140.   e.Forbid();
  141.  
  142.   (* rexxport := e.FindPort(rx.rxsDir); *)
  143.   rexxport := e.FindPort(host.port.node.name^);
  144.   IF rexxport = NIL THEN
  145.     e.Permit();
  146.     RETURN NIL;
  147.   END;
  148.  
  149.   e.PutMsg(rexxport, rxCmdMsg);
  150.   e.Permit();
  151.  
  152.   INC(host.replies);
  153.  
  154.   RETURN rxCmdMsg;
  155. END CommandToRexx;
  156.  
  157.  
  158. PROCEDURE SendRexxCommand*(host: RexxHost;
  159.                            buff: ARRAY OF CHAR): rx.RexxMsgPtr;
  160. VAR
  161.   rcm: rx.RexxMsgPtr;
  162. BEGIN
  163.   rcm := CreateRexxCommand(host, buff, NIL);
  164.   IF rcm # NIL THEN
  165.     RETURN CommandToRexx(host,rcm);
  166.   ELSE
  167.     RETURN NIL;
  168.   END;
  169. END SendRexxCommand;
  170.  
  171.  
  172. PROCEDURE IsARexxReply*(msg: e.MessagePtr): BOOLEAN;
  173. VAR
  174. BEGIN
  175.   IF msg # NIL THEN
  176.     RETURN (msg.node.type = e.replyMsg);
  177.   ELSE
  178.     RETURN FALSE;
  179.   END;
  180. END IsARexxReply;
  181.  
  182. END SimpleRexx.
  183.  
  184.