initial skeleton import

git-svn-id: https://dagolden.googlecode.com/svn/Win32-Process-SafeTerminate/trunk@1805 dfce27d5-b31c-0410-bb09-030b4413eeba

Build.PL

@@ -0,0 +1,32 @@
+# Build.PL
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+use Module::Build;
+my $build = Module::Build->new(
+    module_name => 'Win32::Process::SafeTerminate',
+    dist_author => 'David Golden <dagolden@cpan.org>',
+    license => 'perl',
+    create_readme => 1,
+#   create_makefile_pl  => 'traditional',
+    requires => {
+        'perl' => '5.004',
+    },
+    build_requires => {
+        'Test::More' => 0.47,
+    },
+    meta_add            => { 
+        no_index => { 
+            directory => [ qw{
+                examples
+                inc
+                t
+            }],
+        } 
+    },
+);
+$build->create_build_script;
+

Changes

@@ -0,0 +1,11 @@
+# Changes
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+Revision history for Win32-Process-SafeTerminate
+
+0.01 Mon Mar  3 07:12:00 2008
+    - original skeleton created with Module::Boilerplate

INSTALL

@@ -0,0 +1,29 @@
+# INSTALL
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+INSTALLATION 
+
+This distribution may be installed via one of the following
+methods:
+
+
+1. If Build.PL exists and Module::Build is installed:
+
+    perl Build.PL
+    perl Build
+    perl Build test
+    perl Build install
+
+2. If Makefile.PL exists:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+If you are on a Windows machine you should use 
+'nmake' or 'dmake' rather than 'make'.

MANIFEST

@@ -0,0 +1,17 @@
+# Initial manifest generated by Module::Boilerplate
+lib/Win32/Process/SafeTerminate.pm
+t/01-Win32-Process-SafeTerminate.t
+Build.PL
+LICENSE
+INSTALL
+MANIFEST
+MANIFEST.SKIP
+README
+Changes
+Todo
+xt/pod-format.t
+xt/pod-coverage.t
+lib/Win32/Process/SafeTerminate.pm
+t/02-Win32-Process-SafeTerminate.t
+lib/Win32/Process/SafeTerminate.pm
+t/03-Win32-Process-SafeTerminate.t

MANIFEST.SKIP

@@ -0,0 +1,34 @@
+# MANIFEST.SKIP
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+# Version control files and dirs.
+\bRCS\b
+\bCVS\b
+,v$
+.svn/
+^.git
+
+# Generated by Perl module toolchain
+^MANIFEST\.(?!SKIP)
+^Makefile$
+^blib/
+^blibdirs$
+^PM_to_blib$
+^MakeMaker-\d
+^Build$
+^_build
+^cover_db
+^.*\.bat$
+
+# Temp, old, vi and emacs files.
+~$
+\.old$
+\#\.*\#$
+\.\#$
+\.swp$
+\.bak$
+^pod.*\.tmp$

README

@@ -0,0 +1,8 @@
+# README
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+

Todo

@@ -0,0 +1,10 @@
+# Todo
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+- Write some code
+- Write some tests
+- Replace boilerplate docs with real documentation

lib/Win32/Process/SafeTerminate.pm

@@ -0,0 +1,39 @@
+# lib/Win32/Process/SafeTerminate.pm
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+package Win32::Process::SafeTerminate;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+$VERSION = eval $VERSION; # convert '1.23_45' to 1.2345
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT_OK = ( 'safe_terminate' );
+
+require XSLoader;
+XSLoader::load('Win32::Process::SafeTerminate', $VERSION);
+
+1;
+
+__END__
+
+=begin wikidoc
+
+= NAME
+
+= ACKNOWLEDGEMENTS
+
+* SafeTerminateProcess adapted from article by Andrew Tucker 
+on Dr. Dobb's Portal: [http://www.ddj.com/windows/184416547] 
+* XS code and typemap adapted from [Win32::Process]
+
+=end wikidoc
+
+=cut

lib/Win32/Process/SafeTerminate.xs

