package Embed::Persistent;
use strict;
use FileHandle ();
use Carp 'croak';
use vars qw($VERSION);
$VERSION = (qw$Revision: 1.10 $)[1];
sub valid_package_name {
    my($self, $string) = @_;
    # Escape everything into valid perl identifiers
    $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
    # second pass cares for slashes and words starting with a digit
    $string =~ s{
                          (/)        # directory
                          (\d?)      # package's first character
                         }[
                           "::" . ($2 ? sprintf("_%2x",unpack("C",$2)) : "")
                          ]egx;
    return "Embed" . $string;
}
sub cached {
    my($self, $filename, $package, $mtime) = @_;
    $$mtime = -M $filename;
    if(defined $self->{FileCache}{$package}{mtime}
       &&
       $self->{FileCache}{$package}{mtime} <= $$mtime) {
        return 1;
    }
    return 0;
}
sub cache {
    my($self, $package, $mtime) = @_;
    $self->{FileCache}{$package}{mtime} = $mtime;
}
sub uncache {
    my($self, $package) = @_;
    delete $self->{FileCache}{$package};
}
sub new {
    my $class = shift;
    return bless {
        FileCache => {
        },
        @_,
    } => $class;
}
sub prepare {
    my($self, $filename, $package) = @_;
    my $fh = FileHandle->new($filename) or die "open '$filename' $!";
    local($/) = undef;
    my $sub = <$fh>;
    $fh->close;
    #new object, same class
    return bless {
        CODE => $sub,
        FILENAME => $filename,
        PACKAGE => $package,
    }, ref($self) || $self;
}
sub compile {
    my($self) = @_;
    my $code = $self->{CODE};
    my $package = $self->{PACKAGE};
    my $eval = qq{package $package; sub handler { $code; }};
    {
        # hide our variables within this block
        my($package,$code);
        eval $eval;
    }
    croak $@ if $@;
}
sub run {
    my($self) = @_;
    eval {$self->{PACKAGE}->handler;};
    croak $@ if $@;
}
#borrowed from Safe.pm
sub delete {
    my($self) = @_;
    my $pkg = $self->{PACKAGE};
    $self->uncache($pkg);
    my ($stem, $leaf);
    no strict 'refs';
    $pkg = "main::$pkg\::";     # expand to full symbol table name
    ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
    my $stem_symtab = *{$stem}{HASH};
    delete $stem_symtab->{$leaf};
}
sub eval_file {
    my($self, $filename, $delete) = @_;
    my $package = $self->valid_package_name($filename);
    my $mtime;
    if($self->cached($filename, $package, \$mtime)) 
    {
        # we have compiled this subroutine already, 
        # it has not been updated on disk, nothing left to do
        print STDERR "already compiled $package->handler\n" if $self->{DEBUG};
    }
    else {
        my $code = $self->prepare($filename, $package); 
        #wrap the code into a subroutine inside our unique package
        $code->compile;
        #cache it unless we're cleaning out each time
        $self->cache($package, $mtime) unless $delete;
        $code->run;
        $code->delete if $delete;
    }
    #take a look if you want
    #print Devel::Symdump->rnew($package)->as_string, $/;
}
1;
__END__