os2/perlrexx.cmd

   1 /* Test PERLREXX.DLL */
   2 /* Example:
   3    perlrexx.cmd BEGIN {push @INC, 'lib'} use OS2::REXX; REXX_eval "address cmd\n'copyy'";
   4  */
   5
   6 call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
   7 call SysLoadFuncs
   8
   9 parse arg args
  10 retval = runperl(args)
  11 say 'retval = "'retval'"'
  12 exit 0
  13
  14 addperl: procedure
  15   parse arg perlf
  16   pathname='perlrexx'
  17   r = RxFuncAdd(perlf, pathname, perlf)
  18   say "RxFuncAdd("perlf","pathname") -> "r
  19   return
  20
  21 runperl1: procedure
  22   parse arg perlarg
  23   call addperl('PERL')
  24   call addperl('PERLTERM')
  25   call addperl('PERLEXIT')
  26   call addperl('PERLEVAL')
  27   call addperl('PERLLASTERROR')
  28   signal on syntax name runperl_error
  29 /*  signal on error name runperl_error
  30   signal on failure name runperl_error */
  31   say "doing PERLEVAL("perlarg")"
  32   tmp = PERLEVAL(perlarg)
  33   say "PERLEVAL -> '"tmp"'"
  34   signal off syntax
  35   call RxFuncDrop 'PERL'
  36   call RxFuncDrop 'PERLLASTERROR'
  37   call RxFuncDrop 'PERLTERM'
  38   call RxFuncDrop 'PERLEVAL'
  39   call PERLEXIT
  40   call RxFuncDrop 'PERLEXIT'
  41   return pathname ': PERLEVAL('perlarg') =' tmp
  42
  43 runperl: procedure
  44   parse arg perlarg
  45   pathname='perlrexx'
  46   r = RxFuncAdd("PerlExportAll", pathname, "PERLEXPORTALL")
  47   say "RxFuncAdd("'PerlExportAll'","pathname") -> "r
  48   r = PerlExportAll()
  49   say "PerlExportAll() -> "r
  50   signal on syntax name runperl_error
  51 /*  signal on error name runperl_error
  52   signal on failure name runperl_error */
  53   say "doing PERLEVAL("perlarg")"
  54   tmp = PERLEVAL(perlarg)
  55   say "PERLEVAL -> '"tmp"'"
  56   address evalperl perlarg
  57   say "Did address evalperl "perlarg
  58   signal off syntax
  59   r = PerlDropAllExit()
  60   /* The following line is not reached...  Why? */
  61   say "PerlDropAllExit() -> "r
  62   return pathname ': PERLEVAL('perlarg') =' tmp
  63
  64
  65 runperl_error:
  66   return pathname ': REXX->Perl interface not available; rc="'rc'", .rs="'.rs'", errstr="'errortext(rc)'", perlerr="'PERLLASTERROR()'"'
  67
  68 /*  return pathname ': REXX->Perl interface not available; rc="'rc'", .rs="'.rs'", errstr="'errortext(rc)'", perlerr="???"' */