Alternative Time::Local algorithm that uses matemathical formula
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index 8d4b052..40b7511 100644 (file)
@@ -22,6 +22,7 @@
 #endif
 #include <winnt.h>
 #include <io.h>
+#include <signal.h>
 
 /* #include "config.h" */
 
@@ -1080,13 +1081,27 @@ win32_kill(int pid, int sig)
        /* it is a pseudo-forked child */
        child = find_pseudo_pid(-pid);
        if (child >= 0) {
-           if (!sig)
-               return 0;
            hProcess = w32_pseudo_child_handles[child];
-           if (TerminateThread(hProcess, sig)) {
-               remove_dead_pseudo_process(child);
+           switch (sig) {
+           case 0:
+               /* "Does process exist?" use of kill */
                return 0;
-           }
+           case 9:
+                /* kill -9 style un-graceful exit */
+               if (TerminateThread(hProcess, sig)) {
+                   remove_dead_pseudo_process(child);
+                   return 0;
+               }
+               break;
+           default:
+               /* We fake signals to pseudo-processes using Win32 message queue */
+               if (PostThreadMessage(-pid,WM_USER,sig,0)) {
+                   /* It might be us ... */ 
+                   PERL_ASYNC_CHECK();
+                   return 0;
+               }
+               break;
+            }
        }
        else if (IsWin95()) {
            pid = -pid;
@@ -1098,24 +1113,43 @@ win32_kill(int pid, int sig)
     {
        child = find_pid(pid);
        if (child >= 0) {
-           if (!sig)
+            hProcess = w32_child_handles[child];
+           switch(sig) {
+           case 0:
+               /* "Does process exist?" use of kill */
                return 0;
-           hProcess = w32_child_handles[child];
-           if (TerminateProcess(hProcess, sig)) {
-               remove_dead_process(child);
-               return 0;
-           }
+           case 2:
+               if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
+                   return 0;
+               break;
+           default: /* For now be backwards compatible with perl5.6 */
+           case 9:
+               if (TerminateProcess(hProcess, sig)) {
+                   remove_dead_process(child);
+                   return 0;
+               }
+               break;
+            }
        }
        else {
 alien_process:
            hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
                                   (IsWin95() ? -pid : pid));
            if (hProcess) {
-               if (!sig)
-                   return 0;
-               if (TerminateProcess(hProcess, sig)) {
-                   CloseHandle(hProcess);
+               switch(sig) {
+               case 0:
+                   /* "Does process exist?" use of kill */
                    return 0;
+               case 2:
+                   if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
+                       return 0;
+                   break;
+               default: /* For now be backwards compatible with perl5.6 */
+                case 9:
+                   if (TerminateProcess(hProcess, sig)) {
+                       CloseHandle(hProcess);
+                       return 0;
+                   }
                }
            }
        }
@@ -1685,18 +1719,33 @@ win32_async_check(pTHX)
 {
     MSG msg;
     int ours = 1;
-    while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) {
+    /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
+     * and ignores window messages - should co-exist better with windows apps e.g. Tk
+     */ 
+    while (PeekMessage(&msg, (HWND)-1, 0, 0, PM_REMOVE|PM_NOYIELD)) {
        switch(msg.message) {
 
-       /* plan to use WM_USER to fake kill() with other signals */
+#if 0
+    /* Perhaps some other messages could map to signals ? ... */
+        case WM_CLOSE:
+        case WM_QUIT: 
+           /* Treat WM_QUIT like SIGHUP?  */
+           CALL_FPTR(PL_sighandlerp)(1);
+           break;
+#endif
+
+       /* We use WM_USER to fake kill() with other signals */
        case WM_USER: {
+           CALL_FPTR(PL_sighandlerp)(msg.wParam);
            break;
        }
        
        case WM_TIMER: {
            /* alarm() is a one-shot but SetTimer() repeats so kill it */
-           KillTimer(NULL,w32_timerid);
-           w32_timerid=0;  
+           if (w32_timerid) {
+               KillTimer(NULL,w32_timerid);
+               w32_timerid=0;  
+            }
            /* Now fake a call to signal handler */
            CALL_FPTR(PL_sighandlerp)(14);
            break;
@@ -1710,7 +1759,9 @@ win32_async_check(pTHX)
            break;
        }
     }
+    w32_poll_count = 0;
 
+    /* Above or other stuff may have set a signal flag */
     if (PL_sig_pending) {
        despatch_signals();
     }
@@ -3527,7 +3578,12 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
            ret = -1;
            goto RETVAL;
        }
+       /* Create a new process group so we can use GenerateConsoleCtrlEvent() 
+        * in win32_kill()
+        */
+        create |= CREATE_NEW_PROCESS_GROUP;  
        /* FALL THROUGH */
+
     case P_WAIT:       /* synchronous execution */
        break;
     default:           /* invalid mode */
@@ -3611,6 +3667,9 @@ RETRY:
     else  {
        DWORD status;
        win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
+       /* FIXME: if msgwait returned due to message perhaps forward the
+          "signal" to the process
+         */
        GetExitCodeProcess(ProcessInformation.hProcess, &status);
        ret = (int)status;
        CloseHandle(ProcessInformation.hProcess);
@@ -4391,6 +4450,66 @@ Perl_init_os_extras(void)
      */
 }
 
+PerlInterpreter *
+win32_signal_context(void)
+{
+    dTHX;
+    if (!my_perl) {
+       my_perl = PL_curinterp;
+       PERL_SET_THX(my_perl);
+    } 
+    return my_perl;
+}
+
+BOOL WINAPI 
+win32_ctrlhandler(DWORD dwCtrlType)
+{
+    dTHXa(PERL_GET_SIG_CONTEXT);
+
+    if (!my_perl)
+       return FALSE;
+
+    switch(dwCtrlType) {
+    case CTRL_CLOSE_EVENT:
+     /*  A signal that the system sends to all processes attached to a console when 
+         the user closes the console (either by choosing the Close command from the 
+         console window's System menu, or by choosing the End Task command from the 
+         Task List
+      */
+       CALL_FPTR(PL_sighandlerp)(1); /* SIGHUP */
+       return TRUE;    
+
+    case CTRL_C_EVENT:
+       /*  A CTRL+c signal was received */
+       CALL_FPTR(PL_sighandlerp)(SIGINT); /* SIGINT */
+       return TRUE;    
+
+    case CTRL_BREAK_EVENT:
+       /*  A CTRL+BREAK signal was received */
+       CALL_FPTR(PL_sighandlerp)(SIGBREAK); /* unix calls it SIGQUIT */
+       return TRUE;    
+
+    case CTRL_LOGOFF_EVENT:
+      /*  A signal that the system sends to all console processes when a user is logging 
+          off. This signal does not indicate which user is logging off, so no 
+          assumptions can be made. 
+       */
+       break;  
+    case CTRL_SHUTDOWN_EVENT:
+      /*  A signal that the system sends to all console processes when the system is 
+          shutting down. 
+       */
+       CALL_FPTR(PL_sighandlerp)(SIGTERM); 
+       return TRUE;    
+       break;  
+    default:
+       break;  
+    }
+    return FALSE;
+}
+
+
 void
 Perl_win32_init(int *argcp, char ***argvp)
 {
@@ -4416,6 +4535,17 @@ win32_get_child_IO(child_IO_table* ptbl)
 
 #ifdef HAVE_INTERP_INTERN
 
+
+static void
+win32_csighandler(int sig)
+{
+#if 0
+    dTHXa(PERL_GET_SIG_CONTEXT);
+    Perl_warn(aTHX_ "Got signal %d",sig);
+#endif
+    /* Does nothing */
+}
+
 void
 Perl_sys_intern_init(pTHX)
 {
@@ -4431,6 +4561,15 @@ Perl_sys_intern_init(pTHX)
     w32_num_pseudo_children    = 0;
 #  endif
     w32_init_socktype          = 0;
+    w32_timerid                 = 0;
+    w32_poll_count              = 0;
+    if (my_perl == PL_curinterp) {
+        /* Force C runtime signal stuff to set its console handler */
+       signal(SIGINT,&win32_csighandler);
+       signal(SIGBREAK,&win32_csighandler);
+        /* Push our handler on top */
+       SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
+    }
 }
 
 void
@@ -4440,6 +4579,13 @@ Perl_sys_intern_clear(pTHX)
     Safefree(w32_perlshell_vec);
     /* NOTE: w32_fdpid is freed by sv_clean_all() */
     Safefree(w32_children);
+    if (w32_timerid) {
+       KillTimer(NULL,w32_timerid);
+       w32_timerid=0;  
+    }
+    if (my_perl == PL_curinterp) {
+       SetConsoleCtrlHandler(win32_ctrlhandler,FALSE);
+    }
 #  ifdef USE_ITHREADS
     Safefree(w32_pseudo_children);
 #  endif
@@ -4458,6 +4604,8 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     dst->pseudo_id             = 0;
     Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->thr_intern.Winit_socktype = 0;
+    dst->timerid                 = 0;
+    dst->poll_count              = 0;
 }
 #  endif /* USE_ITHREADS */
 #endif /* HAVE_INTERP_INTERN */