8 # Items to export into callers namespace by default
9 # (move infrequently used names to @EXPORT_OK below)
10 @EXPORT = qw(REXX_call REXX_eval REXX_eval_with);
11 # Other items we are prepared to export if requested
12 @EXPORT_OK = qw(drop register);
16 # We cannot just put OS2::DLL in @ISA, since some scripts would use
17 # function interface, not method interface...
19 *_call = \&OS2::DLL::_call;
20 *load = \&OS2::DLL::load;
21 *find = \&OS2::DLL::find;
23 XSLoader::load 'OS2::REXX';
25 # Preloaded methods go here. Autoload methods go after __END__, and are
26 # processed by the autosplit program.
28 sub register {_register($_) for @_}
33 $self->{Prefix} = shift;
39 $self->{Queue} = shift;
43 { # Supposedly should drop anything with
44 # the given prefix. Unfortunately a
45 # loop is needed after fixpack17.
46 &OS2::REXX::_drop(@_);
50 { # Supposedly should drop anything with
51 # the given prefix. Unfortunately a
52 # loop is needed after fixpack17.
53 &OS2::REXX::_drop(@_); # Try to drop them all.
57 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
58 while (($name) = OS2::REXX::_next($_)) {
59 OS2::REXX::_drop($_ . $name);
67 my ($obj, $name) = @_;
68 $name =~ s/^([\w!?]+)/\U$1\E/;
69 return bless \$name, OS2::REXX::_SCALAR;
74 my ($obj, $name) = @_;
75 $name =~ s/^([\w!?]+)/\U$1\E/;
76 return bless [$name, 0], OS2::REXX::_ARRAY;
81 my ($obj, $name) = @_;
82 $name =~ s/^([\w!?]+)/\U$1\E/;
83 return bless {Stem => $name}, OS2::REXX::_HASH;
86 #############################################################################
87 package OS2::REXX::_SCALAR;
91 return OS2::REXX::_fetch(${$_[0]});
96 return OS2::REXX::_set(${$_[0]}, $_[1]);
101 return OS2::REXX::_drop(${$_[0]});
104 #############################################################################
105 package OS2::REXX::_ARRAY;
109 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
110 return OS2::REXX::_fetch($_[0]->[0].'.'.(0+$_[1]));
115 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
116 return OS2::REXX::_set($_[0]->[0].'.'.(0+$_[1]), $_[2]);
119 #############################################################################
120 package OS2::REXX::_HASH;
123 @ISA = ('Tie::Hash');
128 my $stem = $self->{Stem};
130 delete $self->{List} if exists $self->{List};
134 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
135 while (($name) = OS2::REXX::_next($stem)) {
140 $self->{List} = \@list;
146 return pop @{$_[0]->{List}};
151 return defined OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
156 return OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
161 return OS2::REXX::_set($_[0]->{Stem}.$_[1], $_[2]);
166 OS2::REXX::_drop($_[0]->{Stem}.$_[1]);
169 #############################################################################
177 OS2::REXX - access to DLLs with REXX calling convention and REXX runtime.
181 By default, the REXX variable pool is not available, neither
182 to Perl, nor to external REXX functions. To enable it, you need to put
183 your code inside C<REXX_call> function. REXX functions which do not use
184 variables may be usable even without C<REXX_call> though.
189 $ydb = load OS2::REXX "ydbautil" or die "Cannot load: $!";
190 @pid = $ydb->RxProcId();
192 tie $s, OS2::REXX, "TEST";
200 $dll = load OS2::REXX NAME [, WHERE];
202 NAME is DLL name, without path and extension.
204 Directories are searched WHERE first (list of dirs), then environment
205 paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search
206 is performed in default DLL path (without adding paths and extensions).
208 The DLL is not unloaded when the variable dies.
210 Returns DLL object reference, or undef on failure.
212 =head2 Define function prefix:
216 Define the prefix of external functions, prepended to the function
217 names used within your program, when looking for the entries in the
222 $dll = load OS2::REXX "RexxBase";
223 $dll->prefix("RexxBase_");
228 $dll = load OS2::REXX "RexxBase";
229 $dll->RexxBase_Init();
235 Define the name of the REXX queue passed to all external
236 functions of this module. Defaults to "SESSION".
238 Check for functions (optional):
240 BOOL = $dll->find(NAME [, NAME [, ...]]);
242 Returns true if all functions are available.
244 =head2 Call external REXX function:
246 $dll->function(arguments);
248 Returns the return string if the return code is 0, else undef.
249 Dies with error message if the function is not available.
251 =head1 Accessing REXX-runtime
253 While calling functions with REXX signature does not require the presence
254 of the system REXX DLL, there are some actions which require REXX-runtime
255 present. Among them is the access to REXX variables by name.
257 One enables REXX runtime by bracketing your code by
261 (trailing semicolon required!) or
263 REXX_call \&subroutine_name;
265 Inside such a call one has access to REXX variables (see below).
267 An alternative way to execute code inside a REXX compartment is
271 subroutine_name_in_REXX => \&Perl_subroutine
273 Here C<EXPR> is a REXX code to run; to execute Perl code one needs to put
274 it inside Perl_subroutine(), and call this subroutine from REXX, as in
276 REXX_eval_with <<EOE, foo => sub { 123 * shift };
280 If one needs more Perl subroutines available, one can "import" them into
281 REXX from inside Perl_subroutine(); since REXX is not case-sensitive,
282 the names should be uppercased.
284 use OS2::REXX 'register';
286 sub BAR { 123 + shift}
288 sub importer { register qw(BAR BAZ) }
290 REXX_eval_with <<'EOE', importer => \&importer;
296 =head2 Bind scalar variable to REXX variable:
298 tie $var, OS2::REXX, "NAME";
300 =head2 Bind array variable to REXX stem variable:
302 tie @var, OS2::REXX, "NAME.";
304 Only scalar operations work so far. No array assignments, no array
305 operations, ... FORGET IT.
307 =head2 Bind hash array variable to REXX stem variable:
309 tie %var, OS2::REXX, "NAME.";
311 To access all visible REXX variables via hash array, bind to "";
313 No array assignments. No array operations, other than hash array
314 operations. Just like the *dbm based implementations.
316 For the usual REXX stem variables, append a "." to the name,
317 as shown above. If the hash key is part of the stem name, for
318 example if you bind to "", you cannot use lower case in the stem
319 part of the key and it is subject to character set restrictions.
321 =head2 Erase individual REXX variables (bound or not):
323 OS2::REXX::drop("NAME" [, "NAME" [, ...]]);
325 =head2 Erase REXX variables with given stem (bound or not):
327 OS2::REXX::dropall("STEM" [, "STEM" [, ...]]);
329 =head2 Make Perl functions available in REXX:
331 OS2::REXX::register("NAME" [, "NAME" [, ...]]);
333 Since REXX is not case-sensitive, the names should be uppercase.
335 =head1 Subcommand handlers
337 By default, the executed REXX code runs without any default subcommand
338 handler present. A subcommand handler named C<PERLEVAL> is defined, but
339 not made a default. Use C<ADDRESS PERLEVAL> REXX command to make it a default
340 handler; alternatively, use C<ADDRESS Handler WhatToDo> to direct a command
341 to the handler you like.
343 Experiments show that the handler C<CMD> is also available; probably it is
344 provided by the REXX runtime.
346 =head1 Interfacing from REXX to Perl
348 This module provides an interface from Perl to REXX, and from REXX-inside-Perl
349 back to Perl. There is an alternative scenario which allows usage of Perl
352 A DLL F<PerlRexx> provides an API to Perl as REXX functions
364 A subcommand handler C<PERLEVALSUBCOMMAND> can also be registered. Calling
365 the function PERLEXPORTALL() exports all these functions, as well as
366 exports this subcommand handler under the name C<EVALPERL>. PERLDROPALL()
367 inverts this action (and unloads PERLEXPORTALL() as well). In particular
369 rc = RxFuncAdd("PerlExportAll", 'PerlRexx', "PERLEXPORTALL")
371 res = PERLEVAL(perlarg)
372 ADDRESS EVALPERL perlarg1
373 rc = PerlDropAllExit()
375 loads all the functions above, evals the Perl code in the REXX variable
376 C<perlarg>, putting the result into the REXX variable C<res>,
377 then evals the Perl code in the REXX variable C<perlarg1>, and, finally,
378 drops the loaded functions and the subcommand handler, deinitializes
379 the Perl interpreter, and exits the Perl's C runtime library.
381 PERLEXIT() or PERLDROPALLEXIT() should be called as the last command of
382 the REXX program. (This is considered as a bug.) Their purpose is to flush
383 all the output buffers of the Perl's C runtime library.
385 C<PERLLASTERROR> gives the reason for the failure of the last PERLEVAL().
386 It is useful inside C<signal on syntax> handler. PERLINIT() and PERLTERM()
387 initialize and deinitialize the Perl interpreter.
389 C<PERLEVAL(string)> initializes the Perl interpreter (if needed), and
390 evaluates C<string> as Perl code. The result is returned to REXX stringified,
391 undefined result is considered as failure.
393 C<PERL(string)> does the same as C<PERLEVAL(string)> wrapped by calls to
394 PERLINIT() and PERLEXIT().
398 Note that while function and variable names are case insensitive in the
399 REXX language, function names exported by a DLL and the REXX variables
400 (as seen by Perl through the chosen API) are all case sensitive!
402 Most REXX DLLs export function names all upper case, but there are a
403 few which export mixed case names (such as RxExtras). When trying to
404 find the entry point, both exact case and all upper case are searched.
405 If the DLL exports "RxNap", you have to specify the exact case, if it
406 exports "RXOPEN", you can use any case.
408 To avoid interfering with subroutine names defined by Perl (DESTROY)
409 or used within the REXX module (prefix, find), it is best to use mixed
410 case and to avoid lowercase only or uppercase only names when calling
411 REXX functions. Be consistent. The same function written in different
412 ways results in different Perl stubs.
414 There is no REXX interpolation on variable names, so the REXX variable
415 name TEST.ONE is not affected by some other REXX variable ONE. And it
416 is not the same variable as TEST.one!
418 You cannot call REXX functions which are not exported by the DLL.
419 While most DLLs export all their functions, some, like RxFTP, export
420 only "...LoadFuncs", which registers the functions within REXX only.
422 You cannot call 16-bit DLLs. The few interesting ones I found
423 (FTP,NETB,APPC) do not export their functions.
425 I do not know whether the REXX API is reentrant with respect to
426 exceptions (signals) when the REXX top-level exception handler is
427 overridden. So unless you know better than I do, do not access REXX
428 variables (probably tied to Perl variables) or call REXX functions
429 which access REXX queues or REXX variables in signal handlers.
431 See C<t/rx*.t> and the next section for examples.
437 sub Ender::DESTROY { $vrexx->VExit; print "Exiting...\n" }
439 $vrexx = OS2::REXX->load('VREXX');
440 REXX_call { # VOpenWindow takes a stem
441 local $SIG{TERM} = sub {die}; # enable Ender::DESTROY
442 local $SIG{INT} = sub {die}; # enable Ender::DESTROY
444 $code = $vrexx->VInit;
445 print "Init code = `$code'\n";
446 die "error initializing VREXX" if $code eq 'ERROR';
448 my $ender = bless [], 'Ender'; # Call Ender::DESTROY on exit
450 print "VREXX Version ", $vrexx->VGetVersion, "\n";
452 tie %pos, 'OS2::REXX', 'POS.' or die;
453 %pos = ( LEFT => 0, RIGHT => 7, TOP => 5, BOTTOM => 0 );
455 $id = $vrexx->VOpenWindow('To disconnect:', 'WHITE', 'POS');
456 $vrexx->VForeColor($id, 'BLACK');
457 $vrexx->VSetFont($id, 'TIME', '30');
459 while ( ($r = $tlim - time) >= 0 ) {
460 $vrexx->VClearWindow($id);
461 $vrexx->VSay($id, 100, 50, (sprintf "%02i:%02i", int($r/60), $r % 60));
464 print "Close code = `$res'\n" if $res = $vrexx->VCloseWindow($id);
471 If C<PERL_REXX_DEBUG> is set, prints trace info on calls to REXX runtime
476 Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
477 ilya@math.ohio-state.edu.