File Coverage

blib/lib/Thread/Isolate/Map.pm

Criterion	Covered	Total	%
statement	16	90	17.7
branch	0	42	0.0
condition	0	10	0.0
subroutine	6	10	60.0
pod			n/a
total	22	152	14.4

#############################################################################
## Name:        Map.pm
## Purpose:     Thread::Isolate::Map
## Author:      Graciliano M. P.
## Modified by:
## Created:     2005-01-29
## RCS-ID:
## Copyright:   (c) 2005 Graciliano M. P.
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

package Thread::Isolate::Map ;

use strict qw(vars) ;
no warnings ;

#######
# NEW #
#######

sub new {
  my $this = shift ;
  return( $this ) if ref($this) ;
  my $class = $this || __PACKAGE__ ;

  my $local_pack = shift ;
  my ( $target_pack , $thi ) ;

  $target_pack = !ref($_[0]) ? shift(@_) : $local_pack ;
  $thi = shift ;

  return if !ref($thi) ;

  my $this = bless({} , $class) ;

  $this->{local_pack} = $local_pack ;
  $this->{target_pack} = $target_pack ;
  $this->{thi} = $thi ;

  $this->map ;

  return $this ;
}

#######
# MAP #
#######

sub map {
  my $this = shift ;

  my $thi_entries = $this->scan_pack_entries( $this->{thi} , $this->{target_pack} , 1 ) ;

  no strict "refs" ;
  no warnings ;

  foreach my $entry ( sort @$thi_entries ) {
    #print "> $entry\n" ;
    eval {
      if ( $entry =~ /^\$(.*)/ ) {
        require Thread::Isolate::Map::Scalar ;
        tie( ${$1} , 'Thread::Isolate::Map::Scalar' , $this->{thi} , $entry ) ;
      }
      elsif ( $entry =~ /^\@(.*)/ ) {
        require Thread::Isolate::Map::Array ;
        tie( @{$1} , 'Thread::Isolate::Map::Array' , $this->{thi} , $entry , $1 ) ;
      }
      elsif ( $entry =~ /^\%(.*)/ ) {
        require Thread::Isolate::Map::Hash ;
        tie( %{$1} , 'Thread::Isolate::Map::Hash' , $this->{thi} , $entry , $1 ) ;
      }
      elsif ( $entry =~ /^\*(.*)/ ) {
        require Thread::Isolate::Map::Handle ;
        tie( *{$1} , 'Thread::Isolate::Map::Handle' , $this->{thi} , $entry , $1 ) ;
      }
      elsif ( $entry =~ /^\&(.*)/ ) {
        my $sub = $1 ;
        my $thi = $this->{thi} ;
        *$sub = sub { $thi->call($sub,@_) ;}
      }
    };
    #print "$@\n" if $@ ;
  }

}

#####################
# SCAN_PACK_ENTRIES #
#####################

sub scan_pack_entries {
  my $this = shift ;
  my $thi = ref $_[0] ? shift(@_) : undef ;
  my ( $packname , $recursive ) = @_ ;

  if ( $thi ) {
    my $thi_entries = $thi->eval(q`
      use Thread::Isolate::Map ;
      return Thread::Isolate::Map->scan_pack_entries(@_) ;
    ` , $packname , $recursive ) ;
    warn( $thi->err ) if $thi->err ;
    return $thi_entries ;
  }

  $packname .= '::' if $packname !~ /::$/ ;

  return if $packname =~ /^(?:main::)?(?:Thread::Isolate|threads|UNIVERSAL|Exporter|AutoLoader|CORE|Carp|Config|DynaLoader|Errno|Win32|XSLoader|attributes|overload|strict|utf8|vars|warnings|Storable|Fcntl|Internals|PerlIO|Symbol)(?:::|$)/ ;

  no strict "refs" ;
  my $package = *{$packname}{HASH} ;

  return if !defined %$package || $this->{scan_pack_entries}{$package} ;

  $this->{scan_pack_entries}{$package} = 1 ;

  my @entries ;

  foreach my $symb ( keys %$package ) {
    my $fullname = "$packname$symb" ;

    next if $symb =~ /[^\w:]/ || $symb =~ /^[1-9\.]/ ;

    if ($symb =~ /::$/ ) {
      push(@entries , $fullname) ;
      push(@entries , @{$this->scan_pack_entries($fullname , $recursive)} ) if $recursive ;
    }
    else {
      eval {
        if (defined &$fullname) { push(@entries , "\&$fullname") ;}

        if ( tied *{$fullname} || *{$fullname}{IO} ) { push(@entries , "\*$fullname") ;}

        if (defined *{$fullname}{ARRAY}) { push(@entries , "\@$fullname") ;}

        if (defined *{$fullname}{HASH}) { push(@entries , "\%$fullname") ;}

        push(@entries , "\$$fullname") ;
      };
    }

  }

  delete $this->{scan_pack_entries}{$package} ;

  return \@entries ;
}

########################
# LOAD THREAD::ISOLATE #  Need to load here or the Mother Thread won't have the subs of this package:
########################

use Thread::Isolate ;

#######
# END #
#######

1;


__END__