Perl6::Export - Implements the Perl 6 'is export(...)' trait


Perl6-Export documentation Contained in the Perl6-Export distribution.

Index


Code Index:

NAME

Top

Perl6::Export - Implements the Perl 6 'is export(...)' trait

SYNOPSIS

Top

	# Perl 5 code...

	package Some::Module;
    use Perl6::Export;

	# Export &foo by default, when explicitly requested,
	# or when the ':ALL' export set is requested...

	sub foo is export(:DEFAULT) {
		print "phooo!";
	}




	# Export &var by default, when explicitly requested,
	# or when the ':bees', ':pubs', or ':ALL' export set is requested...
	# the parens after 'is export' are like the parens of a qw(...)

	sub bar is export(:DEFAULT :bees :pubs) {
		print "baaa!";
	}




	# Export &baz when explicitly requested
	# or when the ':bees' or ':ALL' export set is requested...

	sub baz is export(:bees) {
		print "baassss!";
	}




	# Always export &qux 
	# (no matter what else is explicitly or implicitly requested)

	sub qux is export(:MANDATORY) {
		print "quuuuuuuuux!";
	}




	sub import {
		# This subroutine is called when the module is used (as usual),
		# but it is called after any export requests have been handled.
		# Those requests will have been stripped from its argument list
	}




DESCRIPTION

Top

Implements what I hope the Perl 6 symbol export mechanism might look like.

It's very straightforward:

That's it.

WARNING

Top

The syntax and semantics of Perl 6 is still being finalized and consequently is at any time subject to change. That means the same caveat applies to this module.

DEPENDENCIES

Top

Requires Filter::Simple

AUTHOR

Top

Damian Conway (damian@conway.org)

BUGS AND IRRITATIONS

Top

Does not yet handle the export of variables.

Comments, suggestions, and patches welcome.

COPYRIGHT

Top


Perl6-Export documentation Contained in the Perl6-Export distribution.

package Perl6::Export;
our $VERSION = '0.07';

my $ident   = qr{ [^\W\d] \w* }x;
my $arg     = qr{ : $ident \s* ,? \s* }x;
my $args    = qr{ \s* \( $arg* \) | (?# NOTHING) }x;
my $defargs = qr{ \s* \( $arg* :DEFAULT $arg* \) }x;
my $proto   = qr{ \s* (?: \( [^)]* \) | (?# NOTHING) ) }x;

sub add_to {
	my ($EXPORT, $symbol, $args, $decl) = @_;
	$args = "()" unless $args =~ /\S/;
	$args =~ tr/://d;
	return qq[BEGIN{no strict 'refs';]
	     . qq[push\@$EXPORT,'$symbol';\$EXPORT{'$symbol'}=1;]
	     . qq[push\@{\$EXPORT_TAGS\{\$_}},'$symbol' for ('ALL',qw$args)}$decl];
}

sub false_import_sub {
	my $import_sub = q{
				use base 'Exporter';
				sub import {
						my @exports;
						for (my $i=1; $i<@_; $i++) {
								for ($_[$i]) {
										if (!ref && /^[:\$&%\@]?(\w+)$/ && 
												( exists $EXPORT{$1} || exists $EXPORT_TAGS{$1}) ) {
												push @exports, splice @_, $i, 1;
												$i--;
										}
								}
						}
						@exports = ":DEFAULT" unless @exports;
						__PACKAGE__->export_to_level(1, $_[0], ':MANDATORY', @exports);	
						goto &REAL_IMPORT;
				}
		};
	$import_sub =~ s/\n/ /g;
	$import_sub =~ s/REAL_IMPORT/$_[0]/g;
	return $import_sub;
}

my $MANDATORY = q[BEGIN{$EXPORT_TAGS{MANDATORY}||=[]}];

use Filter::Simple;
use Digest::MD5 'md5_hex';

FILTER {
	return unless /\S/;
	my $real_import_name = '_import_'.md5_hex($_);
	my $false_import_sub = false_import_sub($real_import_name);
	my $real_import_sub = "";
	s/ \b sub \s+ import \s* ([({]) /sub $real_import_name$1/x 
		 or $real_import_sub = "sub $real_import_name {}";
	s{( \b sub \s+ ($ident) $proto) \s+ is \s+ export ($defargs) }
	 	 { add_to('EXPORT',$2,$3,$1) }gex;
	s{( \b our \s+ ([\$\@\%]$ident) $proto) \s+ is \s+ exported ($defargs) }
	 	 { add_to('EXPORT',$2,$3,$1) }gex;
	s{( \b sub \s+ ($ident) $proto ) \s+ is \s+ export ($args) }
	 	 { add_to('EXPORT_OK',$2,$3,$1) }gex;
	s{( \b our \s+ ([\$\@\%]$ident) ) \s+ is \s+ export ($args) }
	 	 { add_to('EXPORT_OK',$2,$3,$1) }gex;
	$_ = $real_import_sub . $false_import_sub . $MANDATORY . $_;
}

__END__