package pragmatic;

our $VERSION = 0.01;

our %pragmas; # pragmas currently in effect
our %masked;  # masked symbols while pragma on
our %symbols; # 
our $AUTOLOAD;

sub import {
    shift;            # discard package
    return unless @_; # nothing to do
    my ($mod,@args) = split " ", shift;
    my @caller = caller(1);
    # see if $mod is defined in $caller
    my $callpkg = $caller[0];
    unless (exists $symbols{$callpkg} && exists $symbols{$callpkg}->{$mod}) {
        package pragmatic::import {
            die $@ unless eval "use $mod @args;1";
            my $stash = "$callpkg\::";
            for my $symbol (keys %pragmatic::import::) {
                if (my $code = *{$pragmatic::import::{$symbol}}{CODE}){
                    next unless *{${$stash}{$symbol}};
                    if (*{${$stash}{$symbol}}{CODE}) {
                        $masked{$callpkg}->{$symbol}
                            = *{${$stash}{$symbol}}{CODE};
                    }
                    $symbols{$callpkg}->{$mod}->{$symbol} = $code;
                    *{"$caller\::$symbol"} = \&{"pragmatic::$symbol"};
                }
                delete $pragmatic::import::{$symbol};
            }
        }
    }
    push @{$pragmas{$callpkg}}, $mod
        unless grep {/^$mod$/} @{$pragmas{$callpkg}};
    $^H{"$callpkg/pragma/in_effect"} = 1;
    $^H{"$callpkg/$mod/in_effect"} = 1;
}

sub unimport {
    shift;
    my $mod = shift;
    my $callpkg = (caller)[0];
    if($mod) {
        $^H{"$callpkg/$mod/in_effect"} = 0;
    } else {
        $^H{"$callpkg/pragma/in_effect"} = 0;
    }
}

sub AUTOLOAD {
    $AUTOLOAD =~ s/.*:://;
    my ($callpkg,$file,$line,$hinthash) = (caller(0))[0..2,10];
    if ($hinthash->{"$callpkg/pragma/in_effect"}) {
        # look up symbol in reverse pragma chain for this package
        for my $mod ( reverse @{$pragmas{$callpkg}} ) {
            if (exists $symbols{$callpkg}->{$mod}) {
                if (exists $symbols{$callpkg}->{$mod}->{$AUTOLOAD}) {
                    if ($hinthash->{"$callpkg/$mod/in_effect"}) {
                        goto &{$symbols{$callpkg}->{$mod}->{$AUTOLOAD}};
                    } else {
                        goto &{$masked{$callpkg}->{$AUTOLOAD}};
                    }
                }
            }
        }
        die "Undefined subroutine &$callpkg::$AUTOLOAD called at $file line $line\n";
    } else {
        goto &{$masked{$callpkg}->{$AUTOLOAD}};
    }
}
1;