############################################################################# ## 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'; ####### # 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;