8 @ISA = qw(Exporter DynaLoader);
9 # Items to export into callers namespace by default
10 # (move infrequently used names to @EXPORT_OK below)
11 @EXPORT = qw(REXX_call REXX_eval REXX_eval_with);
12 # Other items we are prepared to export if requested
13 @EXPORT_OK = qw(drop register);
17 # We cannot just put OS2::DLL in @ISA, since some scripts would use
18 # function interface, not method interface...
20 *_call = \&OS2::DLL::_call;
21 *load = \&OS2::DLL::load;
22 *find = \&OS2::DLL::find;
26 # Preloaded methods go here. Autoload methods go after __END__, and are
27 # processed by the autosplit program.
29 sub register {_register($_) for @_}
34 $self->{Prefix} = shift;
40 $self->{Queue} = shift;
44 { # Supposedly should drop anything with
45 # the given prefix. Unfortunately a
46 # loop is needed after fixpack17.
47 &OS2::REXX::_drop(@_);
51 { # Supposedly should drop anything with
52 # the given prefix. Unfortunately a
53 # loop is needed after fixpack17.
54 &OS2::REXX::_drop(@_); # Try to drop them all.
58 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
59 while (($name) = OS2::REXX::_next($_)) {
60 OS2::REXX::_drop($_ . $name);
68 my ($obj, $name) = @_;
69 $name =~ s/^([\w!?]+)/\U$1\E/;
70 return bless \$name, OS2::REXX::_SCALAR;
75 my ($obj, $name) = @_;
76 $name =~ s/^([\w!?]+)/\U$1\E/;
77 return bless [$name, 0], OS2::REXX::_ARRAY;
82 my ($obj, $name) = @_;
83 $name =~ s/^([\w!?]+)/\U$1\E/;
84 return bless {Stem => $name}, OS2::REXX::_HASH;
87 #############################################################################
88 package OS2::REXX::_SCALAR;
92 return OS2::REXX::_fetch(${$_[0]});
97 return OS2::REXX::_set(${$_[0]}, $_[1]);
102 return OS2::REXX::_drop(${$_[0]});
105 #############################################################################
106 package OS2::REXX::_ARRAY;
110 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
111 return OS2::REXX::_fetch($_[0]->[0].'.'.(0+$_[1]));
116 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
117 return OS2::REXX::_set($_[0]->[0].'.'.(0+$_[1]), $_[2]);
120 #############################################################################
121 package OS2::REXX::_HASH;
124 @ISA = ('Tie::Hash');
129 my $stem = $self->{Stem};
131 delete $self->{List} if exists $self->{List};
135 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
136 while (($name) = OS2::REXX::_next($stem)) {
141 $self->{List} = \@list;
147 return pop @{$_[0]->{List}};
152 return defined OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
157 return OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
162 return OS2::REXX::_set($_[0]->{Stem}.$_[1], $_[2]);
167 OS2::REXX::_drop($_[0]->{Stem}.$_[1]);
170 #############################################################################
178 OS2::REXX - access to DLLs with REXX calling convention and REXX runtime.
182 By default, the REXX variable pool is not available, neither
183 to Perl, nor to external REXX functions. To enable it, you need to put
184 your code inside C<REXX_call> function. REXX functions which do not use
185 variables may be usable even without C<REXX_call> though.
190 $ydb = load OS2::REXX "ydbautil" or die "Cannot load: $!";
191 @pid = $ydb->RxProcId();
193 tie $s, OS2::REXX, "TEST";
201 $dll = load OS2::REXX NAME [, WHERE];
203 NAME is DLL name, without path and extension.
205 Directories are searched WHERE first (list of dirs), then environment
206 paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search
207 is performed in default DLL path (without adding paths and extensions).
209 The DLL is not unloaded when the variable dies.
211 Returns DLL object reference, or undef on failure.
213 =head2 Define function prefix:
217 Define the prefix of external functions, prepended to the function
218 names used within your program, when looking for the entries in the
223 $dll = load OS2::REXX "RexxBase";
224 $dll->prefix("RexxBase_");
229 $dll = load OS2::REXX "RexxBase";
230 $dll->RexxBase_Init();
236 Define the name of the REXX queue passed to all external
237 functions of this module. Defaults to "SESSION".
239 Check for functions (optional):
241 BOOL = $dll->find(NAME [, NAME [, ...]]);
243 Returns true if all functions are available.
245 =head2 Call external REXX function:
247 $dll->function(arguments);
249 Returns the return string if the return code is 0, else undef.
250 Dies with error message if the function is not available.
252 =head1 Accessing REXX-runtime
254 While calling functions with REXX signature does not require the presence
255 of the system REXX DLL, there are some actions which require REXX-runtime
256 present. Among them is the access to REXX variables by name.
258 One enables REXX runtime by bracketing your code by
262 (trailing semicolon required!) or
264 REXX_call \&subroutine_name;
266 Inside such a call one has access to REXX variables (see below).
268 An alternative way to execute code inside a REXX compartment is
272 subroutine_name_in_REXX => \&Perl_subroutine
274 Here C<EXPR> is a REXX code to run; to execute Perl code one needs to put
275 it inside Perl_subroutine(), and call this subroutine from REXX, as in
277 REXX_eval_with <<EOE, foo => sub { 123 * shift };
281 If one needs more Perl subroutines available, one can "import" them into
282 REXX from inside Perl_subroutine(); since REXX is not case-sensitive,
283 the names should be uppercased.
285 use OS2::REXX 'register';
287 sub BAR { 123 + shift}
289 sub importer { register qw(BAR BAZ) }
291 REXX_eval_with <<'EOE', importer => \&importer;
297 =head2 Bind scalar variable to REXX variable:
299 tie $var, OS2::REXX, "NAME";
301 =head2 Bind array variable to REXX stem variable:
303 tie @var, OS2::REXX, "NAME.";
305 Only scalar operations work so far. No array assignments, no array
306 operations, ... FORGET IT.
308 =head2 Bind hash array variable to REXX stem variable:
310 tie %var, OS2::REXX, "NAME.";
312 To access all visible REXX variables via hash array, bind to "";
314 No array assignments. No array operations, other than hash array
315 operations. Just like the *dbm based implementations.
317 For the usual REXX stem variables, append a "." to the name,
318 as shown above. If the hash key is part of the stem name, for
319 example if you bind to "", you cannot use lower case in the stem
320 part of the key and it is subject to character set restrictions.
322 =head2 Erase individual REXX variables (bound or not):
324 OS2::REXX::drop("NAME" [, "NAME" [, ...]]);
326 =head2 Erase REXX variables with given stem (bound or not):
328 OS2::REXX::dropall("STEM" [, "STEM" [, ...]]);
330 =head2 Make Perl functions available in REXX:
332 OS2::REXX::register("NAME" [, "NAME" [, ...]]);
334 Since REXX is not case-sensitive, the names should be uppercase.
336 =head1 Subcommand handlers
338 By default, the executed REXX code runs without any default subcommand
339 handler present. A subcommand handler named C<PERLEVAL> is defined, but
340 not made a default. Use C<ADDRESS PERLEVAL> REXX command to make it a default
341 handler; alternatively, use C<ADDRESS Handler WhatToDo> to direct a command
342 to the handler you like.
344 Experiments show that the handler C<CMD> is also available; probably it is
345 provided by the REXX runtime.
347 =head1 Interfacing from REXX to Perl
349 This module provides an interface from Perl to REXX, and from REXX-inside-Perl
350 back to Perl. There is an alternative scenario which allows usage of Perl
353 A DLL F<PerlRexx> provides an API to Perl as REXX functions
365 A subcommand handler C<PERLEVALSUBCOMMAND> can also be registered. Calling
366 the function PERLEXPORTALL() exports all these functions, as well as
367 exports this subcommand handler under the name C<EVALPERL>. PERLDROPALL()
368 inverts this action (and unloads PERLEXPORTALL() as well). In particular
370 rc = RxFuncAdd("PerlExportAll", 'PerlRexx', "PERLEXPORTALL")
372 res = PERLEVAL(perlarg)
373 ADDRESS EVALPERL perlarg1
374 rc = PerlDropAllExit()
376 loads all the functions above, evals the Perl code in the REXX variable
377 C<perlarg>, putting the result into the REXX variable C<res>,
378 then evals the Perl code in the REXX variable C<perlarg1>, and, finally,
379 drops the loaded functions and the subcommand handler, deinitializes
380 the Perl interpreter, and exits the Perl's C runtime library.
382 PERLEXIT() or PERLDROPALLEXIT() should be called as the last command of
383 the REXX program. (This is considered as a bug.) Their purpose is to flush
384 all the output buffers of the Perl's C runtime library.
386 C<PERLLASTERROR> gives the reason for the failure of the last PERLEVAL().
387 It is useful inside C<signal on syntax> handler. PERLINIT() and PERLTERM()
388 initialize and deinitialize the Perl interpreter.
390 C<PERLEVAL(string)> initializes the Perl interpreter (if needed), and
391 evaluates C<string> as Perl code. The result is returned to REXX stringified,
392 undefined result is considered as failure.
394 C<PERL(string)> does the same as C<PERLEVAL(string)> wrapped by calls to
395 PERLINIT() and PERLEXIT().
399 Note that while function and variable names are case insensitive in the
400 REXX language, function names exported by a DLL and the REXX variables
401 (as seen by Perl through the chosen API) are all case sensitive!
403 Most REXX DLLs export function names all upper case, but there are a
404 few which export mixed case names (such as RxExtras). When trying to
405 find the entry point, both exact case and all upper case are searched.
406 If the DLL exports "RxNap", you have to specify the exact case, if it
407 exports "RXOPEN", you can use any case.
409 To avoid interfering with subroutine names defined by Perl (DESTROY)
410 or used within the REXX module (prefix, find), it is best to use mixed
411 case and to avoid lowercase only or uppercase only names when calling
412 REXX functions. Be consistent. The same function written in different
413 ways results in different Perl stubs.
415 There is no REXX interpolation on variable names, so the REXX variable
416 name TEST.ONE is not affected by some other REXX variable ONE. And it
417 is not the same variable as TEST.one!
419 You cannot call REXX functions which are not exported by the DLL.
420 While most DLLs export all their functions, some, like RxFTP, export
421 only "...LoadFuncs", which registers the functions within REXX only.
423 You cannot call 16-bit DLLs. The few interesting ones I found
424 (FTP,NETB,APPC) do not export their functions.
426 I do not know whether the REXX API is reentrant with respect to
427 exceptions (signals) when the REXX top-level exception handler is
428 overridden. So unless you know better than I do, do not access REXX
429 variables (probably tied to Perl variables) or call REXX functions
430 which access REXX queues or REXX variables in signal handlers.
432 See C<t/rx*.t> and the next section for examples.
438 sub Ender::DESTROY { $vrexx->VExit; print "Exiting...\n" }
440 $vrexx = OS2::REXX->load('VREXX');
441 REXX_call { # VOpenWindow takes a stem
442 local $SIG{TERM} = sub {die}; # enable Ender::DESTROY
443 local $SIG{INT} = sub {die}; # enable Ender::DESTROY
445 $code = $vrexx->VInit;
446 print "Init code = `$code'\n";
447 die "error initializing VREXX" if $code eq 'ERROR';
449 my $ender = bless [], 'Ender'; # Call Ender::DESTROY on exit
451 print "VREXX Version ", $vrexx->VGetVersion, "\n";
453 tie %pos, 'OS2::REXX', 'POS.' or die;
454 %pos = ( LEFT => 0, RIGHT => 7, TOP => 5, BOTTOM => 0 );
456 $id = $vrexx->VOpenWindow('To disconnect:', 'WHITE', 'POS');
457 $vrexx->VForeColor($id, 'BLACK');
458 $vrexx->VSetFont($id, 'TIME', '30');
460 while ( ($r = $tlim - time) >= 0 ) {
461 $vrexx->VClearWindow($id);
462 $vrexx->VSay($id, 100, 50, (sprintf "%02i:%02i", int($r/60), $r % 60));
465 print "Close code = `$res'\n" if $res = $vrexx->VCloseWindow($id);
472 If C<PERL_REXX_DEBUG> is set, prints trace info on calls to REXX runtime
477 Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
478 ilya@math.ohio-state.edu.