os2/OS2/REXX/REXX.pm

   1 package OS2::REXX;
   2
   3 use Carp;
   4 require Exporter;
   5 require DynaLoader;
   6 require OS2::DLL;
   7
   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);
  14
  15 # We cannot just put OS2::DLL in @ISA, since some scripts would use
  16 # function interface, not method interface...
  17
  18 *_call = \&OS2::DLL::_call;
  19 *load = \&OS2::DLL::load;
  20 *find = \&OS2::DLL::find;
  21
  22 bootstrap OS2::REXX;
  23
  24 # Preloaded methods go here.  Autoload methods go after __END__, and are
  25 # processed by the autosplit program.
  26
  27 sub prefix
  28 {
  29         my $self = shift;
  30         $self->{Prefix} = shift;
  31 }
  32
  33 sub queue
  34 {
  35         my $self = shift;
  36         $self->{Queue} = shift;
  37 }
  38
  39 sub drop
  40 {                               # Supposedly should drop anything with
  41                                 # the given prefix. Unfortunately a
  42                                 # loop is needed after fixpack17.
  43 &OS2::REXX::_drop(@_);
  44 }
  45
  46 sub dropall
  47 {                               # Supposedly should drop anything with
  48                                 # the given prefix. Unfortunately a
  49                                 # loop is needed after fixpack17.
  50   &OS2::REXX::_drop(@_);        # Try to drop them all.
  51   my $name;
  52   for (@_) {
  53     if (/\.$/) {
  54       OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
  55       while (($name) = OS2::REXX::_next($_)) {
  56         OS2::REXX::_drop($_ . $name);
  57       }
  58     }
  59   }
  60 }
  61
  62 sub TIESCALAR
  63 {
  64         my ($obj, $name) = @_;
  65         $name =~ s/^([\w!?]+)/\U$1\E/;
  66         return bless \$name, OS2::REXX::_SCALAR;
  67 }
  68
  69 sub TIEARRAY
  70 {
  71         my ($obj, $name) = @_;
  72         $name =~ s/^([\w!?]+)/\U$1\E/;
  73         return bless [$name, 0], OS2::REXX::_ARRAY;
  74 }
  75
  76 sub TIEHASH
  77 {
  78         my ($obj, $name) = @_;
  79         $name =~ s/^([\w!?]+)/\U$1\E/;
  80         return bless {Stem => $name}, OS2::REXX::_HASH;
  81 }
  82
  83 #############################################################################
  84 package OS2::REXX::_SCALAR;
  85
  86 sub FETCH
  87 {
  88         return OS2::REXX::_fetch(${$_[0]});
  89 }
  90
  91 sub STORE
  92 {
  93         return OS2::REXX::_set(${$_[0]}, $_[1]);
  94 }
  95
  96 sub DESTROY
  97 {
  98         return OS2::REXX::_drop(${$_[0]});
  99 }
 100
 101 #############################################################################
 102 package OS2::REXX::_ARRAY;
 103
 104 sub FETCH
 105 {
 106         $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
 107         return OS2::REXX::_fetch($_[0]->[0].'.'.(0+$_[1]));
 108 }
 109
 110 sub STORE
 111 {
 112         $_[0]->[1] = $_[1] if $_[1] > $_[0]->[1];
 113         return OS2::REXX::_set($_[0]->[0].'.'.(0+$_[1]), $_[2]);
 114 }
 115
 116 #############################################################################
 117 package OS2::REXX::_HASH;
 118
 119 require Tie::Hash;
 120 @ISA = ('Tie::Hash');
 121
 122 sub FIRSTKEY
 123 {
 124         my ($self) = @_;
 125         my $stem = $self->{Stem};
 126
 127         delete $self->{List} if exists $self->{List};
 128
 129         my @list = ();
 130         my ($name, $value);
 131         OS2::REXX::_fetch('DUMMY'); # reset REXX's first/next iterator
 132         while (($name) = OS2::REXX::_next($stem)) {
 133                 push @list, $name;
 134         }
 135         my $key = pop @list;
 136
 137         $self->{List} = \@list;
 138         return $key;
 139 }
 140
 141 sub NEXTKEY
 142 {
 143         return pop @{$_[0]->{List}};
 144 }
 145
 146 sub EXISTS
 147 {
 148         return defined OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
 149 }
 150
 151 sub FETCH
 152 {
 153         return OS2::REXX::_fetch($_[0]->{Stem}.$_[1]);
 154 }
 155
 156 sub STORE
 157 {
 158         return OS2::REXX::_set($_[0]->{Stem}.$_[1], $_[2]);
 159 }
 160
 161 sub DELETE
 162 {
 163         OS2::REXX::_drop($_[0]->{Stem}.$_[1]);
 164 }
 165
 166 #############################################################################
 167 package OS2::REXX;
 168
 169 1;
 170 __END__
 171
 172 =head1 NAME
 173
 174 OS2::REXX - access to DLLs with REXX calling convention and REXX runtime.
 175
 176 =head2 NOTE
 177
 178 By default, the REXX variable pool is not available, neither
 179 to Perl, nor to external REXX functions. To enable it, you need to put
 180 your code inside C<REXX_call> function.  REXX functions which do not use
 181 variables may be usable even without C<REXX_call> though.
 182
 183 =head1 SYNOPSIS
 184
 185         use OS2::REXX;
 186         $ydb = load OS2::REXX "ydbautil" or die "Cannot load: $!";
 187         @pid = $ydb->RxProcId();
 188         REXX_call {
 189           tie $s, OS2::REXX, "TEST";
 190           $s = 1;
 191         };
 192
 193 =head1 DESCRIPTION
 194
 195 =head2 Load REXX DLL
 196
 197         $dll = load OS2::REXX NAME [, WHERE];
 198
 199 NAME is DLL name, without path and extension.
 200
 201 Directories are searched WHERE first (list of dirs), then environment
 202 paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search
 203 is performed in default DLL path (without adding paths and extensions).
 204
 205 The DLL is not unloaded when the variable dies.
 206
 207 Returns DLL object reference, or undef on failure.
 208
 209 =head2 Define function prefix:
 210
 211         $dll->prefix(NAME);
 212
 213 Define the prefix of external functions, prepended to the function
 214 names used within your program, when looking for the entries in the
 215 DLL.
 216
 217 =head2 Example
 218
 219                 $dll = load OS2::REXX "RexxBase";
 220                 $dll->prefix("RexxBase_");
 221                 $dll->Init();
 222
 223 is the same as
 224
 225                 $dll = load OS2::REXX "RexxBase";
 226                 $dll->RexxBase_Init();
 227
 228 =head2 Define queue:
 229
 230         $dll->queue(NAME);
 231
 232 Define the name of the REXX queue passed to all external
 233 functions of this module. Defaults to "SESSION".
 234
 235 Check for functions (optional):
 236
 237         BOOL = $dll->find(NAME [, NAME [, ...]]);
 238
 239 Returns true if all functions are available.
 240
 241 =head2 Call external REXX function:
 242
 243         $dll->function(arguments);
 244
 245 Returns the return string if the return code is 0, else undef.
 246 Dies with error message if the function is not available.
 247
 248 =head1 Accessing REXX-runtime
 249
 250 While calling functions with REXX signature does not require the presence
 251 of the system REXX DLL, there are some actions which require REXX-runtime
 252 present. Among them is the access to REXX variables by name.
 253
 254 One enables REXX runtime by bracketing your code by
 255
 256         REXX_call BLOCK;
 257
 258 (trailing semicolon required!) or
 259
 260         REXX_call \&subroutine_name;
 261
 262 Inside such a call one has access to REXX variables (see below), and to
 263
 264         REXX_eval EXPR;
 265         REXX_eval_with EXPR,
 266                 subroutine_name_in_REXX => \&Perl_subroutine
 267
 268 =head2 Bind scalar variable to REXX variable:
 269
 270         tie $var, OS2::REXX, "NAME";
 271
 272 =head2 Bind array variable to REXX stem variable:
 273
 274         tie @var, OS2::REXX, "NAME.";
 275
 276 Only scalar operations work so far. No array assignments, no array
 277 operations, ... FORGET IT.
 278
 279 =head2 Bind hash array variable to REXX stem variable:
 280
 281         tie %var, OS2::REXX, "NAME.";
 282
 283 To access all visible REXX variables via hash array, bind to "";
 284
 285 No array assignments. No array operations, other than hash array
 286 operations. Just like the *dbm based implementations.
 287
 288 For the usual REXX stem variables, append a "." to the name,
 289 as shown above. If the hash key is part of the stem name, for
 290 example if you bind to "", you cannot use lower case in the stem
 291 part of the key and it is subject to character set restrictions.
 292
 293 =head2 Erase individual REXX variables (bound or not):
 294
 295         OS2::REXX::drop("NAME" [, "NAME" [, ...]]);
 296
 297 =head2 Erase REXX variables with given stem (bound or not):
 298
 299         OS2::REXX::dropall("STEM" [, "STEM" [, ...]]);
 300
 301 =head1 NOTES
 302
 303 Note that while function and variable names are case insensitive in the
 304 REXX language, function names exported by a DLL and the REXX variables
 305 (as seen by Perl through the chosen API) are all case sensitive!
 306
 307 Most REXX DLLs export function names all upper case, but there are a
 308 few which export mixed case names (such as RxExtras). When trying to
 309 find the entry point, both exact case and all upper case are searched.
 310 If the DLL exports "RxNap", you have to specify the exact case, if it
 311 exports "RXOPEN", you can use any case.
 312
 313 To avoid interfering with subroutine names defined by Perl (DESTROY)
 314 or used within the REXX module (prefix, find), it is best to use mixed
 315 case and to avoid lowercase only or uppercase only names when calling
 316 REXX functions. Be consistent. The same function written in different
 317 ways results in different Perl stubs.
 318
 319 There is no REXX interpolation on variable names, so the REXX variable
 320 name TEST.ONE is not affected by some other REXX variable ONE. And it
 321 is not the same variable as TEST.one!
 322
 323 You cannot call REXX functions which are not exported by the DLL.
 324 While most DLLs export all their functions, some, like RxFTP, export
 325 only "...LoadFuncs", which registers the functions within REXX only.
 326
 327 You cannot call 16-bit DLLs. The few interesting ones I found
 328 (FTP,NETB,APPC) do not export their functions.
 329
 330 I do not know whether the REXX API is reentrant with respect to
 331 exceptions (signals) when the REXX top-level exception handler is
 332 overridden. So unless you know better than I do, do not access REXX
 333 variables (probably tied to Perl variables) or call REXX functions
 334 which access REXX queues or REXX variables in signal handlers.
 335
 336 See C<t/rx*.t> for examples.
 337
 338 =head1 AUTHOR
 339
 340 Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
 341 ilya@math.ohio-state.edu.
 342
 343 =head1 SEE ALSO
 344
 345 L<OS2::DLL>.
 346
 347 =cut