view release on metacpan or  search on metacpan

lib/ExportTo.pm  view on Meta::CPAN

package ExportTo;

use Carp();
use strict;

sub import{
  my $pkg = (caller)[0];
  {
    no strict 'refs';
    *{$pkg . '::export_to'} = \&export_to
      if not defined &{$pkg . '::export_to'};
  }
  goto \&export_to;
}

sub export_to {
  shift if $_[0] eq __PACKAGE__;
  my %hash = @_;
  my $pkg = (caller)[0];
  while(my($class, $subs) = each %hash){
    if(ref $subs eq 'HASH'){
      # {subname => \&coderef/subname}
      while (my($sub, $cr_or_name) = each %{$subs}) {
        my($cr, $subname) = ref $cr_or_name eq 'CODE' ? ($cr_or_name, undef) : (undef, $cr_or_name);
        my $esub = $class . '::' . $sub;
        $sub  =~ s/\+//og;
        ($esub =~ s/\+//og or ($subname and $subname =~s/\+//og)) ? undef &{$esub} : defined(&{$esub}) && next;
        # if($cr or $cr = \&{$pkg . '::' . $subname}) {
        if($cr or $cr = $pkg->can($subname)) {
          no strict 'refs';
          *{$esub} = $cr
        } else {
          Carp::croak($pkg, ' cannot do ' , $subname);
        }
      }
    }else{
      foreach my $sub (@$subs){
        my $esub;
        unless($sub =~ /::/o){
          $esub = $class . '::' . $sub;
        } else {
          $sub =~ s{^(.+)::}{}o and $pkg = $1;
          $esub = $class . '::' . $sub;
        }
        $sub  =~ s/\+//og;
        $esub =~ s/\+//og ? undef &{$esub} : defined(&{$esub}) && next;
        # if(my $cr = \&{$pkg . '::' . $subname}) {
        if(my $cr = $pkg->can($sub)) {
          no strict 'refs';
          *{$esub} = $cr
        } else {
          Carp::croak($pkg, ' cannot do ' , $sub);
        }
      }
    }
  }
}

=head1 NAME

ExportTo - export any function/method to any namespace

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

 package From;
 
 sub function_1{
   # ...
 }
 
 sub function_2{