package namespace;

=head1 NAME

namespace - Perl pragma to use like C++ namespace aliasing

=head1 SYNOPSIS

 use namespace File => IO::File;

 my $fh = new File "foo", O_CREAT|O_WRONLY;
 if( defined $fh )
 {
     print $fh "bar\n";
     $fh->close;
 }

=head1 DESCRIPTION

Allow aliasing namespace. May be useful for reusability increase.

 use namespace ALIAS => PACKAGE 
    [, qw/IMPORT_LIST [ ::SUBPACKAGE [ IMPORT_LIST ]] /];

 ALIAS and PACKAGE is required parameters;
 IMPORT_LIST is the usual list of import.


Also may be undefined namespace and they subnamespaces:

 no namespace ALIAS;


If ALIAS begin with '::', then alias will be expandet to 
caller namespace. If following example of pragma namespace 
called from main:: module, then alias will be expandet to main::ALIAS::.
     
 use namespace ::ALIAS => PACKAGE
    

=head1 EXAMPLES

 EXAMPLE 1

 use namespace DOM => XML::DOM, qw/$VERSION ::Document $VERSION/;

    # DOM is alias for XML::DOM
    #       $VERSION from XML::DOM will be imported to DOM
    #
    # ::Document subpackage of XML::DOM will be aliased to DOM::Document
    #       $VERSION from XML::DOM::Document will be imported to DOM::Document

 my $doc = new DOM::Document;
 print "Current used DOM version is $DOM::VERSION \n";

 no namespace DOM;

    # namespace DOM and all subnamespaces will be destroyed



 EXAMPLE 2

 use namespace DOM => XML::DOM, qw/::Document/;
 # or
 # use namespace DOM => XML::Sablotron::DOM, qw/:constants ::Document/;

 my $doc = new DOM::Document;
 print "Constant 'TEXT_NODE' = ", TEXT_NODE;

=head1 AUTHOR

Albert MICHEEV <amichauer@cpan.org>

=cut

use strict qw/subs vars/;
$namespace::VERSION = '0.05';


sub import{
    my ($slf, $als, $pkg) = (shift, shift, shift);
    my $clr = (caller)[0];

    $als = $clr.$als if substr($als, 0, 2) eq '::';

    die "Package '$als' already defined!" if defined %{$als.'::'};

    require join( '/', split '::', $pkg ) . '.pm' unless defined %{$pkg.'::'};
    @{$als.'::ISA'} = $pkg;

    if( @_ and $_[0] eq '()' ){ shift }
    else{ unshift @_, @{$pkg.'::EXPORT'} if defined @{$pkg.'::EXPORT'} }

    my ($Pkg, $Als) = ($pkg, $als);

    while( my $imp = shift ){
        if( substr($imp, 0, 2) eq '::' ){
            $Pkg = $pkg.$imp;
            $Als = $als.$imp;
            @{$Als.'::ISA'} = $Pkg;
            if( @_ and $_[0] eq '()' ){ shift }
            else{ unshift @_, @{$Pkg.'::EXPORT'} if defined @{$Pkg.'::EXPORT'} }
        }
        elsif( $imp =~ /^:(.+)$/ ){
            die "Can't find '$imp' export tag in $Pkg!\n" unless
                defined ${$Pkg.'::'}{EXPORT_TAGS}{$1};
            unshift @_, @{ ${$Pkg.'::'}{EXPORT_TAGS}{$1} };
        }
        elsif( $imp =~ /^([\$%@])?(.+)$/ ){
            die "Can't find '$imp' from $Pkg!\n" unless
                !$1       && defined \&{$Pkg.'::'.$2} or
                $1 eq '$' && defined \${$Pkg.'::'.$2} or
                $1 eq '@' && defined \@{$Pkg.'::'.$2} or
                             defined \%{$Pkg.'::'.$2};
            *{$clr.'::'.$2} = 
            *{$Als.'::'.$2} = 
               !$1        ? \&{$Pkg.'::'.$2} :
                $1 eq '$' ? \${$Pkg.'::'.$2} :
                $1 eq '@' ? \@{$Pkg.'::'.$2} : 
                            \%{$Pkg.'::'.$2};
        }
        else{ die "Undefined behavior!\n" }
    }
}

sub unimport{
    undef %{(substr($_[1], 0, 2) eq '::' ? (caller)[0] : '' ).$_[1].'::'};
}

1;