cleaneval.pl

#include <EXTERN.h>
#include <perl.h>
#include <stdlib.h>
#include <stdio.h>

PerlInterpreter *my_perl;

inline SV *run_in(PerlInterpreter *perl, char *code){
  SV *result;
  my_perl = perl;
  PERL_SET_CONTEXT(perl);
  result = eval_pv(code, TRUE);
  my_perl = NULL;
  return result;
}

void dump(PerlInterpreter *one, SV *what){
  SV *dump = run_in(
    one,
    "use Data::Dump::Streamer; sub { print {*STDERR} Dump($_[0])->Out }"
  );

  PERL_SET_CONTEXT(one);
  my_perl = one;

  dSP;

  ENTER;
  SAVETMPS;

  PUSHMARK(SP);
  SvREFCNT_inc(what);
  XPUSHs(what);
  PUTBACK;

  call_sv(dump, G_DISCARD);

  FREETMPS;
  LEAVE;
}


void interesting_part(PerlInterpreter *one, PerlInterpreter *two){
  SV *data = run_in(two, "use strict; { foo => { bar => ['baz'] } }");
  dump(one, data);

  SV *libs1 = run_in(one, "+{%INC, perl => 1}");
  SV *libs2 = run_in(two, "+{%INC, perl => 2}");
  dump(one, libs1);
  dump(one, libs2);
}

static void xs_init (pTHX);

EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);

EXTERN_C void xs_init(pTHX) {
  char *file = __FILE__;
  /* DynaLoader is a special case */
  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}

int main(int argc, char **argv, char **env){
  PerlInterpreter *one_perl, *two_perl;
  char *one_args[] = { "one_perl", "-e", "0" };
  char *two_args[] = { "two_perl", "-e", "0" };

  PERL_SYS_INIT3(&argc,&argv,&env);
  one_perl = perl_alloc();
  two_perl = perl_alloc();

  PERL_SET_CONTEXT(one_perl);
  perl_construct(one_perl);
  PERL_SET_CONTEXT(two_perl);
  perl_construct(two_perl);

  PERL_SET_CONTEXT(one_perl);
  perl_parse(one_perl, xs_init, 3, one_args, (char **)NULL);

  PERL_SET_CONTEXT(two_perl);
  perl_parse(two_perl, xs_init, 3, two_args, (char **)NULL);

  interesting_part(one_perl, two_perl);

  PERL_SET_CONTEXT(one_perl);
  perl_destruct(one_perl);
  PERL_SET_CONTEXT(two_perl);
  perl_destruct(two_perl);

  PERL_SET_CONTEXT(one_perl);
  perl_free(one_perl);
  PERL_SET_CONTEXT(two_perl);
  perl_free(two_perl);
  PERL_SYS_TERM();
}

output

$HASH1 = { foo => { bar => [ 'baz' ] } };
$HASH1 = {
           "AutoLoader.pm"
                          => '/usr/share/perl/5.10/AutoLoader.pm',
           "base.pm"      => '/usr/share/perl/5.10/base.pm',
           "B/Deparse.pm" => '/usr/lib/perl/5.10/B/Deparse.pm',
           "B.pm"         => '/usr/lib/perl/5.10/B.pm',
           "B/Utils.pm"   => '/usr/lib/perl5/B/Utils.pm',
           "bytes.pm"     => '/usr/share/perl/5.10/bytes.pm',
           "Carp.pm"      => '/usr/share/perl/5.10/Carp.pm',
           "Config_git.pl"
                          => '/usr/lib/perl/5.10/Config_git.pl',
           "Config_heavy.pl"
                          => '/usr/lib/perl/5.10/Config_heavy.pl',
           "Config.pm"    => '/usr/lib/perl/5.10/Config.pm',
           "Data/Dumper.pm"
                          => '/usr/lib/perl/5.10/Data/Dumper.pm',
           "Data/Dump/Streamer/_/Printers.pm"
                          => '/usr/lib/perl5/Data/Dump/Streamer/_/Printers.pm',
           "Data/Dump/Streamer.pm"
                          => '/usr/lib/perl5/Data/Dump/Streamer.pm',
           "DynaLoader.pm"
                          => '/usr/lib/perl/5.10/DynaLoader.pm',
           "Exporter/Heavy.pm"
                          => '/usr/share/perl/5.10/Exporter/Heavy.pm',
           "Exporter.pm"  => '/usr/share/perl/5.10/Exporter.pm',
           "Fcntl.pm"     => '/usr/lib/perl/5.10/Fcntl.pm',
           "feature.pm"   => '/usr/share/perl/5.10/feature.pm',
           "File/Spec.pm" => '/usr/share/perl/5.10/File/Spec.pm',
           "File/Spec/Unix.pm"
                          => '/usr/share/perl/5.10/File/Spec/Unix.pm',
           "Hash/Util.pm" => '/usr/lib/perl/5.10/Hash/Util.pm',
           "IO/File.pm"   => '/usr/lib/perl/5.10/IO/File.pm',
           "IO/Handle.pm" => '/usr/lib/perl/5.10/IO/Handle.pm',
           "IO.pm"        => '/usr/lib/perl/5.10/IO.pm',
           "IO/Seekable.pm"
                          => '/usr/lib/perl/5.10/IO/Seekable.pm',
           "List/Util.pm" => '/usr/lib/perl/5.10/List/Util.pm',
           "overload.pm"  => '/usr/share/perl/5.10/overload.pm',
           "PadWalker.pm" => '/usr/lib/perl5/PadWalker.pm',
           perl           => 1,
           "re.pm"        => '/usr/lib/perl/5.10/re.pm',
           "Scalar/Util.pm"
                          => '/usr/lib/perl/5.10/Scalar/Util.pm',
           "SelectSaver.pm"
                          => '/usr/share/perl/5.10/SelectSaver.pm',
           "SelfLoader.pm"
                          => '/usr/share/perl/5.10/SelfLoader.pm',
           "strict.pm"    => '/usr/share/perl/5.10/strict.pm',
           "subs.pm"      => '/usr/share/perl/5.10/subs.pm',
           "Symbol.pm"    => '/usr/share/perl/5.10/Symbol.pm',
           "Text/Abbrev.pm"
                          => '/usr/share/perl/5.10/Text/Abbrev.pm',
           "Text/Balanced.pm"
                          => '/usr/share/perl/5.10/Text/Balanced.pm',
           "utf8.pm"      => '/usr/share/perl/5.10/utf8.pm',
           "vars.pm"      => '/usr/share/perl/5.10/vars.pm',
           "version.pm"   => '/usr/share/perl/5.10/version.pm',
           "warnings.pm"  => '/usr/share/perl/5.10/warnings.pm',
           "warnings/register.pm"
                          => '/usr/share/perl/5.10/warnings/register.pm',
           "XSLoader.pm"  => '/usr/lib/perl/5.10/XSLoader.pm'
         };
$HASH1 = {
           perl        => 2,
           "strict.pm" => '/usr/share/perl/5.10/strict.pm'
         };