@@ -0,0 +1,86 @@
+#include <stdlib.h>		// avoid BCC-5.0 brainmelt
+#include <math.h>		// avoid VC-5.0 brainmelt
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+#if defined(__cplusplus)
+#include <stdlib.h>
+extern "C" {
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.H"
+
+MODULE = Win32::Process::SafeTerminate PACKAGE = Win32::Process::SafeTerminate
+
+    #    SafeTerminateProcess adapted from article by Andrew Tucker 
+    #    on Dr. Dobb's Portal: http://www.ddj.com/windows/184416547 
+    #
+    #    Safely terminate a process by creating a remote thread
+    #    in the process that calls ExitProcess
+
+BOOL 
+SafeTerminateProcess(hProcess, uExitCode)
+    HANDLE hProcess
+    UINT uExitCode
+CODE:
+    DWORD dwTID, dwCode, dwErr = 0;
+    HANDLE hProcessDup = INVALID_HANDLE_VALUE;
+    HANDLE hRT = NULL;
+    HINSTANCE hKernel = GetModuleHandle("Kernel32");
+    BOOL bSuccess = FALSE;
+
+    BOOL bDup = DuplicateHandle(GetCurrentProcess(), 
+                                hProcess, 
+                                GetCurrentProcess(), 
+                                &hProcessDup, 
+                                PROCESS_ALL_ACCESS, 
+                                FALSE, 
+                                0);
+
+    // Detect the special case where the process is 
+    // already dead...
+    if ( GetExitCodeProcess((bDup) ? hProcessDup : hProcess, &dwCode) && 
+         (dwCode == STILL_ACTIVE) ) 
+    {
+        FARPROC pfnExitProc;
+
+        pfnExitProc = GetProcAddress(hKernel, "ExitProcess");
+
+        hRT = CreateRemoteThread((bDup) ? hProcessDup : hProcess, 
+                                 NULL, 
+                                 0, 
+                                 (LPTHREAD_START_ROUTINE)pfnExitProc,
+                                 (PVOID)uExitCode, 0, &dwTID);
+
+        if ( hRT == NULL )
+            dwErr = GetLastError();
+    }
+    else
+    {
+        dwErr = ERROR_PROCESS_ABORTED;
+    }
+
+
+    if ( hRT )
+    {
+        // Must wait process to terminate to 
+        // guarantee that it has exited...
+        WaitForSingleObject((bDup) ? hProcessDup : hProcess, 
+                            INFINITE);
+
+        CloseHandle(hRT);
+        bSuccess = TRUE;
+    }
+
+    if ( bDup )
+        CloseHandle(hProcessDup);
+
+    if ( !bSuccess )
+        SetLastError(dwErr);
+
+    RETVAL = bSuccess;
+OUTPUT:
+    RETVAL
+    uExitCode

t/01-Win32-Process-SafeTerminate.t

@@ -0,0 +1,14 @@
+# 01-Win32-Process-SafeTerminate.t
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+require_ok( 'Win32::Process::SafeTerminate' );
+

t/02-Win32-Process-SafeTerminate.t

@@ -0,0 +1,14 @@
+# 02-Win32-Process-SafeTerminate.t
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+require_ok( 'Win32::Process::SafeTerminate' );
+

t/03-Win32-Process-SafeTerminate.t

@@ -0,0 +1,14 @@
+# 03-Win32-Process-SafeTerminate.t
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+require_ok( 'Win32::Process::SafeTerminate' );
+

typemap

@@ -0,0 +1,10 @@
+UINT                    T_U_INT
+DWORD_PTR               T_UV
+DWORD                   T_NV
+DWORD *                 T_PV
+LPCSTR                  T_PV
+LPCTSTR                 T_PV
+BOOL                    T_IV
+LPTSTR                  T_PV
+HANDLE                  T_PTR
+

xt/pod-coverage.t

@@ -0,0 +1,30 @@
+# pod-coverage.t
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+use Test::More;
+
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+    if $@;
+
+my $min_pc = 0.17;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+    if $@;
+
+my @modules = all_modules('lib');
+
+plan tests => scalar @modules; 
+
+for my $mod ( @modules ) {
+    my $doc = "lib/$mod";
+    $doc =~ s{::}{/}g;
+    $doc = -f "$doc\.pod" ? "$doc\.pod" : "$doc\.pm" ;
+    pod_coverage_ok( $mod, { pod_from => $doc } );
+}
+

xt/pod-format.t

@@ -0,0 +1,14 @@
+# pod-format.t
+# Copyright (c) 2008 by David Golden. All rights reserved.
+# Licensed under terms of Perl itself (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a 
+# copy of the License from http://dev.perl.org/licenses/
+
+use Test::More;
+
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();