os2/OS2/REXX/DLL/DLL.pm

   1 package OS2::DLL;
   2
   3 use Carp;
   4 use DynaLoader;
   5
   6 @ISA = qw(DynaLoader);
   7
   8 sub AUTOLOAD {
   9     $AUTOLOAD =~ /^OS2::DLL::.+::(.+)$/
  10       or confess("Undefined subroutine &$AUTOLOAD called");
  11     return undef if $1 eq "DESTROY";
  12     $_[0]->find($1)
  13       or confess("Can't find entry '$1' to DLL '$_[0]->{File}': $^E");
  14     goto &$AUTOLOAD;
  15 }
  16
  17 @libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'});
  18 %dlls = ();
  19
  20 # Preloaded methods go here.  Autoload methods go after __END__, and are
  21 # processed by the autosplit program.
  22
  23 # Cannot autoload, the autoloader is used for the REXX functions.
  24
  25 sub load
  26 {
  27         confess 'Usage: load OS2::DLL <file> [<dirs>]' unless $#_ >= 1;
  28         my ($class, $file, @where) = (@_, @libs);
  29         return $dlls{$file} if $dlls{$file};
  30         my $handle;
  31         foreach (@where) {
  32                 $handle = DynaLoader::dl_load_file("$_/$file.dll");
  33                 last if $handle;
  34         }
  35         $handle = DynaLoader::dl_load_file($file) unless $handle;
  36         return undef unless $handle;
  37         my $packs = $INC{'OS2/REXX.pm'} ? 'OS2::DLL OS2::REXX' : 'OS2::DLL';
  38         eval <<EOE or die "eval package $@";
  39 package OS2::DLL::$file; \@ISA = qw($packs);
  40 sub AUTOLOAD {
  41   \$OS2::DLL::AUTOLOAD = \$AUTOLOAD;
  42   goto &OS2::DLL::AUTOLOAD;
  43 }
  44 1;
  45 EOE
  46         return $dlls{$file} =
  47           bless {Handle => $handle, File => $file, Queue => 'SESSION' },
  48                 "OS2::DLL::$file";
  49 }
  50
  51 sub find
  52 {
  53         my $self   = shift;
  54         my $file   = $self->{File};
  55         my $handle = $self->{Handle};
  56         my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : "";
  57         my $queue  = $self->{Queue};
  58         foreach (@_) {
  59                 my $name = "OS2::DLL::${file}::$_";
  60                 next if defined(&$name);
  61                 my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_)
  62                         || DynaLoader::dl_find_symbol($handle, $prefix.$_)
  63                         or return 0;
  64                 eval <<EOE or die "eval sub";
  65 package OS2::DLL::$file;
  66 sub $_ {
  67   shift;
  68   OS2::DLL::_call('$_', $addr, '$queue', \@_);
  69 }
  70 1;
  71 EOE
  72         }
  73         return 1;
  74 }
  75
  76 bootstrap OS2::DLL;
  77
  78 1;
  79 __END__
  80
  81 =head1 NAME
  82
  83 OS2::DLL - access to DLLs with REXX calling convention.
  84
  85 =head2 NOTE
  86
  87 When you use this module, the REXX variable pool is not available.
  88
  89 See documentation of L<OS2::REXX> module if you need the variable pool.
  90
  91 =head1 SYNOPSIS
  92
  93         use OS2::DLL;
  94         $emx_dll = OS2::DLL->load('emx');
  95         $emx_version = $emx_dll->emx_revision();
  96
  97 =head1 DESCRIPTION
  98
  99 =head2 Load REXX DLL
 100
 101         $dll = load OS2::DLL NAME [, WHERE];
 102
 103 NAME is DLL name, without path and extension.
 104
 105 Directories are searched WHERE first (list of dirs), then environment
 106 paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search
 107 is performed in default DLL path (without adding paths and extensions).
 108
 109 The DLL is not unloaded when the variable dies.
 110
 111 Returns DLL object reference, or undef on failure.
 112
 113 =head2 Check for functions (optional):
 114
 115         BOOL = $dll->find(NAME [, NAME [, ...]]);
 116
 117 Returns true if all functions are available.
 118
 119 =head2 Call external REXX function:
 120
 121         $dll->function(arguments);
 122
 123 Returns the return string if the return code is 0, else undef.
 124 Dies with error message if the function is not available.
 125
 126 =head1 ENVIRONMENT
 127
 128 If C<PERL_REXX_DEBUG> is set, emits debugging output.  Looks for DLLs
 129 in C<PERL5REXX>, C<PERLREXX>, C<PATH>.
 130
 131 =head1 AUTHOR
 132
 133 Extracted by Ilya Zakharevich ilya@math.ohio-state.edu from L<OS2::REXX>
 134 written by Andreas Kaiser ak@ananke.s.bawue.de.
 135
 136 =cut