use Carp;
require Exporter;
require DynaLoader;
+require OS2::DLL;
+
@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
# Other items we are prepared to export if requested
@EXPORT_OK = qw(drop);
-sub AUTOLOAD {
- $AUTOLOAD =~ /^OS2::REXX::.+::(.+)$/
- or confess("Undefined subroutine &$AUTOLOAD called");
- return undef if $1 eq "DESTROY";
- $_[0]->find($1)
- or confess("Can't find entry '$1' to DLL '$_[0]->{File}'");
- goto &$AUTOLOAD;
-}
+# We cannot just put OS2::DLL in @ISA, since some scripts would use
+# function interface, not method interface...
-@libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'});
-%dlls = ();
+*_call = \&OS2::DLL::_call;
+*load = \&OS2::DLL::load;
+*find = \&OS2::DLL::find;
bootstrap OS2::REXX;
# Preloaded methods go here. Autoload methods go after __END__, and are
# processed by the autosplit program.
-# Cannot autoload, the autoloader is used for the REXX functions.
-
-sub load
-{
- confess 'Usage: load OS2::REXX <file> [<dirs>]' unless $#_ >= 1;
- my ($class, $file, @where) = (@_, @libs);
- return $dlls{$file} if $dlls{$file};
- my $handle;
- foreach (@where) {
- $handle = DynaLoader::dl_load_file("$_/$file.dll");
- last if $handle;
- }
- return undef unless $handle;
- eval "package OS2::REXX::$file; \@ISA = ('OS2::REXX');"
- . "sub AUTOLOAD {"
- . " \$OS2::REXX::AUTOLOAD = \$AUTOLOAD;"
- . " goto &OS2::REXX::AUTOLOAD;"
- . "} 1;" or die "eval package $@";
- return $dlls{$file} = bless {Handle => $handle, File => $file, Queue => 'SESSION' }, "OS2::REXX::$file";
-}
-
-sub find
-{
- my $self = shift;
- my $file = $self->{File};
- my $handle = $self->{Handle};
- my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : "";
- my $queue = $self->{Queue};
- foreach (@_) {
- my $name = "OS2::REXX::${file}::$_";
- next if defined(&$name);
- my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_)
- || DynaLoader::dl_find_symbol($handle, $prefix.$_)
- or return 0;
- eval "package OS2::REXX::$file; sub $_".
- "{ shift; OS2::REXX::_call('$_', $addr, '$queue', \@_); }".
- "1;"
- or die "eval sub";
- }
- return 1;
-}
-
sub prefix
{
my $self = shift;
sub TIESCALAR
{
my ($obj, $name) = @_;
- $name =~ s/^[\w!?]+/\U$&\E/;
+ $name =~ s/^([\w!?]+)/\U$1\E/;
return bless \$name, OS2::REXX::_SCALAR;
}
sub TIEARRAY
{
my ($obj, $name) = @_;
- $name =~ s/^[\w!?]+/\U$&\E/;
+ $name =~ s/^([\w!?]+)/\U$1\E/;
return bless [$name, 0], OS2::REXX::_ARRAY;
}
sub TIEHASH
{
my ($obj, $name) = @_;
- $name =~ s/^[\w!?]+/\U$&\E/;
+ $name =~ s/^([\w!?]+)/\U$1\E/;
return bless {Stem => $name}, OS2::REXX::_HASH;
}
NAME is DLL name, without path and extension.
Directories are searched WHERE first (list of dirs), then environment
-paths PERL5REXX, PERLREXX or, as last resort, PATH.
+paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search
+is performed in default DLL path (without adding paths and extensions).
The DLL is not unloaded when the variable dies.
Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
ilya@math.ohio-state.edu.
+=head1 SEE ALSO
+
+L<OS2::DLL>.
+
=cut