Commit | Line | Data |
ed344e4f |
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 |