Re: Clearing user defined variables

[gmpassos]

Well, reset() implementation really suxs, but Perl always let you to implement everything that you want. So, this 2 functions can help you:

  $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 , "\@$fullnam
+e") ;}
        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}{ARR
+AY}) {
          #print "CLS>> \@$fullname\n" ;
          untie @$fullname if tied @$fullname ;
          undef @$fullname ;
        }

        if ( !$skip_entries{"\%$fullname"} && defined *{$fullname}{HAS
+H}) {
          #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 ;

        }
      };
    }
  }
  
}

The output will be:

>> 123 # 456
>> 123 #

Enjoy! ;-P

Note that I encourage you to take a look in object orientation! Forget this ugly and stupid structured codes, this doesn't work very well. After learn OO you will see that with it you will be able to reuse better your codes, maintan, and you will be possible to make solutions for things much more complex, since you won't waste time with issues that structured codes create, and a bunch of functions that aren't made to work together or in other codes.