| Perl6-Export documentation | Contained in the Perl6-Export distribution. |
Perl6::Export - Implements the Perl 6 'is export(...)' trait
# 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
}
Implements what I hope the Perl 6 symbol export mechanism might look like.
It's very straightforward:
use arguments), you mark it
with the is export trait. is export(:DEFAULT) trait. is export(:MANDATORY) trait. That's it.
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.
Requires Filter::Simple
Damian Conway (damian@conway.org)
Does not yet handle the export of variables.
Comments, suggestions, and patches welcome.
Copyright (c) 2003, Damian Conway. All Rights Reserved.
This module is free software. It may be used, redistributed
and/or modified under the same terms as Perl itself.
| 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__