package Data::Revive;

# This is (hopefully) the bare minimum of opcodes
# necessary to use normal objects.
# Pass in "-opcode" to disable any default opcode,
# or any opcode not listed here to enable it.
my @defaults = qw {
    const
    rv2sv
    rv2av
    rv2hv
    rv2gv
    pushmark
    anonlist
    anonhash
    refgen
    sassign
    leaveeval
    padany
    aelem
    helem
    null
    undef
};

sub revive_object {

    my $object_text = $_[0];
    my @options = @{ $_[1] or [] };
    my @allowed_ops = grep { defined } grep !/^-/, (
        @options,
        grep {
            my $this = $_;
            not grep /^-$this$/, @options
        } @defaults
    ); 
    use Safe;
    my $safe_env = Safe->new();
    $safe_env->permit_only(@allowed_ops);
    my $obj = $safe_env->reval($object_text) or die $@;
    if ((grep /^bless$/, @allowed_ops) and ref($obj)) {
        # Safe's restricted environment causes blessed objects to
        # lose their 'magic' when passed back out. Here we simply 
        # re-bless the object to correct that.
        bless $obj, ref($obj);
    } 
    return $obj;
}

1;
[download]

#!/usr/bin/perl
use strict;
use Data::Revive;

package Nothing;
sub foo {
        print "foo method called\n";
}

package main;
use Data::Dumper;
$Data::Dumper::Purity = 1;

print "--- Test Object ---\n";
my $sample_obj = {
    'foo' => {
        'bar' => [0,1,2,3,4]
    },
    'baz' => 12,
    'quux' => "string",
    'quuux' => undef
};
$sample_obj->{quuuux} = $sample_obj;
my $sample_text = Dumper($sample_obj);
print $sample_text;
print "\n\n";

print "--- Revived Object ---\n";
my $loaded_obj = Data::Revive::revive_object($sample_text);
print Dumper($loaded_obj);
print "\n\n";


print "--- Revived Object with added Opcode ---\n";
my $sample_text2 = Dumper(bless($sample_obj, 'Nothing'));
my $loaded_obj2 = Data::Revive::revive_object($sample_text2, [qw(bless
+)]);
print Dumper($loaded_obj2);
$loaded_obj2->foo();
print "\n\n";


print "--- Revived Object with (intentional) failed Opcode ---\n";
# note, bless not allowed this time
$loaded_obj2 = Data::Revive::revive_object($sample_text2);
print Dumper($loaded_obj2);
print "\n\n";
[download]