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 return undef unless $handle;
43 eval "package OS2::REXX::$file; \@ISA = ('OS2::REXX');"
45 . " \$OS2::REXX::AUTOLOAD = \$AUTOLOAD;"
46 . " goto &OS2::REXX::AUTOLOAD;"
47 . "} 1;" or die "eval package $@";
48 return $dlls{$file} = bless {Handle => $handle, File => $file, Queue => 'SESSION' }, "OS2::REXX::$file";
54 my $file = $self->{File};
55 my $handle = $self->{Handle};
56 my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : "";
57 my $queue = $self->{Queue};
59 my $name = "OS2::REXX::${file}::$_";
60 next if defined(&$name);
61 my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_)
62 || DynaLoader::dl_find_symbol($handle, $prefix.$_)
64 eval "package OS2::REXX::$file; sub $_".
65 "{ shift; OS2::REXX::_call('$_', $addr, '$queue', \@_); }".
75 $self->{Prefix} = shift;
81 $self->{Queue} = shift;
85 { # Supposedly should drop anything with
86 # the given prefix. Unfortunately a
87 # loop is needed after fixpack17.
88 &OS2::REXX::_drop(@_);
92 { # Supposedly should drop anything with
93 # the given prefix. Unfortunately a
94 # loop is needed after fixpack17.
95 &OS2::REXX::_drop(@_); # Try to drop them all.
99 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
100 while (($name) = OS2::REXX::_next($_)) {
101 OS2::REXX::_drop($_ . $name);
109 my ($obj, $name) = @_;
110 $name =~ s/^[\w!?]+/\U$&\E/;
111 return bless \$name, OS2::REXX::_SCALAR;
116 my ($obj, $name) = @_;
117 $name =~ s/^[\w!?]+/\U$&\E/;
118 return bless [$name, 0], OS2::REXX::_ARRAY;
123 my ($obj, $name) = @_;
124 $name =~ s/^[\w!?]+/\U$&\E/;
125 return bless {Stem => $name}, OS2::REXX::_HASH;
128 #############################################################################
129 package OS2::REXX::_SCALAR;
133 return OS2::REXX::_fetch(${$_[0]});
138 return OS2::REXX::_set(${$_[0]}, $_[1]);
143 return OS2::REXX::_drop(${$_[0]});
146 #############################################################################
147 package OS2::REXX::_ARRAY;
151 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
152 return OS2::REXX::_fetch($_[0]->[0].'.'.(0+$_[1]));
157 $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
158 return OS2::REXX::_set($_[0]->[0].'.'.(0+$_[1]), $_[2]);
161 #############################################################################
162 package OS2::REXX::_HASH;
165 @ISA = ('Tie::Hash');
170 my $stem = $self->{Stem};
172 delete $self->{List} if exists $self->{List};
176 OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
177 while (($name) = OS2::REXX::_next($stem)) {
182 $self->{List} = \@list;
188 return pop @{$_[0]->{List}};
193 return defined OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
198 return OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
203 return OS2::REXX::_set($_[0]->{Stem}.$_[1], $_[2]);
208 OS2::REXX::_drop($_[0]->{Stem}.$_[1]);
211 #############################################################################
219 OS2::REXX - access to DLLs with REXX calling convention and REXX runtime.
223 By default, the REXX variable pool is not available, neither
224 to Perl, nor to external REXX functions. To enable it, you need to put
225 your code inside C<REXX_call> function. REXX functions which do not use
226 variables may be usable even without C<REXX_call> though.
231 $ydb = load OS2::REXX "ydbautil" or die "Cannot load: $!";
232 @pid = $ydb->RxProcId();
234 tie $s, OS2::REXX, "TEST";
242 $dll = load OS2::REXX NAME [, WHERE];
244 NAME is DLL name, without path and extension.
246 Directories are searched WHERE first (list of dirs), then environment
247 paths PERL5REXX, PERLREXX or, as last resort, PATH.
249 The DLL is not unloaded when the variable dies.
251 Returns DLL object reference, or undef on failure.
253 =head2 Define function prefix:
257 Define the prefix of external functions, prepended to the function
258 names used within your program, when looking for the entries in the
263 $dll = load OS2::REXX "RexxBase";
264 $dll->prefix("RexxBase_");
269 $dll = load OS2::REXX "RexxBase";
270 $dll->RexxBase_Init();
276 Define the name of the REXX queue passed to all external
277 functions of this module. Defaults to "SESSION".
279 Check for functions (optional):
281 BOOL = $dll->find(NAME [, NAME [, ...]]);
283 Returns true if all functions are available.
285 =head2 Call external REXX function:
287 $dll->function(arguments);
289 Returns the return string if the return code is 0, else undef.
290 Dies with error message if the function is not available.
292 =head1 Accessing REXX-runtime
294 While calling functions with REXX signature does not require the presence
295 of the system REXX DLL, there are some actions which require REXX-runtime
296 present. Among them is the access to REXX variables by name.
298 One enables REXX runtime by bracketing your code by
302 (trailing semicolon required!) or
304 REXX_call \&subroutine_name;
306 Inside such a call one has access to REXX variables (see below), and to
310 subroutine_name_in_REXX => \&Perl_subroutine
312 =head2 Bind scalar variable to REXX variable:
314 tie $var, OS2::REXX, "NAME";
316 =head2 Bind array variable to REXX stem variable:
318 tie @var, OS2::REXX, "NAME.";
320 Only scalar operations work so far. No array assignments, no array
321 operations, ... FORGET IT.
323 =head2 Bind hash array variable to REXX stem variable:
325 tie %var, OS2::REXX, "NAME.";
327 To access all visible REXX variables via hash array, bind to "";
329 No array assignments. No array operations, other than hash array
330 operations. Just like the *dbm based implementations.
332 For the usual REXX stem variables, append a "." to the name,
333 as shown above. If the hash key is part of the stem name, for
334 example if you bind to "", you cannot use lower case in the stem
335 part of the key and it is subject to character set restrictions.
337 =head2 Erase individual REXX variables (bound or not):
339 OS2::REXX::drop("NAME" [, "NAME" [, ...]]);
341 =head2 Erase REXX variables with given stem (bound or not):
343 OS2::REXX::dropall("STEM" [, "STEM" [, ...]]);
347 Note that while function and variable names are case insensitive in the
348 REXX language, function names exported by a DLL and the REXX variables
349 (as seen by Perl through the chosen API) are all case sensitive!
351 Most REXX DLLs export function names all upper case, but there are a
352 few which export mixed case names (such as RxExtras). When trying to
353 find the entry point, both exact case and all upper case are searched.
354 If the DLL exports "RxNap", you have to specify the exact case, if it
355 exports "RXOPEN", you can use any case.
357 To avoid interfering with subroutine names defined by Perl (DESTROY)
358 or used within the REXX module (prefix, find), it is best to use mixed
359 case and to avoid lowercase only or uppercase only names when calling
360 REXX functions. Be consistent. The same function written in different
361 ways results in different Perl stubs.
363 There is no REXX interpolation on variable names, so the REXX variable
364 name TEST.ONE is not affected by some other REXX variable ONE. And it
365 is not the same variable as TEST.one!
367 You cannot call REXX functions which are not exported by the DLL.
368 While most DLLs export all their functions, some, like RxFTP, export
369 only "...LoadFuncs", which registers the functions within REXX only.
371 You cannot call 16-bit DLLs. The few interesting ones I found
372 (FTP,NETB,APPC) do not export their functions.
374 I do not know whether the REXX API is reentrant with respect to
375 exceptions (signals) when the REXX top-level exception handler is
376 overridden. So unless you know better than I do, do not access REXX
377 variables (probably tied to Perl variables) or call REXX functions
378 which access REXX queues or REXX variables in signal handlers.
380 See C<t/rx*.t> for examples.
384 Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
385 ilya@math.ohio-state.edu.