Ticket #677: 677-win32-launcher-2.patch

win32/README

@@ -1 +1 @@
 README for padre.exe
 
 This is Padre's win32 launcher. It does the following:
-    * Tries to find wperl.exe in the executable path. If it fails, it exits 
-        with a message.
-    * Tries to find padre script in the executable path. If it fails, it exits 
-        with a message.
-    * Runs %padre_exe_path%\wperl.exe %padre_exe_path%\padre.
+    * Tries to find the padre script in the same directory as padre.exe
+          If it fails, it exits with a message box.
+    * Tries to find wperl.exe in the executable path.
+      If it succeed, it will set $^X to this path.
+    * Creates a Perl interpreter and run the padre script.
 
-To compile it, simply 'perl Makefile.PL' or 'cpan .' in the parent folder. You'll
-ofcourse need Strawberry Perl as it has gcc and windres out of the box.
+Padre.exe is dynamically linked to the perl<xxx>.dll on which it was built, so
+it is safer to build it at install time on a user machine.
+
+To compile it, simply 'perl Makefile.PL' or 'cpan .' in the parent folder.
+You'll of course need Strawberry Perl as it has gcc and windres out of the box.

win32/padre.c

@@ -1 +1 @@
 /**
- * Padre Minimal Win32 Executable Launcher
- * @author Ahmad M. Zawawi <ahmad.zawawi@gmail.com>
+ * Padre Win32 executable Launcher
  * @author Olivier Mengué <dolmen@cpan.org>
  */
 #define WIN32_LEAN_AND_MEAN
 #define STRICT
+
+#define _WIN32_WINNT 0x0501
 #include <windows.h>
 #include <tchar.h>
 
+
+#include <EXTERN.h>               /* from the Perl distribution     */
+#include <perl.h>                 /* from the Perl distribution     */
+
 #include "padre-rc.h"
 
+
 static void LocalizedMessageBox(LPCTSTR lpMessage, LPCTSTR lpTitle, DWORD dwFlags)
 {
     HMODULE hModule;
@@ -34 +40 @@
     return (att != INVALID_FILE_ATTRIBUTES); //&& (att & (FILE_ATTRIBUTE_DEVICE|FILE_ATTRIBUTE_DIRECTORY) == 0);
 }
 
