#!/usr/bin/perl

use strict;
use warnings;

use Config;

use ExtUtils::Embed;

my($target,$source,$srclen) = (shift @ARGV,'',0);

exit unless open SRC,"<$target";
sysread SRC,$source,(-s SRC);
close SRC;

$source =~ s/^\#\![^\r\n]+\s*//;
$srclen = length $source;

my $tmpsrc = $target;
$tmpsrc =~ s/\.([0-9a-zA-Z]+)$//i;
my $output = ($^O =~ /win/i)? "$tmpsrc.exe" : $tmpsrc;
$tmpsrc .= '.c';

exit unless open TMP,">$tmpsrc";
flock(TMP,2);
{
  my(@mods,%seen);
  my $xsinit_proto = "pTHX";
  my $std = 1 unless scalar @mods;
  push(@mods, ExtUtils::Embed::static_ext()) if defined $std;
  @mods = grep(!$seen{$_}++, @mods);
  print TMP ExtUtils::Embed::xsi_header();
  print TMP "EXTERN_C void xs_init ($xsinit_proto);\n\n";
  print TMP ExtUtils::Embed::xsi_protos(@mods);
  print TMP "\nEXTERN_C void\nxs_init($xsinit_proto)\n{\n";
  print TMP ExtUtils::Embed::xsi_body(@mods);
  print TMP "}\n\n";
}
print TMP "static char SOURCE[] = {\n  ";
for(my $i=0;$i<$srclen;$i++){
  print TMP '0x'.unpack("H2",substr($source,$i,1));
  print TMP ((($i+1)%16) == 0)? ",\n  " : ', ';
}
print TMP "0x00\n};\n\n";
print TMP <<__END_OF_FUNCTION__;

int main(int argc,char **argv,char **envp){

  PerlInterpreter *my_perl;
  char **fake;
  int i;

  fake = (char**)malloc(sizeof(char**)*(argc+3));

  fake[0] = argv[0];
  fake[1] = "-e";
  fake[2] = "0";

  for(i=1;i<argc;i++){
    fake[(i+2)] = argv[i];
  }; fake[(argc+3)] = (char*)NULL;

  PERL_SYS_INIT3(&argc,&argv,&envp);

  my_perl = perl_alloc();
  perl_construct(my_perl);
  PL_perl_destruct_level = 0;

  perl_parse(my_perl,xs_init,(argc+2),fake,(char**)NULL);
  perl_run(my_perl);

  eval_pv(SOURCE,TRUE);

  perl_destruct(my_perl);
  perl_free(my_perl);

  PERL_SYS_TERM();

}
__END_OF_FUNCTION__
close TMP;

my $INCLUDE = "-I$Config{installarchlib}/CORE";
my $LIBPATH = "-L$Config{installarchlib}/CORE";

`$Config{cc} -O3 -o $output $tmpsrc -lperl $INCLUDE $LIBPATH`;

unlink $tmpsrc;
