6 @ISA = qw(Exporter DynaLoader);
7 # Items to export into callers namespace by default
8 # (move infrequently used names to @EXPORT_OK below)
9 @EXPORT = qw(REXX_call REXX_eval REXX_eval_with);
10 # Other items we are prepared to export if requested
11 @EXPORT_OK = qw(drop);
14 $AUTOLOAD =~ /^OS2::REXX::.+::(.+)$/
15 or confess("Undefined subroutine &$AUTOLOAD called");
16 return undef if $1 eq "DESTROY";
18 or confess("Can't find entry '$1' to DLL '$_[0]->{File}'");
22 @libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'});
27 # Preloaded methods go here. Autoload methods go after __END__, and are
28 # processed by the autosplit program.
30 # Cannot autoload, the autoloader is used for the REXX functions.
34 confess 'Usage: load OS2::REXX <file> [<dirs>]' unless $#_ >= 1;
35 my ($class, $file, @where) = (@_, @libs);
36 return $dlls{$file} if $dlls{$file};
39 $handle = DynaLoader::dl_load_file("$_/$file.dll");
42 $handle = DynaLoader::dl_load_file($file) unless $handle;
43 return undef unless $handle;
44 eval "package OS2::REXX::$file; \@ISA = ('OS2::REXX');"
46 . " \$OS2::REXX::AUTOLOAD = \$AUTOLOAD;"
47 . " goto &OS2::REXX::AUTOLOAD;"
48 . "} 1;" or die "eval package $@";
49 return $dlls{$file} = bless {Handle => $handle, File => $file, Queue => 'SESSION' }, "OS2::REXX::$file";
55 my $file = $self->{File};
56 my $handle = $self->{Handle};
57 my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : "";
58 my $queue = $self->{Queue};
60 my $name = "OS2::REXX::${file}::$_";
61 next if defined(&$name);
62 my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_)
63 || DynaLoader::dl_find_symbol($handle, $prefix.$_)
65 eval "package OS2::REXX::$file; sub $_".
66 "{ shift; OS2::REXX::_call('$_', $addr, '$queue', \@_); }".
76 $self->{Prefix} = shift;
82 $self->{Queue} = shift;
86 { # Supposedly should drop anything with
87 # the given prefix. Unfortunately a
88 # loop is needed after fixpack17.
89 &OS2::REXX::_drop(@_);
93 { # Supposedly should drop anything with
94 # the given prefix. Unfortunately a
95 # loop is needed after fixpack17.
96 &OS2::REXX::_drop(@_); # Try to drop them all.
100 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
101 while (($name) = OS2::REXX::_next($_)) {
102 OS2::REXX::_drop($_ . $name);
110 my ($obj, $name) = @_;
111 $name =~ s/^([\w!?]+)/\U$1\E/;
112 return bless \$name, OS2::REXX::_SCALAR;
117 my ($obj, $name) = @_;
118 $name =~ s/^([\w!?]+)/\U$1\E/;
119 return bless [$name, 0], OS2::REXX::_ARRAY;
124 my ($obj, $name) = @_;
125 $name =~ s/^([\w!?]+)/\U$1\E/;
126 return bless {Stem => $name}, OS2::REXX::_HASH;
129 #############################################################################
130 package OS2::REXX::_SCALAR;
134 return OS2::REXX::_fetch(${$_[0]});
139 return OS2::REXX::_set(${$_[0]}, $_[1]);
144 return OS2::REXX::_drop(${$_[0]});
147 #############################################################################
148 package OS2::REXX::_ARRAY;
152 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
153 return OS2::REXX::_fetch($_[0]->[0].'.'.(0+$_[1]));
158 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
159 return OS2::REXX::_set($_[0]->[0].'.'.(0+$_[1]), $_[2]);
162 #############################################################################
163 package OS2::REXX::_HASH;
166 @ISA = ('Tie::Hash');
171 my $stem = $self->{Stem};
173 delete $self->{List} if exists $self->{List};
177 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
178 while (($name) = OS2::REXX::_next($stem)) {
183 $self->{List} = \@list;
189 return pop @{$_[0]->{List}};
194 return defined OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
199 return OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
204 return OS2::REXX::_set($_[0]->{Stem}.$_[1], $_[2]);
209 OS2::REXX::_drop($_[0]->{Stem}.$_[1]);
212 #############################################################################
220 OS2::REXX - access to DLLs with REXX calling convention and REXX runtime.
224 By default, the REXX variable pool is not available, neither
225 to Perl, nor to external REXX functions. To enable it, you need to put
226 your code inside C<REXX_call> function. REXX functions which do not use
227 variables may be usable even without C<REXX_call> though.
232 $ydb = load OS2::REXX "ydbautil" or die "Cannot load: $!";
233 @pid = $ydb->RxProcId();
235 tie $s, OS2::REXX, "TEST";
243 $dll = load OS2::REXX NAME [, WHERE];
245 NAME is DLL name, without path and extension.
247 Directories are searched WHERE first (list of dirs), then environment
248 paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search
249 is performed in default DLL path (without adding paths and extensions).
251 The DLL is not unloaded when the variable dies.
253 Returns DLL object reference, or undef on failure.
255 =head2 Define function prefix:
259 Define the prefix of external functions, prepended to the function
260 names used within your program, when looking for the entries in the
265 $dll = load OS2::REXX "RexxBase";
266 $dll->prefix("RexxBase_");
271 $dll = load OS2::REXX "RexxBase";
272 $dll->RexxBase_Init();
278 Define the name of the REXX queue passed to all external
279 functions of this module. Defaults to "SESSION".
281 Check for functions (optional):
283 BOOL = $dll->find(NAME [, NAME [, ...]]);
285 Returns true if all functions are available.
287 =head2 Call external REXX function:
289 $dll->function(arguments);
291 Returns the return string if the return code is 0, else undef.
292 Dies with error message if the function is not available.
294 =head1 Accessing REXX-runtime
296 While calling functions with REXX signature does not require the presence
297 of the system REXX DLL, there are some actions which require REXX-runtime
298 present. Among them is the access to REXX variables by name.
300 One enables REXX runtime by bracketing your code by
304 (trailing semicolon required!) or
306 REXX_call \&subroutine_name;
308 Inside such a call one has access to REXX variables (see below), and to
312 subroutine_name_in_REXX => \&Perl_subroutine
314 =head2 Bind scalar variable to REXX variable:
316 tie $var, OS2::REXX, "NAME";
318 =head2 Bind array variable to REXX stem variable:
320 tie @var, OS2::REXX, "NAME.";
322 Only scalar operations work so far. No array assignments, no array
323 operations, ... FORGET IT.
325 =head2 Bind hash array variable to REXX stem variable:
327 tie %var, OS2::REXX, "NAME.";
329 To access all visible REXX variables via hash array, bind to "";
331 No array assignments. No array operations, other than hash array
332 operations. Just like the *dbm based implementations.
334 For the usual REXX stem variables, append a "." to the name,
335 as shown above. If the hash key is part of the stem name, for
336 example if you bind to "", you cannot use lower case in the stem
337 part of the key and it is subject to character set restrictions.
339 =head2 Erase individual REXX variables (bound or not):
341 OS2::REXX::drop("NAME" [, "NAME" [, ...]]);
343 =head2 Erase REXX variables with given stem (bound or not):
345 OS2::REXX::dropall("STEM" [, "STEM" [, ...]]);
349 Note that while function and variable names are case insensitive in the
350 REXX language, function names exported by a DLL and the REXX variables
351 (as seen by Perl through the chosen API) are all case sensitive!
353 Most REXX DLLs export function names all upper case, but there are a
354 few which export mixed case names (such as RxExtras). When trying to
355 find the entry point, both exact case and all upper case are searched.
356 If the DLL exports "RxNap", you have to specify the exact case, if it
357 exports "RXOPEN", you can use any case.
359 To avoid interfering with subroutine names defined by Perl (DESTROY)
360 or used within the REXX module (prefix, find), it is best to use mixed
361 case and to avoid lowercase only or uppercase only names when calling
362 REXX functions. Be consistent. The same function written in different
363 ways results in different Perl stubs.
365 There is no REXX interpolation on variable names, so the REXX variable
366 name TEST.ONE is not affected by some other REXX variable ONE. And it
367 is not the same variable as TEST.one!
369 You cannot call REXX functions which are not exported by the DLL.
370 While most DLLs export all their functions, some, like RxFTP, export
371 only "...LoadFuncs", which registers the functions within REXX only.
373 You cannot call 16-bit DLLs. The few interesting ones I found
374 (FTP,NETB,APPC) do not export their functions.
376 I do not know whether the REXX API is reentrant with respect to
377 exceptions (signals) when the REXX top-level exception handler is
378 overridden. So unless you know better than I do, do not access REXX
379 variables (probably tied to Perl variables) or call REXX functions
380 which access REXX queues or REXX variables in signal handlers.
382 See C<t/rx*.t> for examples.
386 Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
387 ilya@math.ohio-state.edu.