X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=os2%2FOS2%2FREXX%2FREXX.pm;h=57e6d6d1a43482dc991c66f728632671d299dc97;hb=2035c5e8eb03b194190a7ef87630a0e4cc7c6251;hp=5c6dfd226f05bec5918ddc907addf38365d03f05;hpb=ed344e4f516e393bcdfd181ec61ffbb056bebd56;p=p5sagit%2Fp5-mst-13.2.git diff --git a/os2/OS2/REXX/REXX.pm b/os2/OS2/REXX/REXX.pm index 5c6dfd2..57e6d6d 100644 --- a/os2/OS2/REXX/REXX.pm +++ b/os2/OS2/REXX/REXX.pm @@ -10,7 +10,9 @@ require OS2::DLL; # (move infrequently used names to @EXPORT_OK below) @EXPORT = qw(REXX_call REXX_eval REXX_eval_with); # Other items we are prepared to export if requested -@EXPORT_OK = qw(drop); +@EXPORT_OK = qw(drop register); + +$VERSION = '1.01'; # We cannot just put OS2::DLL in @ISA, since some scripts would use # function interface, not method interface... @@ -24,6 +26,8 @@ bootstrap OS2::REXX; # Preloaded methods go here. Autoload methods go after __END__, and are # processed by the autosplit program. +sub register {_register($_) for @_} + sub prefix { my $self = shift; @@ -259,12 +263,37 @@ One enables REXX runtime by bracketing your code by REXX_call \&subroutine_name; -Inside such a call one has access to REXX variables (see below), and to +Inside such a call one has access to REXX variables (see below). + +An alternative way to execute code inside a REXX compartment is REXX_eval EXPR; REXX_eval_with EXPR, subroutine_name_in_REXX => \&Perl_subroutine +Here C is a REXX code to run; to execute Perl code one needs to put +it inside Perl_subroutine(), and call this subroutine from REXX, as in + + REXX_eval_with < sub { 123 * shift }; + say foo(2) + EOE + +If one needs more Perl subroutines available, one can "import" them into +REXX from inside Perl_subroutine(); since REXX is not case-sensitive, +the names should be uppercased. + + use OS2::REXX 'register'; + + sub BAR { 123 + shift} + sub BAZ { 789 } + sub importer { register qw(BAR BAZ) } + + REXX_eval_with <<'EOE', importer => \&importer; + call importer + say bar(34) + say baz() + EOE + =head2 Bind scalar variable to REXX variable: tie $var, OS2::REXX, "NAME"; @@ -298,6 +327,73 @@ part of the key and it is subject to character set restrictions. OS2::REXX::dropall("STEM" [, "STEM" [, ...]]); +=head2 Make Perl functions available in REXX: + + OS2::REXX::register("NAME" [, "NAME" [, ...]]); + +Since REXX is not case-sensitive, the names should be uppercase. + +=head1 Subcommand handlers + +By default, the executed REXX code runs without any default subcommand +handler present. A subcommand handler named C is defined, but +not made a default. Use C
REXX command to make it a default +handler; alternatively, use C
to direct a command +to the handler you like. + +Experiments show that the handler C is also available; probably it is +provided by the REXX runtime. + +=head1 Interfacing from REXX to Perl + +This module provides an interface from Perl to REXX, and from REXX-inside-Perl +back to Perl. There is an alternative scenario which allows usage of Perl +from inside REXX. + +A DLL F provides an API to Perl as REXX functions + + PERL + PERLTERM + PERLINIT + PERLEXIT + PERLEVAL + PERLLASTERROR + PERLEXPORTALL + PERLDROPALL + PERLDROPALLEXIT + +A subcommand handler C can also be registered. Calling +the function PERLEXPORTALL() exports all these functions, as well as +exports this subcommand handler under the name C. PERLDROPALL() +inverts this action (and unloads PERLEXPORTALL() as well). In particular + + rc = RxFuncAdd("PerlExportAll", 'PerlRexx', "PERLEXPORTALL") + rc = PerlExportAll() + res = PERLEVAL(perlarg) + ADDRESS EVALPERL perlarg1 + rc = PerlDropAllExit() + +loads all the functions above, evals the Perl code in the REXX variable +C, putting the result into the REXX variable C, +then evals the Perl code in the REXX variable C, and, finally, +drops the loaded functions and the subcommand handler, deinitializes +the Perl interpreter, and exits the Perl's C runtime library. + +PERLEXIT() or PERLDROPALLEXIT() should be called as the last command of +the REXX program. (This is considered as a bug.) Their purpose is to flush +all the output buffers of the Perl's C runtime library. + +C gives the reason for the failure of the last PERLEVAL(). +It is useful inside C handler. PERLINIT() and PERLTERM() +initialize and deinitialize the Perl interpreter. + +C initializes the Perl interpreter (if needed), and +evaluates C as Perl code. The result is returned to REXX stringified, +undefined result is considered as failure. + +C does the same as C wrapped by calls to +PERLINIT() and PERLEXIT(). + =head1 NOTES Note that while function and variable names are case insensitive in the @@ -333,7 +429,48 @@ overridden. So unless you know better than I do, do not access REXX variables (probably tied to Perl variables) or call REXX functions which access REXX queues or REXX variables in signal handlers. -See C for examples. +See C and the next section for examples. + +=head1 EXAMPLE + + use OS2::REXX; + + sub Ender::DESTROY { $vrexx->VExit; print "Exiting...\n" } + + $vrexx = OS2::REXX->load('VREXX'); + REXX_call { # VOpenWindow takes a stem + local $SIG{TERM} = sub {die}; # enable Ender::DESTROY + local $SIG{INT} = sub {die}; # enable Ender::DESTROY + + $code = $vrexx->VInit; + print "Init code = `$code'\n"; + die "error initializing VREXX" if $code eq 'ERROR'; + + my $ender = bless [], 'Ender'; # Call Ender::DESTROY on exit + + print "VREXX Version ", $vrexx->VGetVersion, "\n"; + + tie %pos, 'OS2::REXX', 'POS.' or die; + %pos = ( LEFT => 0, RIGHT => 7, TOP => 5, BOTTOM => 0 ); + + $id = $vrexx->VOpenWindow('To disconnect:', 'WHITE', 'POS'); + $vrexx->VForeColor($id, 'BLACK'); + $vrexx->VSetFont($id, 'TIME', '30'); + $tlim = time + 60; + while ( ($r = $tlim - time) >= 0 ) { + $vrexx->VClearWindow($id); + $vrexx->VSay($id, 100, 50, (sprintf "%02i:%02i", int($r/60), $r % 60)); + sleep 1; + } + print "Close code = `$res'\n" if $res = $vrexx->VCloseWindow($id); + }; + + + +=head1 ENVIRONMENT + +If C is set, prints trace info on calls to REXX runtime +environment. =head1 AUTHOR