File Coverage

blib/lib/Safe/World/ScanPack.pm

Criterion	Covered	Total	%
statement	53	56	94.6
branch	6	10	60.0
condition	9	12	75.0
subroutine	9	9	100.0
pod	0	2	0.0
total	77	89	86.5

#############################################################################
## Name:        ScanPack.pm
## Purpose:     Safe::World::ScanPack
## Author:      Graciliano M. P.
## Modified by:
## Created:     08/09/2003
## RCS-ID:
## Copyright:   (c) 2003 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 Safe::World::ScanPack ;
use 5.003 ;

use vars qw($VERSION *ENTRY);

$VERSION = '0.01';

no warnings ;

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

sub new {
  my(undef,@packages) = @_;
  no strict "refs" ;
  my $self = bless({}, __PACKAGE__) ;

  my @packs = $self->_scan(@packages) ;

  @packs = sort @packs ;
  $self->{PACKAGES} = \@packs ;

  delete $self->{SCANNEDS} ;

  return $self ;
}

#########
# _SCAN #
#########

sub _scan {
  my $self = shift ;
  my(@packages) = @_;

  my($key,$val,$num,$pack) ;

  no strict "refs" ;

  my @scanneds ;

  foreach $pack (@packages) {
    my $packref = *{"$pack\::"}{HASH} ;
    $packref = "$packref" ;
    if ($self->{SCANNEDS}{$packref}) { next ;}
    $self->{SCANNEDS}{$packref}++ ;
    push(@scanneds , $packref) ;

    no strict ;
    while (($key,$val) = each(%{*{"$pack\::"}})) {
      local(*ENTRY) = $val;

      if (defined $val && defined *ENTRY{HASH} && $key =~ /::$/ && $key ne "main::" && $key ne "::") {
        my($p) = $pack ne "main" ? "$pack\::" : "";
        ($p .= $key) =~ s/::$// ;
        my $packref = *{"$p\::"}{HASH} ;
        if ( !$self->{PACKAGES}{$p} ) {
          $self->{PACKAGES}{$p} = 1 ;
          if ( !$self->{SCANNEDS}{"$packref"} ) { push(@packages, $self->_scan($p)) ;}
          else { push(@packages, $p) ;}
        }
      }
    }
  }

  foreach my $scanneds_i ( @scanneds ) {
    delete $self->{SCANNEDS}{$scanneds_i} ;
  }

  return @packages ;
}

############
# PACKAGES #
############

sub packages { return @{ $_[0]->{PACKAGES} } ;}

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


1;