perl 5.0 alpha 6

[editor's note: cleaned up from the September '94 InfoMagic CD, just
like the last commit]

1 files changed, 46 insertions, 0 deletions

diff --git a/lib/Exporter.pm b/lib/Exporter.pm
new file mode 100644
index 0000000000..0b021b3d71
--- /dev/null
+++ b/lib/Exporter.pm
@@ -0,0 +1,46 @@
+package Exporter;
+
+require 5.000;
+
+sub import {
+    my ($callpack, $callfile, $callline) = caller($ExportLevel);
+    my $pack = 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 $sym (@imports) {
+	    if (!$exports{$sym}) {
+		if ($sym !~ s/^&// || !$exports{$sym}) {
+		    warn "$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";
+    }
+};
+
+1;