Perl 6's Exporter

[Brent Dax]

I've been thinking about improvements that could be made to Exporter for
Perl 6.

        1. Choosing where to export to:
                use Data::Dumper 'Dumper' => 'dumpvar';
                #exports Data::Dumper::Dumper to Main::dumpvar (or whatever)
        2. Built-in switch handling:
                use Data::Dumper ('Dumper' : qw(+Indent=2 +Useqq));
                #imports Dumper, sets $Data::Dumper::Indent=2, and
                # does $Data::Dumper::Useqq is true
        3. Warnings about conflicts:
                use warnings 'Exporter';
                sub Dumper { ... }
                use Data::Dumper qw(Dumper);
                #prints out a warning (not just 'redefined subroutine', either).
        4. For modules, saying 'use Exporter' should be enough to get import.
           If you don't want Exporter's import(), just C<use Exporter()>.
        5. In addition to @EXPORT/@EXPORT_OK/%EXPORT_TAGS, provide a way to do
           it on the 'use Exporter' line.

So, with those requirements and what knowledge of Perl 6 I have, I
present a preliminary Exporter.  I typed it directly into the mailer, so
there's a good chance of mistakes.  If anyone spots any mistakes in it,
let me know.


module Exporter;

use strict;
use warnings;
use warnings::register; #assuming this continues to exist...

sub myimport($exp_from : *@symbols=() : *@options=()) {
        my $exp_to=caller.package;      #is this how caller is used?

        pkg_alias($exp_from, "Exporter::From");
        pkg_alias($exp_to, "Exporter::To");

        #defaults
        @symbols //= @Exporter::From::EXPORT;

        #expand tags to their values
        @symbols=map {
                /^:/ ??
                        @{%Exporter::From::EXPORT_TAGS}{$_}} ::
                        $_
        } @symbols;

        for(@symbols) {
                #handle version numbers
                if(/^[\d.]+$/) {
                        $exp_from.require_version($_);
                        next;
                }

                #handle renamed exports
                my($to, $from)=$_.ref eq 'PAIR' ? ($_.left, $_.right) : ($_, $_);

                for($to, $from) {
                        #make sure it has some sort of sigil
                        $_='&' _ $_ unless m'^[$@%&]';
                }

                warnings::warnif("$from exported from $exp_from conflicts with
existing $to at $(caller.file) line $(caller.line).\n")
                        if defined %Exporter::To::{$to};

                die("$exp_from doesn't export $from at $(caller.file) line
$(caller.line).\n")
                        unless grep {/^$from$/} @Exporter::From::EXPORT,
@Exporter::From::EXPORT_OK;

                %Exporter::To::{$to}=%Exporter::From::{$from};
        }

        for(@options) {
                my($sign, $name, $value)=/[+-]([[\w]&&[^\d]]\w+)(?:=(.*))?/s;
                my $targ := ${$Exporter::From::{$name}};

                given($sign) {
                        when('+'): {
                                if(defined $value) {
                                        $targ=$value;
                                }
                                else {
                                        $targ is true;
                                }
                        }

                        when('-') {
                                if($targ.props{true}) {
                                        $targ is false;
                                }
                                else {
                                        undef $targ;
                                }
                        }
                }
        }
}

sub import($pkg : ARRAY $export=undef, ARRAY $ok=undef, HASH
$tags=undef) {
        my $from_pkg=caller.package;

        pkg_alias($from_pkg, "Exporter::From");

        &Exporter::From::import := &myimport;

        #another way to decide what to export:
        #use Exporter(
        #       export  => [qw(foo bar)],
        #       ok              => [qw(baz quux],
        #       tags            => { :argc => ['argv'] }
        #);

        if(defined $export) {
                @Exporter::From::EXPORT=@$export;
        }

        if(defined $ok) {
                @Exporter::From::EXPORT_OK=@$ok;
        }

        if(defined $tags) {
                %Exporter::From::EXPORT_TAGS=%$tags;
        }
}

sub pkg_alias($original, $new) {
        #Any sufficiently encapsulated hack...
        no strict 'refs';

        %{"${original}::"} := %{"${new}::"};    #XXX will this actually work?
}


=head1 NAME

Exporter - Implements default import method for modules

=head1 SYNOPSIS

In MyModule.pm:

        module MyModule;

        use Exporter(
                export => [qw(foo @bar)],
                ok => [qw($baz quux)],
                tags => { :argc => ['@argv %argv']}
        );

In other files:

        use MyModule;           #imports everything in export

        use MyModule 'quux';    #imports only &quux

        use MyModule ':argc'    #imports @argv and %argv

        use MyModule();         #imports nothing at all

=head1 DESCRIPTION

TODO: Fill this in.

=head1 BUGS

Who knows--this code is for a language that hasn't been fully defined
and which doesn't yet have an implementation.

=head1 AUTHOR

The Perl 6 core developers.  (Preliminary version by Brent Dax.)

=cut


--Brent Dax
[EMAIL PROTECTED]
Configure pumpking for Perl 6

"Nothing important happened today."
    --George III of England's diary entry for 4-Jul-1776