#
# Copied from: https://metacpan.org/release/DOUGM/ExtUtils-Embed-1.14/source/lib/Embed/Persistent.pm
# No notice found so maybe Perl license.
#

#package Embed::Persistent;
package 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__