$ORIGINAL = 123 ; my %original_entries = Reset::scan_pack_entries('main') ; $NEW = 456 ; print ">> $ORIGINAL # $NEW\n" ; Reset::clean_pack_news('main' , %original_entries) ; print ">> $ORIGINAL # $NEW\n" ; package Reset ; sub scan_pack_entries { my ( $packname ) = @_ ; $packname .= '::' unless $packname =~ /::$/ ; no strict "refs" ; my $package = *{$packname}{HASH} ; return unless defined $package ; no warnings ; local $^W = 0 ; my @entries ; my $fullname ; foreach my $symb ( keys %$package ) { $fullname = "$packname$symb" ; if ( $symb !~ /::$/ && $symb !~ /[^\w:]/ && $symb !~ /^[1-9\.]/ && $symb !~ /^[0-9]+$/ ) { eval { if (defined &$fullname) { push(@entries , "\&$fullname") ;} if (*{$fullname}{IO}) { push(@entries , "\*$fullname") ;} if (defined *{$fullname}{ARRAY}) { push(@entries , "\@$fullname") ;} if (defined *{$fullname}{HASH}) { push(@entries , "\%$fullname") ;} if (defined $$fullname) { push(@entries , "\$$fullname") ;} }; } } return map { $_ => 1 } @entries ; } sub clean_pack_news { my ( $packname , %skip_entries ) = @_ ; $packname .= '::' unless $packname =~ /::$/ ; no strict "refs" ; my $package = *{$packname}{HASH} ; return unless defined $package ; local(*NULL) ; my $tmp_sub = sub{} ; no warnings ; local $^W = 0 ; my $fullname ; foreach my $symb ( keys %$package ) { $fullname = "$packname$symb" ; if ( $symb !~ /::$/ && $symb !~ /[^\w:]/ && $symb !~ /^[1-9\.]/ && $symb !~ /^[0-9]+$/ ) { eval { if ( !$skip_entries{"\&$fullname"} && defined &$fullname) { #print "CLS>> \&$fullname\n" ; if (my $p = prototype $fullname) { *{$fullname} = eval "sub ($p) {}" ;} else { *{$fullname} = $tmp_sub ;} undef &$fullname ; } if ( !$skip_entries{"\*$fullname"} ) { #print "CLS>> \*$fullname # ". $skip_entries{"\*$fullname"} ."\n" ; untie *{$fullname} if tied *{$fullname} ; #if (*{$fullname}{IO}) { close $fullname ;} } if ( !$skip_entries{"\@$fullname"} && defined *{$fullname}{ARRAY}) { #print "CLS>> \@$fullname\n" ; untie @$fullname if tied @$fullname ; undef @$fullname ; } if ( !$skip_entries{"\%$fullname"} && defined *{$fullname}{HASH}) { #print "CLS>> \%$fullname\n" ; untie %$fullname if tied %$fullname ; undef %$fullname ; } if ( !$skip_entries{"\$$fullname"} ) { #print "CLS>> \$$fullname\n" ; untie $$fullname if tied $$fullname ; undef $$fullname ; } }; } } } #### >> 123 # 456 >> 123 #