package OS2::DLL; use Carp; use DynaLoader; @ISA = qw(DynaLoader); sub AUTOLOAD { $AUTOLOAD =~ /^OS2::DLL::.+::(.+)$/ 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}': $^E"); goto &$AUTOLOAD; } @libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'}); %dlls = (); # 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::DLL []' 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; } $handle = DynaLoader::dl_load_file($file) unless $handle; return undef unless $handle; my $packs = $INC{'OS2/REXX.pm'} ? 'OS2::DLL OS2::REXX' : 'OS2::DLL'; eval < $handle, File => $file, Queue => 'SESSION' }, "OS2::DLL::$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::DLL::${file}::$_"; next if defined(&$name); my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_) || DynaLoader::dl_find_symbol($handle, $prefix.$_) or return 0; eval < module if you need the variable pool. =head1 SYNOPSIS use OS2::DLL; $emx_dll = OS2::DLL->load('emx'); $emx_version = $emx_dll->emx_revision(); =head1 DESCRIPTION =head2 Load REXX DLL $dll = load OS2::DLL NAME [, WHERE]; NAME is DLL name, without path and extension. Directories are searched WHERE first (list of dirs), then environment 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. Returns DLL object reference, or undef on failure. =head2 Check for functions (optional): BOOL = $dll->find(NAME [, NAME [, ...]]); Returns true if all functions are available. =head2 Call external REXX function: $dll->function(arguments); Returns the return string if the return code is 0, else undef. Dies with error message if the function is not available. =head1 ENVIRONMENT If C is set, emits debugging output. Looks for DLLs in C, C, C. =head1 AUTHOR Extracted by Ilya Zakharevich ilya@math.ohio-state.edu from L written by Andreas Kaiser ak@ananke.s.bawue.de. =cut