package Mud::StorableSub;
use strict;

use vars qw(%SubCache $SSself $SSserial);

sub new {
  my ($class, $code, %param) = @_;
  
  $SSserial++;
  my $self = bless {
    source => $code,
    'init' => ($param{'init'} || __PACKAGE__.'::_initialize_box'),
    'file' => ($param{'file'} || "(storable sub $SSserial)"),
    'line' => ($param{'line'} || 1),
  }, $class;
  
  $self->sub; # force compilation so that we can't return an uncompilable StorableSub
  
  return $self;
}

sub DESTROY {
  delete $SubCache{$_[0]};
}

sub sub {
  # avoid my() variables as they will show up in the evaled sub...
  local $SSself = shift;
  return $SubCache{$SSself} ||= do {
    $SSself->_init_compile_package;
    my $sub = eval qq{use strict; package Mud::StorableSub::Box;\n\n#line $SSself->{'line'} "$SSself->{'file'}"\nreturn sub { $SSself->{source} }};
    $@ and die $@;
    $SSself->_clear_compile_package;
    $sub;
  };
}

sub source {$_[0]{source}}

sub _init_compile_package {
  my ($self) = @_;
  no strict 'refs';
  &{$self->{'init'}}('Mud::StorableSub::Box', $self);
}

sub _clear_compile_package {
  my ($self) = @_;
  require Symbol;
  if (defined &Symbol::delete_package) {
    Symbol::delete_package($self->{package});
  } else {
    __scrub_package('Mud::StorableSub::Box');
  }
}

sub _initialize_box {}

sub __scrub_package { # from perlfaq7
    no strict 'refs';
    my $pack = shift;
    die "Shouldn't delete main package"
        if $pack eq "" || $pack eq "main";
    my $stash = *{$pack . '::'}{HASH};
    my $name;
    foreach $name (keys %$stash) {
        my $fullname = $pack . '::' . $name;
        # Get rid of everything with that name.
        undef $$fullname;
        undef @$fullname;
        undef %$fullname;
        undef &$fullname;
        undef *$fullname;
    }
}

1;
__END__
