package Win32::PEPM::Build;

use strict;
use warnings;
use File::Slurp;
use ExtUtils::MakeMaker;

our $VERSION = '0.02';

push(@ExtUtils::MakeMaker::Overridable, qw(pm_to_blib));

#MZ files are EXE officially, COM files are different with a
#different (non-existant) header, Windows doesnt care about the ext
#for sanity to indiciate this isn't a Win32 EXE
sub makeCOM {
my $file = shift;
my $text = read_file($file, binmode => ':raw' );
my $crlf = index($text, "\r") != -1;
my $nl = $crlf ? "\r\n" : "\n";
#note, this will break if __END__ is in a string
my $pos = index($text, '__END__');
#stop following error caused by no __END__
#Unrecognized character \x12; marked by <-- HERE after <-- HERE near column 1 at
#C:/perl/***.pm line 154.
$text .= $nl.'__END__'.$nl if $pos == -1;
$text = 'MZ' #DOS MAGIC
    .';' #make the magic not be a syntax error
    .$nl.'#!!!!WARNING do not edit this file!!!!'.$nl
    .' ' #space pad to the heredoc
        x (0x40 #DOS headers full length
        -length($nl.'#!!!!WARNING do not edit this file!!!!'.$nl)
        -length('<<e_lfanew;'.$nl) #heredoc to escape
        -4 #size of DWORD e_lfanew
    .'<<e_lfanew;'.$nl #heredoc
    ."\x01\x01\x01\x01" #e_lfanew member, a U32/DWORD offset, will be overwritten by linker
    #end of 0x40 area, things below are now supposed executable space of the dos prog
    .$nl.'e_lfanew'.$nl.$nl #end quoting of the binary offset
    #note the "Rich Signature" appears here before PE header
    #after going through VC linker, the Rich Signature IS NOT uninitialized
    #memory leaking from VC linker due to our garbage MZ header with invalid
    #DOS executable lengths
write_file($file, {binmode => ':raw'},  $text);

sub WMHash {
    no warnings 'uninitialized';
    my $h = shift;
    #assymne VERSION_FROM is the master .pm for the module if a module has
    #multiple .pm files, the DLL will be placed in the master .pm and the 2
    #should be having the same base names that isn't being checked due to
    die 'Win32::PEPM::Build::WMHash VERSION_FROM EUMM key is required'
        unless $h->{VERSION_FROM};
    $h->{dynamic_lib} = {} if ref $h->{dynamic_lib} ne 'HASH';
    $h->{dynamic_lib}->{OTHERLDFLAGS} .= ' -stub:$(BASEEXT).com';
    $h->{dynamic_lib}->{INST_DYNAMIC} = '$(DLBASE).$(DLEXT)';

    $h->{clean} = {} if ref $h->{clean} ne 'HASH';
    $h->{clean}->{FILES} = $h->{clean}->{FILES}.' $(BASEEXT).com $(DLBASE).$(DLEXT)';

    my $oldpostamble;
    my $oldpm_to_blib;
    my $oldconstants;
    sub hookMY
        $oldpostamble = *MY::postamble{CODE};
        *MY::postamble =  sub {
            my $str = '';
            $str = &$oldpostamble(@_) if ($oldpostamble);
            return $str.'


	$(PERLRUN) -MWin32::PEPM::Build \

        $oldpm_to_blib = *MY::pm_to_blib{CODE};
        *MY::pm_to_blib =  sub {
            my $dlib;
                $dlib = &$oldpm_to_blib(@_);
            } else {
                package MY;
                my($self) = shift;
                $dlib = $self->SUPER::pm_to_blib(@_);
                package main;
            my $pos = index($dlib,'pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM)',0);
            die 'bad pm_to_blib match' if $pos == -1;
            $pos += length 'pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM)';
            substr($dlib, $pos, 0, ' $(INST_DYNAMIC)'); #depend on the DLL built
            $pos = index($dlib,'	$(NOECHO) $(TOUCH) pm_to_blib',0);
            die "bad pm_to_blib match" if $pos == -1;
            #file is copied twice, but for simplicity don't remove the 1st copying cmd
            #copy the DLL to the .pm, DLL already is a .pm after C linking
            #remove auto since there is no need to install the dll since it will be
            #inside the .pm #TODO it breaks nmake, nothing is installed then due to dep suddenly disappearing and being build once already
            substr($dlib, $pos, 0,
            return $dlib;

        $oldconstants = *MY::constants{CODE};
        *MY::constants =  sub {
            my $dlib;
                $dlib = &$oldconstants(@_);
            } else {
                package MY;
                my($self) = shift;
                $dlib = $self->SUPER::constants(@_);
                package main;
            my $pos = index($dlib,'INST_DYNAMIC     = $(INST_ARCHAUTODIR)\$(DLBASE).$(DLEXT)',0);
            die 'bad constants match' if $pos == -1;
            substr($dlib, $pos, length('INST_DYNAMIC     = $(INST_ARCHAUTODIR)\$(DLBASE).$(DLEXT)'),
                'INST_DYNAMIC     = $(DLBASE).$(DLEXT)');
            return $dlib;