Proposal for Test2::V1

Still need to add tests and POD (I finished the POD for V1 itself)

Also need to modigy other docs that currently reference V0.

Author: exodist

lib/T2.pm

@@ -0,0 +1,72 @@
+package T2;
+use strict;
+use warnings;
+
+my $INIT;
+my $HANDLE;
+sub handle { $HANDLE }
+
+sub import {
+    my $class = shift;
+    my ($handle) = @_;
+
+    my ($caller, $file, $line) = caller;
+
+    die "The ${ \__PACKAGE__ } namespace has already been initialized (Originally initiated at $INIT->[1] line $INIT->[2]) at $file line $line.\n"
+        if $INIT;
+
+    unless ($handle) {
+        die "The '$caller' package does not provide a T2 handler at $file line $line.\n"
+            unless $caller->can('T2');
+
+        $handle = $caller->T2 or die "Could not get handle via '$caller\->T2()' at $file line $line.\n";
+    }
+
+    die "'$handle' is not a Test2::Handle instance at $file line $line.\n"
+        unless $handle->isa('Test2::Handle');
+
+    $INIT = [$caller, $file, $line];
+    $HANDLE = $handle;
+
+    for my $sym ($HANDLE->HANDLE_SUBS) {
+        next if $sym eq 'import';
+        next if $sym eq 'handle';
+
+        my $code = $HANDLE->HANDLE_NAMESPACE->can($sym);
+        my $proto = prototype($code);
+
+        my $header = defined($proto) ? "sub $sym($proto) {" : "sub $sym {";
+
+        my $line = __LINE__ + 3;
+        my $sub = eval <<"        EOT" or die $@;
+#line $line ${ \__FILE__ }
+$header
+    my (\$f) = \@_;
+    shift if \$f && "\$f" eq "$class";
+    goto &\$code;
+};
+
+\\&$sym;
+        EOT
+
+        no strict 'refs';
+        *$sym = $sub;
+    }
+}
+
+sub AUTOLOAD {
+    my ($this) = @_;
+
+    if ($this) {
+        shift if "$this" eq 'T2';
+        shift if ref($this) eq 'T2';
+    }
+
+    my ($name) = (our $AUTOLOAD =~ m/^(?:.*::)?([^:]+)$/);
+
+    my @caller = caller;
+    my $sub = $HANDLE->HANDLE_NAMESPACE->can($name) or die qq{"$name" is not provided by this T2 handle at $caller[1] line $caller[2].\n};
+    goto &$sub;
+}
+
+1;

lib/Test2/Handle.pm

@@ -0,0 +1,156 @@
+package Test2::Handle;
+use strict;
+use warnings;
+
+our $VERSION = '1.302217';
+
+require Carp;
+require Test2::Util;
+
+use Test2::Util::HashBase qw{
+    +namespace
+    +base
+    +include
+    +import
+    +stash
+    +stomp
+};
+
+my $NS = 1;
+
+# Things we do not want to import automagically
+my %EXCLUDE_SYMBOLS = (
+    BEGIN   => 1,
+    DESTROY => 1,
+    DOES    => 1,
+    END     => 1,
+    VERSION => 1,
+    does    => 1,
+);
+
+sub HANDLE_BASE { Carp::croak("Not Implemented") }
+
+sub HANDLE_NAMESPACE { $_[0]->{+NAMESPACE} }
+
+sub HANDLE_SUBS {
+    my $self = shift;
+
+    my @out;
+
+    my $seen = {class => {}, export => {}};
+    my @todo = ($self->{+NAMESPACE});
+
+    while (my $check = shift @todo) {
+        next if $seen->{class}->{$check}++;
+
+        no strict 'refs';
+        my $stash = \%{"$check\::"};
+        push @out => grep { !$seen->{export}->{$_}++ && !$EXCLUDE_SYMBOLS{$_} && $_ !~ m/^_/ && $check->can($_) } keys %$stash;
+        push @todo => @{"$check\::ISA"};
+    }
+
+    return @out;
+}
+
+sub import {
+    my $class = shift;
+    my ($name, %params) = @_;
+
+    my $self = $class->new(%params);
+
+    my $caller = caller;
+    no strict 'refs';
+    *{"$caller\::$name"} = sub() { $self };
+}
+
+sub init {
+    my $self = shift;
+
+    my $stomp = $self->{+STOMP}   ||= 0;
+    my $inc   = $self->{+INCLUDE} ||= [];
+    my $base  = $self->{+BASE}    ||= $self->HANDLE_BASE;
+
+    require(Test2::Util::pkg_to_file($base));
+
+    my $new;
+    my $ns    = $self->{+NAMESPACE} ||= do { $new = 1; __PACKAGE__ . '::GEN_' . $NS++ };
+    my $stash = $self->{+STASH}     ||= do { no strict 'refs'; \%{"$ns\::"} };
+
+    Carp::croak("Namespace '$ns' already appears to be populated") if !$stomp && keys %$stash;
+
+    $INC{Test2::Util::pkg_to_file($ns)} ||= __FILE__ if $new;
+
+    my $line = __LINE__ + 3;
+    $self->{+IMPORT} ||= eval <<"    EOT" or die $@;
+#line $line ${ \__FILE__ }
+        package $ns;
+        sub {
+            my (\$module, \@imports) = \@_;
+            require(Test2::Util::pkg_to_file(\$module));
+            \$module->import(\@imports);
+        };
+    EOT
+
+    {
+        no strict 'refs';
+        push @{"$ns\::ISA"} => $self->{+BASE};
+    }
+
+    if (my $include = $self->{+INCLUDE}) {
+        my $r = ref($include);
+        if ($r eq 'ARRAY') {
+            $self->include(ref($_) ? @{$_} : $_) for @$include;
+        }
+        elsif ($r eq 'HASH') {
+            $self->include($_ => @{$include->{$_} || []});
+        }
+        else {
+            die "Not sure what to do with '$r'";
+        }
+    }
+}
+
+my $WRAP = sub {
+    my $self = shift;
+    my ($name) = @_;
+
+    return if $self->can($name);
+
+    my $wrap = sub {
+        my $handle = shift;
+        my $ns = $handle->{+NAMESPACE};
+        my @caller = caller;
+        my $sub = $ns->can($name) or die qq{"$name" is not provided by this T2 handle at $caller[1] line $caller[2].\n};
+        goto &$sub;
+    };
+
+    {
+        no strict 'refs';
+        *$name = $wrap;
+    }
+
+    return $wrap;
+};
+
+sub include {
+    my $self = shift;
+    my ($mod, @imports) = @_;
+    @imports = @{$imports[0]} if @imports == 1 && ref($imports[0]) eq 'ARRAY';
+
+    $self->{+IMPORT}->($mod, @imports);
+    $self->$WRAP($_) for @imports;
+}
+
+sub AUTOLOAD {
+    my ($self) = @_;
+
+    my ($name) = (our $AUTOLOAD =~ m/^(?:.*::)?([^:]+)$/);
+    return if $EXCLUDE_SYMBOLS{$name};
+
+    my $wrap = $self->$WRAP($name);
+    goto &$wrap;
+}
+
+1;
+
+=head1 FIX POD