win32/ipstdio.c

   1 /*
   2
   3         ipstdio.c
   4         Interface for perl stdio functions
   5
   6 */
   7
   8 #include "ipstdiowin.h"
   9 #include <stdio.h>
  10
  11 class CPerlStdIO : public IPerlStdIOWin
  12 {
  13 public:
  14         CPerlStdIO()
  15         {
  16                 pPerl = NULL;
  17                 pSock = NULL;
  18                 w32_platform = -1;
  19                 ZeroMemory(bSocketTable, sizeof(bSocketTable));
  20         };
  21         virtual PerlIO* Stdin(void);
  22         virtual PerlIO* Stdout(void);
  23         virtual PerlIO* Stderr(void);
  24         virtual PerlIO* Open(const char *, const char *, int &err);
  25         virtual int Close(PerlIO*, int &err);
  26         virtual int Eof(PerlIO*, int &err);
  27         virtual int Error(PerlIO*, int &err);
  28         virtual void Clearerr(PerlIO*, int &err);
  29         virtual int Getc(PerlIO*, int &err);
  30         virtual char* GetBase(PerlIO *, int &err);
  31         virtual int GetBufsiz(PerlIO *, int &err);
  32         virtual int GetCnt(PerlIO *, int &err);
  33         virtual char* GetPtr(PerlIO *, int &err);
  34         virtual int Putc(PerlIO*, int, int &err);
  35         virtual int Puts(PerlIO*, const char *, int &err);
  36         virtual int Flush(PerlIO*, int &err);
  37         virtual int Ungetc(PerlIO*,int, int &err);
  38         virtual int Fileno(PerlIO*, int &err);
  39         virtual PerlIO* Fdopen(int, const char *, int &err);
  40         virtual PerlIO* Reopen(const char*, const char*, PerlIO*, int &err);
  41         virtual SSize_t Read(PerlIO*,void *,Size_t, int &err);
  42         virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err);
  43         virtual void SetBuf(PerlIO *, char*, int &err);
  44         virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err);
  45         virtual void SetCnt(PerlIO *, int, int &err);
  46         virtual void SetPtrCnt(PerlIO *, char *, int, int& err);
  47         virtual void Setlinebuf(PerlIO*, int &err);
  48         virtual int Printf(PerlIO*, int &err, const char *,...);
  49         virtual int Vprintf(PerlIO*, int &err, const char *, va_list);
  50         virtual long Tell(PerlIO*, int &err);
  51         virtual int Seek(PerlIO*, off_t, int, int &err);
  52         virtual void Rewind(PerlIO*, int &err);
  53         virtual PerlIO* Tmpfile(int &err);
  54         virtual int Getpos(PerlIO*, Fpos_t *, int &err);
  55         virtual int Setpos(PerlIO*, const Fpos_t *, int &err);
  56         virtual void Init(int &err);
  57         virtual void InitOSExtras(void* p);
  58         virtual int OpenOSfhandle(long osfhandle, int flags);
  59         virtual int GetOSfhandle(int filenum);
  60
  61         void ShutDown(void);
  62
  63         inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
  64         inline void SetSockCtl(CPerlSock *p) { pSock = p; };
  65 protected:
  66         inline int IsWin95(void)
  67         {
  68                 return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
  69         };
  70         inline int IsWinNT(void)
  71         {
  72                 return (os_id() == VER_PLATFORM_WIN32_NT);
  73         };
  74         inline void AddToSocketTable(int fh)
  75         {
  76                 if(fh < _NSTREAM_)
  77                         bSocketTable[fh] = TRUE;
  78         };
  79         inline BOOL InSocketTable(int fh)
  80         {
  81                 if(fh < _NSTREAM_)
  82                         return bSocketTable[fh];
  83                 return FALSE;
  84         };
  85         inline void RemoveFromSocketTable(int fh)
  86         {
  87                 if(fh < _NSTREAM_)
  88                         bSocketTable[fh] = FALSE;
  89         };
  90         DWORD os_id(void)
  91         {
  92                 if((-1) == w32_platform)
  93                 {
  94                         OSVERSIONINFO osver;
  95
  96                         memset(&osver, 0, sizeof(OSVERSIONINFO));
  97                         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
  98                         GetVersionEx(&osver);
  99                         w32_platform = osver.dwPlatformId;
 100                 }
 101                 return (w32_platform);
 102         };
 103
 104
 105         CPerlObj *pPerl;
 106         CPerlSock *pSock;
 107         DWORD w32_platform;
 108         BOOL bSocketTable[_NSTREAM_];
 109 };
 110
 111 void CPerlStdIO::ShutDown(void)
 112 {
 113         int i, err;
 114         for(i = 0; i < _NSTREAM_; ++i)
 115         {
 116                 if(InSocketTable(i))
 117                         pSock->CloseSocket(i, err);
 118         }
 119 };
 120
 121 #ifdef _X86_
 122 extern "C" int __cdecl _alloc_osfhnd(void);
 123 extern "C" int __cdecl _set_osfhnd(int fh, long value);
 124 extern "C" void __cdecl _unlock(int);
 125
 126 #if (_MSC_VER >= 1000)
 127 typedef struct
 128 {
 129         long osfhnd;    /* underlying OS file HANDLE */
 130         char osfile;    /* attributes of file (e.g., open in text mode?) */
 131         char pipech;    /* one char buffer for handles opened on pipes */
 132 }       ioinfo;
 133 extern "C" ioinfo * __pioinfo[];
 134 #define IOINFO_L2E                      5
 135 #define IOINFO_ARRAY_ELTS       (1 << IOINFO_L2E)
 136 #define _pioinfo(i)     (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
 137 #define _osfile(i)      (_pioinfo(i)->osfile)
 138 #else
 139 extern "C" extern char _osfile[];
 140 #endif  // (_MSC_VER >= 1000)
 141
 142 #define FOPEN                   0x01    // file handle open
 143 #define FAPPEND                 0x20    // file handle opened O_APPEND
 144 #define FDEV                    0x40    // file handle refers to device
 145 #define FTEXT                   0x80    // file handle is in text mode
 146
 147 #define _STREAM_LOCKS   26              // Table of stream locks
 148 #define _LAST_STREAM_LOCK  (_STREAM_LOCKS+_NSTREAM_-1)  // Last stream lock
 149 #define _FH_LOCKS          (_LAST_STREAM_LOCK+1)                // Table of fh locks
 150 #endif  // _X86_
 151
 152 int CPerlStdIO::OpenOSfhandle(long osfhandle, int flags)
 153 {
 154         int fh;
 155
 156 #ifdef _X86_
 157         if(IsWin95())
 158         {
 159                 // all this is here to handle Win95's GetFileType bug.
 160                 char fileflags;         // _osfile flags
 161
 162                 // copy relevant flags from second parameter
 163                 fileflags = FDEV;
 164
 165                 if(flags & _O_APPEND)
 166                         fileflags |= FAPPEND;
 167
 168                 if(flags & _O_TEXT)
 169                         fileflags |= FTEXT;
 170
 171                 // attempt to allocate a C Runtime file handle
 172                 if((fh = _alloc_osfhnd()) == -1)
 173                 {
 174                         errno = EMFILE;         // too many open files
 175                         _doserrno = 0L;         // not an OS error
 176                         return -1;                      // return error to caller
 177                 }
 178
 179                 // the file is open. now, set the info in _osfhnd array
 180                 _set_osfhnd(fh, osfhandle);
 181
 182                 fileflags |= FOPEN;                     // mark as open
 183
 184 #if (_MSC_VER >= 1000)
 185                 _osfile(fh) = fileflags;        // set osfile entry
 186 #else
 187                 _osfile[fh] = fileflags;        // set osfile entry
 188 #endif
 189         }
 190         else
 191 #endif  // _X86_
 192         fh = _open_osfhandle(osfhandle, flags);
 193
 194         if(fh >= 0)
 195                 AddToSocketTable(fh);
 196
 197         return fh;                                      // return handle
 198 }
 199
 200 int CPerlStdIO::GetOSfhandle(int filenum)
 201 {
 202         return _get_osfhandle(filenum);
 203 }
 204
 205 PerlIO* CPerlStdIO::Stdin(void)
 206 {
 207     return (PerlIO*)(&_iob[0]);
 208 }
 209
 210 PerlIO* CPerlStdIO::Stdout(void)
 211 {
 212     return (PerlIO*)(&_iob[1]);
 213 }
 214
 215 PerlIO* CPerlStdIO::Stderr(void)
 216 {
 217     return (PerlIO*)(&_iob[2]);
 218 }
 219
 220 PerlIO* CPerlStdIO::Open(const char *path, const char *mode, int &err)
 221 {
 222         PerlIO* ret = NULL;
 223         if(*path != '\0')
 224         {
 225             if(stricmp(path, "/dev/null") == 0)
 226                         ret = (PerlIO*)fopen("NUL", mode);
 227                 else
 228                         ret = (PerlIO*)fopen(path, mode);
 229
 230                 if(errno)
 231                         err = errno;
 232         }
 233         else
 234                 err = EINVAL;
 235         return ret;
 236 }
 237
 238 extern "C" int _free_osfhnd(int fh);
 239 int CPerlStdIO::Close(PerlIO* pf, int &err)
 240 {
 241         int ret = 0, fileNo = fileno((FILE*)pf);
 242         if(InSocketTable(fileNo))
 243         {
 244                 RemoveFromSocketTable(fileNo);
 245                 pSock->CloseSocket(fileNo, err);
 246                 _free_osfhnd(fileNo);
 247                 fclose((FILE*)pf);
 248         }
 249         else
 250                 ret = fclose((FILE*)pf);
 251
 252         if(errno)
 253                 err = errno;
 254         return ret;
 255 }
 256
 257 int CPerlStdIO::Eof(PerlIO* pf, int &err)
 258 {
 259         int ret = feof((FILE*)pf);
 260         if(errno)
 261                 err = errno;
 262         return ret;
 263 }
 264
 265 int CPerlStdIO::Error(PerlIO* pf, int &err)
 266 {
 267         int ret = ferror((FILE*)pf);
 268         if(errno)
 269                 err = errno;
 270         return ret;
 271 }
 272
 273 void CPerlStdIO::Clearerr(PerlIO* pf, int &err)
 274 {
 275         clearerr((FILE*)pf);
 276         err = 0;
 277 }
 278
 279 int CPerlStdIO::Getc(PerlIO* pf, int &err)
 280 {
 281         int ret = fgetc((FILE*)pf);
 282         if(errno)
 283                 err = errno;
 284         return ret;
 285 }
 286
 287 int CPerlStdIO::Putc(PerlIO* pf, int c, int &err)
 288 {
 289         int ret = fputc(c, (FILE*)pf);
 290         if(errno)
 291                 err = errno;
 292         return ret;
 293 }
 294
 295 int CPerlStdIO::Puts(PerlIO* pf, const char *s, int &err)
 296 {
 297         int ret = fputs(s, (FILE*)pf);
 298         if(errno)
 299                 err = errno;
 300         return ret;
 301 }
 302
 303 int CPerlStdIO::Flush(PerlIO* pf, int &err)
 304 {
 305         int ret = fflush((FILE*)pf);
 306         if(errno)
 307                 err = errno;
 308         return ret;
 309 }
 310
 311 int CPerlStdIO::Ungetc(PerlIO* pf,int c, int &err)
 312 {
 313         int ret = ungetc(c, (FILE*)pf);
 314         if(errno)
 315                 err = errno;
 316         return ret;
 317 }
 318
 319 int CPerlStdIO::Fileno(PerlIO* pf, int &err)
 320 {
 321         int ret = fileno((FILE*)pf);
 322         if(errno)
 323                 err = errno;
 324         return ret;
 325 }
 326
 327 PerlIO* CPerlStdIO::Fdopen(int fh, const char *mode, int &err)
 328 {
 329         PerlIO* ret = (PerlIO*)fdopen(fh, mode);
 330         if(errno)
 331                 err = errno;
 332         return ret;
 333 }
 334
 335 PerlIO* CPerlStdIO::Reopen(const char* filename, const char* mode, PerlIO* pf, int &err)
 336 {
 337         PerlIO* ret = (PerlIO*)freopen(filename, mode, (FILE*)pf);
 338         if(errno)
 339                 err = errno;
 340         return ret;
 341 }
 342
 343 SSize_t CPerlStdIO::Read(PerlIO* pf, void * buffer, Size_t count, int &err)
 344 {
 345         size_t ret = fread(buffer, 1, count, (FILE*)pf);
 346         if(errno)
 347                 err = errno;
 348         return ret;
 349 }
 350
 351 SSize_t CPerlStdIO::Write(PerlIO* pf, const void * buffer, Size_t count, int &err)
 352 {
 353         size_t ret = fwrite(buffer, 1, count, (FILE*)pf);
 354         if(errno)
 355                 err = errno;
 356         return ret;
 357 }
 358
 359 void CPerlStdIO::Setlinebuf(PerlIO*pf, int &err)
 360 {
 361     setvbuf((FILE*)pf, NULL, _IOLBF, 0);
 362 }
 363
 364 int CPerlStdIO::Printf(PerlIO* pf, int &err, const char *format, ...)
 365 {
 366         va_list(arglist);
 367         va_start(arglist, format);
 368         int ret = Vprintf(pf, err, format, arglist);
 369         if(errno)
 370                 err = errno;
 371         return ret;
 372 }
 373
 374 int CPerlStdIO::Vprintf(PerlIO* pf, int &err, const char * format, va_list arg)
 375 {
 376         int ret = vfprintf((FILE*)pf, format, arg);
 377         if(errno)
 378                 err = errno;
 379         return ret;
 380 }
 381
 382 long CPerlStdIO::Tell(PerlIO* pf, int &err)
 383 {
 384         long ret = ftell((FILE*)pf);
 385         if(errno)
 386                 err = errno;
 387         return ret;
 388 }
 389
 390 int CPerlStdIO::Seek(PerlIO* pf, off_t offset, int origin, int &err)
 391 {
 392         int ret = fseek((FILE*)pf, offset, origin);
 393         if(errno)
 394                 err = errno;
 395         return ret;
 396 }
 397
 398 void CPerlStdIO::Rewind(PerlIO* pf, int &err)
 399 {
 400         rewind((FILE*)pf);
 401 }
 402
 403 PerlIO* CPerlStdIO::Tmpfile(int &err)
 404 {
 405         return (PerlIO*)tmpfile();
 406 }
 407
 408 int CPerlStdIO::Getpos(PerlIO* pf, Fpos_t *p, int &err)
 409 {
 410         int ret = fgetpos((FILE*)pf, (fpos_t*)p);
 411         if(errno)
 412                 err = errno;
 413         return ret;
 414 }
 415
 416 int CPerlStdIO::Setpos(PerlIO* pf, const Fpos_t *p, int &err)
 417 {
 418         int ret = fsetpos((FILE*)pf, (fpos_t*)p);
 419         if(errno)
 420                 err = errno;
 421         return ret;
 422 }
 423
 424 char* CPerlStdIO::GetBase(PerlIO *pf, int &err)
 425 {
 426         return ((FILE*)pf)->_base;
 427 }
 428
 429 int CPerlStdIO::GetBufsiz(PerlIO *pf, int &err)
 430 {
 431         return ((FILE*)pf)->_bufsiz;
 432 }
 433
 434 int CPerlStdIO::GetCnt(PerlIO *pf, int &err)
 435 {
 436         return ((FILE*)pf)->_cnt;
 437 }
 438
 439 char* CPerlStdIO::GetPtr(PerlIO *pf, int &err)
 440 {
 441         return ((FILE*)pf)->_ptr;
 442 }
 443
 444 void CPerlStdIO::SetBuf(PerlIO *pf, char* buffer, int &err)
 445 {
 446     setbuf((FILE*)pf, buffer);
 447 }
 448
 449 int CPerlStdIO::SetVBuf(PerlIO *pf, char* buffer, int type, Size_t size, int &err)
 450 {
 451     return setvbuf((FILE*)pf, buffer, type, size);
 452 }
 453
 454 void CPerlStdIO::SetCnt(PerlIO *pf, int n, int &err)
 455 {
 456         ((FILE*)pf)->_cnt = n;
 457 }
 458
 459 void CPerlStdIO::SetPtrCnt(PerlIO *pf, char *ptr, int n, int& err)
 460 {
 461         ((FILE*)pf)->_ptr = ptr;
 462         ((FILE*)pf)->_cnt = n;
 463 }
 464
 465 void CPerlStdIO::Init(int &err)
 466 {
 467 }
 468
 469
 470 static
 471 XS(w32_GetCwd)
 472 {
 473     dXSARGS;
 474     SV *sv = sv_newmortal();
 475     /* Make one call with zero size - return value is required size */
 476     DWORD len = GetCurrentDirectory((DWORD)0,NULL);
 477     SvUPGRADE(sv,SVt_PV);
 478     SvGROW(sv,len);
 479     SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
 480     /*
 481      * If result != 0
 482      *   then it worked, set PV valid,
 483      *   else leave it 'undef'
 484      */
 485     if (SvCUR(sv))
 486         SvPOK_on(sv);
 487     EXTEND(sp,1);
 488     ST(0) = sv;
 489     XSRETURN(1);
 490 }
 491
 492 static
 493 XS(w32_SetCwd)
 494 {
 495     dXSARGS;
 496     if (items != 1)
 497         croak("usage: Win32::SetCurrentDirectory($cwd)");
 498     if (SetCurrentDirectory(SvPV(ST(0),na)))
 499         XSRETURN_YES;
 500
 501     XSRETURN_NO;
 502 }
 503
 504 static
 505 XS(w32_GetNextAvailDrive)
 506 {
 507     dXSARGS;
 508     char ix = 'C';
 509     char root[] = "_:\\";
 510     while (ix <= 'Z') {
 511         root[0] = ix++;
 512         if (GetDriveType(root) == 1) {
 513             root[2] = '\0';
 514             XSRETURN_PV(root);
 515         }
 516     }
 517     XSRETURN_UNDEF;
 518 }
 519
 520 static
 521 XS(w32_GetLastError)
 522 {
 523     dXSARGS;
 524     XSRETURN_IV(GetLastError());
 525 }
 526
 527 static
 528 XS(w32_LoginName)
 529 {
 530     dXSARGS;
 531         char szBuffer[128];
 532     DWORD size = sizeof(szBuffer);
 533     if (GetUserName(szBuffer, &size)) {
 534         /* size includes NULL */
 535         ST(0) = sv_2mortal(newSVpv(szBuffer,size-1));
 536         XSRETURN(1);
 537     }
 538     XSRETURN_UNDEF;
 539 }
 540
 541 static
 542 XS(w32_NodeName)
 543 {
 544     dXSARGS;
 545     char name[MAX_COMPUTERNAME_LENGTH+1];
 546     DWORD size = sizeof(name);
 547     if (GetComputerName(name,&size)) {
 548         /* size does NOT include NULL :-( */
 549         ST(0) = sv_2mortal(newSVpv(name,size));
 550         XSRETURN(1);
 551     }
 552     XSRETURN_UNDEF;
 553 }
 554
 555
 556 static
 557 XS(w32_DomainName)
 558 {
 559     dXSARGS;
 560     char name[256];
 561     DWORD size = sizeof(name);
 562     if (GetUserName(name,&size)) {
 563         char sid[1024];
 564         DWORD sidlen = sizeof(sid);
 565         char dname[256];
 566         DWORD dnamelen = sizeof(dname);
 567         SID_NAME_USE snu;
 568         if (LookupAccountName(NULL, name, &sid, &sidlen,
 569                               dname, &dnamelen, &snu)) {
 570             XSRETURN_PV(dname);         /* all that for this */
 571         }
 572     }
 573     XSRETURN_UNDEF;
 574 }
 575
 576 static
 577 XS(w32_FsType)
 578 {
 579     dXSARGS;
 580     char fsname[256];
 581     DWORD flags, filecomplen;
 582     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
 583                          &flags, fsname, sizeof(fsname))) {
 584         if (GIMME == G_ARRAY) {
 585             XPUSHs(sv_2mortal(newSVpv(fsname,0)));
 586             XPUSHs(sv_2mortal(newSViv(flags)));
 587             XPUSHs(sv_2mortal(newSViv(filecomplen)));
 588             PUTBACK;
 589             return;
 590         }
 591         XSRETURN_PV(fsname);
 592     }
 593     XSRETURN_UNDEF;
 594 }
 595
 596 static
 597 XS(w32_GetOSVersion)
 598 {
 599     dXSARGS;
 600     OSVERSIONINFO osver;
 601
 602     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
 603     if (GetVersionEx(&osver)) {
 604         XPUSHs(newSVpv(osver.szCSDVersion, 0));
 605         XPUSHs(newSViv(osver.dwMajorVersion));
 606         XPUSHs(newSViv(osver.dwMinorVersion));
 607         XPUSHs(newSViv(osver.dwBuildNumber));
 608         XPUSHs(newSViv(osver.dwPlatformId));
 609         PUTBACK;
 610         return;
 611     }
 612     XSRETURN_UNDEF;
 613 }
 614
 615 static
 616 XS(w32_IsWinNT)
 617 {
 618     dXSARGS;
 619         OSVERSIONINFO osver;
 620         memset(&osver, 0, sizeof(OSVERSIONINFO));
 621         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
 622         GetVersionEx(&osver);
 623     XSRETURN_IV(VER_PLATFORM_WIN32_NT == osver.dwPlatformId);
 624 }
 625
 626 static
 627 XS(w32_IsWin95)
 628 {
 629     dXSARGS;
 630         OSVERSIONINFO osver;
 631         memset(&osver, 0, sizeof(OSVERSIONINFO));
 632         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
 633         GetVersionEx(&osver);
 634     XSRETURN_IV(VER_PLATFORM_WIN32_WINDOWS == osver.dwPlatformId);
 635 }
 636
 637 static
 638 XS(w32_FormatMessage)
 639 {
 640     dXSARGS;
 641     DWORD source = 0;
 642     char msgbuf[1024];
 643
 644     if (items != 1)
 645         croak("usage: Win32::FormatMessage($errno)");
 646
 647     if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
 648                       &source, SvIV(ST(0)), 0,
 649                       msgbuf, sizeof(msgbuf)-1, NULL))
 650         XSRETURN_PV(msgbuf);
 651
 652     XSRETURN_UNDEF;
 653 }
 654
 655 static
 656 XS(w32_Spawn)
 657 {
 658     dXSARGS;
 659     char *cmd, *args;
 660     PROCESS_INFORMATION stProcInfo;
 661     STARTUPINFO stStartInfo;
 662     BOOL bSuccess = FALSE;
 663
 664     if(items != 3)
 665         croak("usage: Win32::Spawn($cmdName, $args, $PID)");
 666
 667     cmd = SvPV(ST(0),na);
 668     args = SvPV(ST(1), na);
 669
 670     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
 671     stStartInfo.cb = sizeof(stStartInfo);           /* Set the structure size */
 672     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;     /* Enable wShowWindow control */
 673     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
 674
 675     if(CreateProcess(
 676                 cmd,                    /* Image path */
 677                 args,                   /* Arguments for command line */
 678                 NULL,                   /* Default process security */
 679                 NULL,                   /* Default thread security */
 680                 FALSE,                  /* Must be TRUE to use std handles */
 681                 NORMAL_PRIORITY_CLASS,  /* No special scheduling */
 682                 NULL,                   /* Inherit our environment block */
 683                 NULL,                   /* Inherit our currrent directory */
 684                 &stStartInfo,           /* -> Startup info */
 685                 &stProcInfo))           /* <- Process info (if OK) */
 686     {
 687         CloseHandle(stProcInfo.hThread);/* library source code does this. */
 688         sv_setiv(ST(2), stProcInfo.dwProcessId);
 689         bSuccess = TRUE;
 690     }
 691     XSRETURN_IV(bSuccess);
 692 }
 693
 694 static
 695 XS(w32_GetTickCount)
 696 {
 697     dXSARGS;
 698     XSRETURN_IV(GetTickCount());
 699 }
 700
 701 static
 702 XS(w32_GetShortPathName)
 703 {
 704     dXSARGS;
 705     SV *shortpath;
 706     DWORD len;
 707
 708     if(items != 1)
 709         croak("usage: Win32::GetShortPathName($longPathName)");
 710
 711     shortpath = sv_mortalcopy(ST(0));
 712     SvUPGRADE(shortpath, SVt_PV);
 713     /* src == target is allowed */
 714     do {
 715         len = GetShortPathName(SvPVX(shortpath),
 716                                SvPVX(shortpath),
 717                                SvLEN(shortpath));
 718     } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
 719     if (len) {
 720         SvCUR_set(shortpath,len);
 721         ST(0) = shortpath;
 722     }
 723     else
 724         ST(0) = &sv_undef;
 725     XSRETURN(1);
 726 }
 727
 728
 729 void CPerlStdIO::InitOSExtras(void* p)
 730 {
 731     char *file = __FILE__;
 732     dXSUB_SYS;
 733
 734     /* XXX should be removed after checking with Nick */
 735     newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
 736
 737     /* these names are Activeware compatible */
 738     newXS("Win32::GetCwd", w32_GetCwd, file);
 739     newXS("Win32::SetCwd", w32_SetCwd, file);
 740     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
 741     newXS("Win32::GetLastError", w32_GetLastError, file);
 742     newXS("Win32::LoginName", w32_LoginName, file);
 743     newXS("Win32::NodeName", w32_NodeName, file);
 744     newXS("Win32::DomainName", w32_DomainName, file);
 745     newXS("Win32::FsType", w32_FsType, file);
 746     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
 747     newXS("Win32::IsWinNT", w32_IsWinNT, file);
 748     newXS("Win32::IsWin95", w32_IsWin95, file);
 749     newXS("Win32::FormatMessage", w32_FormatMessage, file);
 750     newXS("Win32::Spawn", w32_Spawn, file);
 751     newXS("Win32::GetTickCount", w32_GetTickCount, file);
 752     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
 753
 754 }
 755
 756