#include <string.h>
#include <stdarg.h>
#include <float.h>
++#include <time.h>
++#ifdef _MSC_VER
++#include <sys/utime.h>
++#else
++#include <utime.h>
++#endif
#ifdef __GNUC__
/* Mingw32 defaults to globing command line
static int do_spawn2(char *cmd, int exectype);
static BOOL has_redirection(char *ptr);
static long filetime_to_clock(PFILETIME ft);
++static BOOL filetime_from_time(PFILETIME ft, time_t t);
char * w32_perlshell_tokens = Nullch;
char ** w32_perlshell_vec;
return 0;
}
++/* fix utime() so it works on directories in NT
++ * thanks to Jan Dubois <jan.dubois@ibm.net>
++ */
++static BOOL
++filetime_from_time(PFILETIME pFileTime, time_t Time)
++{
++ struct tm *pTM = gmtime(&Time);
++ SYSTEMTIME SystemTime;
++
++ if (pTM == NULL)
++ return FALSE;
++
++ SystemTime.wYear = pTM->tm_year + 1900;
++ SystemTime.wMonth = pTM->tm_mon + 1;
++ SystemTime.wDay = pTM->tm_mday;
++ SystemTime.wHour = pTM->tm_hour;
++ SystemTime.wMinute = pTM->tm_min;
++ SystemTime.wSecond = pTM->tm_sec;
++ SystemTime.wMilliseconds = 0;
++
++ return SystemTimeToFileTime(&SystemTime, pFileTime);
++}
++
++DllExport int
++win32_utime(const char *filename, const struct utimbuf *times)
++{
++ HANDLE handle;
++ FILETIME ftCreate;
++ FILETIME ftAccess;
++ FILETIME ftWrite;
++ struct utimbuf TimeBuffer;
++
++ int rc = utime(filename,times);
++ /* EACCES: path specifies directory or readonly file */
++ if (rc == 0 || errno != EACCES /* || !IsWinNT() */)
++ return rc;
++
++ if (times == NULL) {
++ times = &TimeBuffer;
++ time(×->actime);
++ times->modtime = times->actime;
++ }
++
++ /* This will (and should) still fail on readonly files */
++ handle = CreateFile(filename, GENERIC_READ | GENERIC_WRITE,
++ FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
++ OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
++ if (handle == INVALID_HANDLE_VALUE)
++ return rc;
++
++ if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
++ filetime_from_time(&ftAccess, times->actime) &&
++ filetime_from_time(&ftWrite, times->modtime) &&
++ SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
++ {
++ rc = 0;
++ }
++
++ CloseHandle(handle);
++ return rc;
++}
++
DllExport int
win32_wait(int *status)
{
XSRETURN(1);
}
++static
++XS(w32_Sleep)
++{
++ dXSARGS;
++ if (items != 1)
++ croak("usage: Win32::Sleep($milliseconds)");
++ Sleep(SvIV(ST(0)));
++ XSRETURN_YES;
++}
++
void
Perl_init_os_extras()
{
char *file = __FILE__;
dXSUB_SYS;
-- /* XXX should be removed after checking with Nick */
-- newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
--
/* these names are Activeware compatible */
newXS("Win32::GetCwd", w32_GetCwd, file);
newXS("Win32::SetCwd", w32_SetCwd, file);
newXS("Win32::Spawn", w32_Spawn, file);
newXS("Win32::GetTickCount", w32_GetTickCount, file);
newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
++ newXS("Win32::Sleep", w32_Sleep, file);
/* XXX Bloat Alert! The following Activeware preloads really
* ought to be part of Win32::Sys::*, so they're not included
}
#endif
--
--
--
--
--
--
--
--