home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / os2 / OS2 / REXX / DLL / DLL.pm next >
Encoding:
Perl POD Document  |  1999-10-23  |  3.2 KB  |  137 lines
  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
  137.