1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
package OS2::DLL;
our $VERSION = '1.00';
use Carp;
use XSLoader;
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 new {
confess 'Usage: OS2::DLL->new( <file> [<dirs>] )' unless @_ >= 2;
my ($class, $file) = (shift, shift);
my $handle;
$handle = $class->load($file, @_) and return $handle;
my $path = @_ ? " from '@_'" : '';
my $err = DynaLoader::dl_error();
$err =~ s/\s+at\s+\S+\s+line\s+\S+\s*\z//;
croak "Can't load '$file'$path: $err";
}
sub load
{
confess 'Usage: load OS2::DLL <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;
}
$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 <<EOE or die "eval package $@";
package OS2::DLL::$file; \@ISA = qw($packs);
sub AUTOLOAD {
\$OS2::DLL::AUTOLOAD = \$AUTOLOAD;
goto &OS2::DLL::AUTOLOAD;
}
1;
EOE
return $dlls{$file} =
bless {Handle => $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 <<EOE or die "eval sub";
package OS2::DLL::$file;
sub $_ {
shift;
OS2::DLL::_call('$_', $addr, '$queue', \@_);
}
1;
EOE
}
return 1;
}
XSLoader::load 'OS2::DLL';
1;
__END__
=head1 NAME
OS2::DLL - access to DLLs with REXX calling convention.
=head2 NOTE
When you use this module, the REXX variable pool is not available.
See documentation of L<OS2::REXX> 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 (in this case one can
get the reason via C<DynaLoader::dl_error()>).
=head2 Create a REXX DLL handle
$dll = OS2::DLL->new( NAME [, WHERE] );
Same as L<C<load>|Load REXX DLL>, but croaks with a meaningful message 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<PERL_REXX_DEBUG> is set, emits debugging output. Looks for DLLs
in C<PERL5REXX>, C<PERLREXX>, C<PATH>.
=head1 AUTHOR
Extracted by Ilya Zakharevich ilya@math.ohio-state.edu from L<OS2::REXX>
written by Andreas Kaiser ak@ananke.s.bawue.de.
=cut
|