+static int GetDirectory(LPTSTR lpDir, LPCTSTR lpFilename, int iBufSize)
+{
+    int len, len2;
+    LPCTSTR p;
+    LPTSTR q;
 
-/**
- * When called by windows, we simply launch Padre from here
- */
-#ifdef Mini1
-VOID WINAPI __main(VOID)
-#elif defined(Mini2)
-VOID WINAPI WinMainCRTStartup(VOID)
-#else
-int WINAPI WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance,
-    LPSTR lpCmdLineArgs, int nCmdShow)
-#endif
+    len = lstrlen(lpFilename);
+    if (len == 0) {
+        lpDir[0] = _T('\0');
+        return 0;
+    }
+    p = lpFilename + len;
+    while (--p > lpFilename) {
+        if (*p == _T('\\') || *p == _T('/'))
+            break;
+    };
+    len = p - lpFilename;
+    if (lpDir == lpFilename) {
+        *(LPTSTR)p = _T('\0');
+    } else {
+        if (len+1 > iBufSize) {
+            lpDir[0] = _T('\0');
+            return 0;
+        }
+        p = lpFilename;
+        q = lpDir;
+        len2 = len;
+        while (len2--)
+            *q++ = *p++;
+        *q = _T('\0');
+    }
+    return len;
+}
+
+
+
+/* From win32/perllib.c  - begin */
+// This the special part that is not documented in perlembed
+
+EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
+
+static void
+xs_init(pTHX)
 {
+    char *file = __FILE__;
+    dXSUB_SYS;
+    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+/* From win32/perllib.c  - end */
+
+
+
+
+
+
+int main(int argc, char **argv, char **env)
+{
     // Padre.exe path
     TCHAR szExePath[MAX_PATH];
-    // WPerl.exe path
-    TCHAR szWPerl[MAX_PATH];
     // Padre script path
     TCHAR szPadre[MAX_PATH];
-    // WPerl Command line
-    TCHAR szCmdLine[1024+1];
-    HMODULE hModule;
-    STARTUPINFO si;
-    PROCESS_INFORMATION pi;
-    BOOL bSuccess;
+    // wperl.exe path
+    TCHAR szWPerlExePath[MAX_PATH];
+    HMODULE hModule, hModulePerlDll;
     DWORD dwLength;
-    LPCTSTR lpArgs;
+    HANDLE hHeap;
+    char **new_argv;
+    PerlInterpreter *my_perl;  /***    The Perl interpreter    ***/
+    int i;
+    int exitcode;
 
     hModule = GetModuleHandle(NULL);
-    //Find the the executable's path
+    // Find the the executable's path
     dwLength = GetModuleFileName(hModule, szExePath, sizeof(szExePath)/sizeof(szExePath[0]));
-    if (dwLength) {
-        while (dwLength && szExePath[ dwLength ] != '\\' && szExePath[ dwLength ] != '/') {
-            dwLength--;
-        }
-        szExePath[ dwLength + 1 ] = '\0';
-    }
 
-#if 0
-    lstrcpy(szWPerl, _T("C:\\strawberry\\perl\\bin\\wperl.exe"));
-#else
-    lstrcpy(szWPerl, szExePath);
-    lstrcpy(&szWPerl[dwLength+1], _T("wperl.exe"));
-#endif
 
-    //At this point we should check if wperl.exe exists or not
-    if (! FileExists(szWPerl)) {
-        //if it does not exist, let us try to find it
-        //in ..\..\bin (to support vendor perl)
-        //see ticket #837
-        lstrcpy(szWPerl, szExePath);
-        lstrcpy(szWPerl, _T("..\\..\\bin\\wperl.exe") );
+    // Build the 'padre' script path
+    dwLength = GetDirectory(szPadre, szExePath, sizeof(szPadre)/sizeof(szPadre[0]));
+    lstrcpy(szPadre+dwLength, _T("\\padre"));
+    //MessageBox(NULL, szPadre, "Padre", MB_OK|MB_ICONINFORMATION);
 
-        //Display an error message if wperl.exe is not found
-        if (! FileExists(szWPerl)) {
-            LocalizedMessageBox(MAKEINTRESOURCE(IDS_ERR_WPERL), MAKEINTRESOURCE(IDS_APP_TITLE), MB_OK|MB_ICONERROR);
-            ExitProcess(1);
-        }
+    // At this point we should check if padre script exists or not
+    if (! FileExists(szPadre)) {
+        LocalizedMessageBox(MAKEINTRESOURCE(IDS_ERR_SCRIPT), MAKEINTRESOURCE(IDS_APP_TITLE), MB_OK|MB_ICONERROR);
+        return 1;
     }
 
+    // Rewrite the command line to insert the padre script
+    hHeap = GetProcessHeap();
+    new_argv = HeapAlloc(hHeap, 0, (argc+2)*sizeof(new_argv[0]));
+    new_argv[0] = argv[0];
+    new_argv[1] = "--";
+    new_argv[2] = szPadre;
+    for(i=1; i<argc; i++)
+        new_argv[i+2] = argv[i];
+    argc += 2;
+    argv = new_argv;
 
-    // Build the 'padre' script path
-    lstrcpy(szPadre, szExePath);
-    lstrcpy(&szPadre[dwLength+1], _T("padre"));
+    // We must set $^X to wperl.exe
+    // We do that by changing argv[0]
 
-    //At this point we should check if padre script exists or not
-    if (! FileExists(szPadre)) {
-        LocalizedMessageBox(MAKEINTRESOURCE(IDS_ERR_SCRIPT), MAKEINTRESOURCE(IDS_APP_TITLE), MB_OK|MB_ICONERROR);
-        ExitProcess(1);
+    // Get the module of the Perl DLL to which we have been linked
+    // as this is where wperl.exe is.
+    if (GetModuleHandleEx(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS
+                        | GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT,
+                        (LPCTSTR)RunPerl, &hModulePerlDll)
+            && hModulePerlDll != hModule) {
+        // If hModulePerlDll == hModule, we have to for another function
+
+        dwLength = GetModuleFileName(hModulePerlDll, szWPerlExePath,
+                    sizeof(szWPerlExePath)/sizeof(szWPerlExePath[0]));
+        //MessageBox(NULL, szWPerlExePath, "Padre", MB_OK|MB_ICONINFORMATION);
+        dwLength = GetDirectory(szWPerlExePath, szWPerlExePath,
+                    sizeof(szWPerlExePath)/sizeof(szWPerlExePath[0]));
+        lstrcpy(szWPerlExePath+dwLength, _T("\\wperl.exe"));
+        if (FileExists(szWPerlExePath))
+            argv[0] = szWPerlExePath;
     }
 
-    lpArgs = GetCommandLine();
-    //LocalizedMessageBox(lpArgs, MAKEINTRESOURCE(IDS_APP_TITLE), MB_OK|MB_ICONINFORMATION);
-    do {
-        while (*lpArgs == _T(' ') || *lpArgs == _T('\t')) lpArgs++;
-        if (!*lpArgs) break;
-        if (*lpArgs == _T('"')) {
-            lpArgs++;
-            while (*lpArgs && *lpArgs != _T('"')) lpArgs++;
-            if (*lpArgs == _T('"')) lpArgs++;
-        } else {
-            while (*lpArgs && *lpArgs != _T(' ') && *lpArgs != _T('\t')) lpArgs++;
-        }
-    } while (0);
-    // Build the command line
-    wsprintf(szCmdLine, "\"%s\" \"%s\"%s", szWPerl, szPadre, lpArgs);
-    szCmdLine[(sizeof(szCmdLine)/sizeof(szCmdLine[0]))-1] = '\0';
+    //MessageBox(NULL, argv[0], "Padre", MB_OK|MB_ICONINFORMATION);
+    
+#if 0
+    /*
+     * Unfortunately it seems RunPerl() ignores the changed argv[0] and
+     * overrides argv[0] so that $^X is still Padre.exe
+     */
+    exitcode = RunPerl(argc, argv, env);
+#else
 
-    ZeroMemory( &pi, sizeof(pi) );
-    GetStartupInfo(&si);
-    //LocalizedMessageBox(szCmdLine, MAKEINTRESOURCE(IDS_APP_TITLE), MB_OK|MB_ICONINFORMATION);
-    bSuccess = CreateProcess(szWPerl,
-                             szCmdLine,
-                             NULL,
-                             NULL,
-                             TRUE,
-                             GetPriorityClass(hModule),
-                             GetEnvironmentStrings(),
-                             NULL,
-                             &si,
-                             &pi);
-    if (bSuccess) {
-        //WaitForSingleObject( pi.hProcess, INFINITE );
-        CloseHandle(pi.hProcess);
-        CloseHandle(pi.hThread);
+#if defined(TOP_CLONE) && defined(USE_ITHREADS)
+    // See the RunPerl source
+    MessageBox(NULL, "FIXME: ithreads support not implemented in Padre.exe launcher!", "Padre", MB_OK|MB_ICONERROR);
+#endif
+
+    /* This is derived from the source of RunPerl() */
+
+    PERL_SYS_INIT3(&argc, &argv, &env);
+    if (!(my_perl = perl_alloc())) {
+        MessageBox(NULL, "Can't allocate Perl interpreter!", "Padre", MB_OK|MB_ICONERROR);
+        exitcode = 1;
     } else {
-        LocalizedMessageBox(MAKEINTRESOURCE(IDS_ERR_RUN), MAKEINTRESOURCE(IDS_APP_TITLE), MB_OK|MB_ICONERROR);
+        perl_construct(my_perl);
+        PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+        PL_perl_destruct_level = 0;
+        exitcode = perl_parse(my_perl, xs_init, argc, argv, env)
+                || perl_run(my_perl);
+        perl_destruct(my_perl);
+        perl_free(my_perl);
     }
+    PERL_SYS_TERM();
 
-    // The application's return value
-    ExitProcess(0);
+#endif
+
+    HeapFree(hHeap, 0, new_argv);
+    return exitcode;
 }
 /**
 # Copyright 2008-2010 The Padre development team as listed in Padre.pm.

win32/wperl.exe.manifest

@@ -1 @@
-<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
-<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
-
-    <assemblyIdentity
-        version="5.0.0.0"
-        processorArchitecture="x86"
-        name="wperl.exe"
-        type="win32"
-    />
-    <description>wperl</description>
-
-    <!-- Enable XP/Vista-style themes -->
-    <dependency>
-        <dependentAssembly>
-            <assemblyIdentity
-                type="win32"
-                name="Microsoft.Windows.Common-Controls"
-                version="6.0.0.0"
-                processorArchitecture="X86"
-                publicKeyToken="6595b64144ccf1df"
-                language="*"
-            />
-        </dependentAssembly>
-    </dependency>
-
-    <!-- Identify the application security requirements. -->
-    <ms_asmv2:trustInfo xmlns:ms_asmv2="urn:schemas-microsoft-com:asm.v2">
-        <ms_asmv2:security>
-            <ms_asmv2:requestedPrivileges>
-                <ms_asmv2:requestedExecutionLevel
-                    level="asInvoker" uiAccess="false"/>
-            </ms_asmv2:requestedPrivileges>
-        </ms_asmv2:security>
-    </ms_asmv2:trustInfo>
-
-</assembly>
- No newline at end of file

win32/padre.exe.manifest

@@ -2 +2 @@
 <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
 
     <assemblyIdentity
-        version="5.0.0.0"
+        version="0.58.0.0"
         processorArchitecture="x86"
-        name="wperl.exe"
+        name="Padre"
         type="win32"
     />
-    <description>wperl</description>
+    <description>Padre - The Perl IDE</description>
 
     <!-- Enable XP/Vista-style themes -->
     <dependency>
@@ -33 +33 @@
         </ms_asmv2:security>
     </ms_asmv2:trustInfo>
 
-</assembly>
- No newline at end of file
+</assembly>

win32/padre-rc.rc

@@ -12 +12 @@
 
 IDI_APP ICON DISCARDABLE "padre.ico"
 
+// Embed the manifest in the exe
+// http://msdn.microsoft.com/fr-fr/library/bb773175%28en-us,VS.85%29.aspx
+CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "padre.exe.manifest"
 
+
 // Languages list:
 // http://msdn.microsoft.com/en-us/library/dd318693%28VS.85%29.aspx
 
@@ -20 +24 @@
 LANGUAGE LANG_FRENCH, SUBLANG_FRENCH
 BEGIN
    IDS_APP_TITLE,  "Padre"
-   IDS_ERR_WPERL,  "Fichier « WPerl.exe » introuvable !"
+   IDS_ERR_WPERL,  "Programme « WPerl.exe » introuvable !"
    IDS_ERR_SCRIPT, "Script « padre » introuvable !"
    IDS_ERR_RUN,    "Echec du lancement du script avec « padre » avec « WPerl.exe » !"
 END

privinc/Module/Install/PRIVATE/Padre.pm

@@ -8 +8 @@
 use FindBin    ();
 use File::Find ();
 
+# For building the Win32 launcher
+use Config;
+use ExtUtils::Embed;
+
 our $VERSION = '0.26';
 use base qw{ Module::Install::Base };
 
@@ -245 +249 @@
     # Create the blib/bin folder
     system $^X , qw[-MExtUtils::Command -e mkpath --], $bin;
 
+    # TODO update the version number in win32/padre.exe.manifest
+
     # Step 1: Make sure we do not have old files
-    unlink "$src/padre-rc.o" if -f "$src/padre-rc.o";
+    my @temp_files = map {"$src/$_"} qw[ padre-rc.res perlxsi.c ];
+    map { unlink } (grep { -f } @temp_files);
 
     # Step 2: Build Padre's win32 resource using windres
-    system qq[cd $src && windres padre-rc.rc padre-rc.o];
+    system qq[cd $src && windres --input padre-rc.rc --output padre-rc.res --output-format=coff];
 
-    # Step 3: Build padre.exe using gcc
-    system "cd $src && gcc -Wall -Os -mwin32 -mwindows -Wl,-s padre.c padre-rc.o -o ../$bin/padre.exe";
+    # Step 3: Generate xs_init() function for static libraries
+    xsinit("$src/perlxsi.c", 0);
 
-    # Step 4: Remove temporary files
-    unlink "$src/padre-rc.o" if -f "$src/padre-rc.o";
+    # Step 4: Build padre.exe using $Config{cc}
+    system "cd $src && $Config{cc} -mwin32 -mwindows -Wl,-s padre.c perlxsi.c padre-rc.res -o ../$bin/padre.exe ".ccopts.ldopts;
 
-    # Step 5: Install XP manifest to get a themed Padre
-    system $^X , qw[-MExtUtils::Command -e cp --], "$src/wperl.exe.manifest", "$bin/wperl.exe.manifest";
+    # Step 5: Remove temporary files
+    map { unlink } (grep { -f } @temp_files);
 }
 
 1;