blob: dce6909b187b1f052f217693ccae9a15a72c09b6 (
plain)
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
|
package Exporter;
require 5.000;
$ExportLevel = 0;
sub export {
my $pack = shift;
my $callpack = shift;
my @imports = @_;
*exports = \@{"${pack}::EXPORT"};
if (@imports) {
my $oops;
my $type;
*exports = \%{"${pack}::EXPORT"};
if (!%exports) {
grep(s/^&//, @exports);
@exports{@exports} = (1) x @exports;
foreach $extra (@{"${pack}::EXPORT_OK"}) {
$exports{$extra} = 1;
}
}
foreach $sym (@imports) {
if (!$exports{$sym}) {
if ($sym !~ s/^&// || !$exports{$sym}) {
warn qq["$sym" is not exported by the $pack module ],
"at $callfile line $callline\n";
$oops++;
next;
}
}
}
die "Can't continue with import errors.\n" if $oops;
}
else {
@imports = @exports;
}
foreach $sym (@imports) {
$type = '&';
$type = $1 if $sym =~ s/^(\W)//;
*{"${callpack}::$sym"} =
$type eq '&' ? \&{"${pack}::$sym"} :
$type eq '$' ? \${"${pack}::$sym"} :
$type eq '@' ? \@{"${pack}::$sym"} :
$type eq '%' ? \%{"${pack}::$sym"} :
$type eq '*' ? *{"${pack}::$sym"} :
warn "Can't export symbol: $type$sym\n";
}
};
sub import {
local ($callpack, $callfile, $callline) = caller($ExportLevel);
my $pack = shift;
export $pack, $callpack, @_;
}
1;
|
