This is a patch to go from libwin32 v0.16 to v0.171. This is somewhat
unofficial because I don't have the tuits to make a real release just now,
but since ActivePerl build 618 contains this version of libwin32, I
thought I'd show you what's in it sooner rather than later.
Apply with:
cd libwin32-0.16
patch -p1 -N < this_file
Enjoy.
Gurusamy Sarathy
[email protected]
------------------------------------8<------------------------------------
diff -ur libwin32-0.16/APIRegistry/Registry.xs libwin32-0.171/APIRegistry/Registry.xs
--- libwin32-0.16/APIRegistry/Registry.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/APIRegistry/Registry.xs Tue Sep 19 16:39:21 2000
@@ -484,7 +484,7 @@
}
RETVAL= ErrorRet( uErr );
/* Traim trailing '\0' from REG*_SZ values if iolData was C<[]>: */
- if( RETVAL && NULL != opData && NULL != ouType
+ if( RETVAL && NULL != opData && NULL != ouType && *iolData
&& ( REG_SZ == *ouType || REG_EXPAND_SZ == *ouType )
&& null_arg(ST(7)) && '\0' == opData[*iolData-1] )
--*iolData;
@@ -529,6 +529,7 @@
RETVAL= ErrorRet( uErr );
/* Traim trailing L'\0' from REG*_SZ values if iolData was C<[]>: */
if( RETVAL && NULL != opData && NULL != ouType
+ && *iolData >= sizeof(WCHAR)
&& ( REG_SZ == *ouType || REG_EXPAND_SZ == *ouType )
&& null_arg(ST(7))
&& L'\0' == ((WCHAR *)opData)[(*iolData/sizeof(WCHAR))-1] )
@@ -901,7 +902,7 @@
}
RETVAL= ErrorRet( uErr );
/* Traim trailing '\0' from REG*_SZ values if iolData was C<[]>: */
- if( RETVAL && NULL != opData && NULL != ouType
+ if( RETVAL && NULL != opData && NULL != ouType && *iolData
&& ( REG_SZ == *ouType || REG_EXPAND_SZ == *ouType )
&& null_arg(ST(5)) && '\0' == opData[*iolData-1] )
--*iolData;
@@ -938,6 +939,7 @@
RETVAL= ErrorRet( uErr );
/* Traim trailing L'\0' from REG*_SZ vals if iolData was C<[]>: */
if( RETVAL && NULL != opData && NULL != ouType
+ && *iolData >= sizeof(WCHAR)
&& ( REG_SZ == *ouType || REG_EXPAND_SZ == *ouType )
&& null_arg(ST(5))
&& L'\0' == ((WCHAR *)opData)[(*iolData/sizeof(WCHAR))-1] )
diff -ur libwin32-0.16/Changes libwin32-0.171/Changes
--- libwin32-0.16/Changes Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/Changes Tue Sep 19 16:39:21 2000
@@ -1,6 +1,8 @@
Revision history for Perl extension libwin32.
+0.17 (unreleased)
+
0.16 Mon May 22 22:16:41 2000
+ Support for building under Perl 5.6.0.
diff -ur libwin32-0.16/Console/Console.pm libwin32-0.171/Console/Console.pm
--- libwin32-0.16/Console/Console.pm Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/Console/Console.pm Tue Sep 19 16:39:21 2000
@@ -1,7 +1,7 @@
package Win32::Console;
#######################################################################
#
-# Win32::Console - Perl Module for Windows Clipboard Interaction
+# Win32::Console - Win32 Console and Character Mode Functions
# ^^^^^^^^^^^^^^
# Version: 0.03 (07 Apr 1997)
# Version: 0.031 (24 Sep 1999) - fixed typo in GenerateCtrlEvent()
diff -ur libwin32-0.16/EventLog/Changes libwin32-0.171/EventLog/Changes
--- libwin32-0.16/EventLog/Changes Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/EventLog/Changes Tue Sep 19 16:39:21 2000
@@ -1,5 +1,9 @@
Revision history for Perl extension Win32::EventLog.
+0.071 Fri Aug 25 12:34:56 2000
+ - remove limit of 16 fields for GetEventLogText
+ - fix endless loop problem in GetEventLogText
+
0.07 Mon May 22 21:02:26 2000
- support for passing Unicode strings to underlying calls (thanks
to Jan Dubois <
[email protected]>)
diff -ur libwin32-0.16/EventLog/EventLog.pm libwin32-0.171/EventLog/EventLog.pm
--- libwin32-0.16/EventLog/EventLog.pm Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/EventLog/EventLog.pm Tue Sep 19 16:39:21 2000
@@ -9,7 +9,7 @@
use strict;
use vars qw($VERSION $AUTOLOAD @ISA @EXPORT $GetMessageText);
-$VERSION = '0.07';
+$VERSION = '0.071';
require Exporter;
require DynaLoader;
diff -ur libwin32-0.16/EventLog/EventLog.xs libwin32-0.171/EventLog/EventLog.xs
--- libwin32-0.16/EventLog/EventLog.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/EventLog/EventLog.xs Tue Sep 19 16:39:21 2000
@@ -417,7 +417,7 @@
if (USING_WIDE()) {
static const WCHAR *wEVFILE[] = {L"System", L"Security", L"Application"};
WCHAR *ptr, *tmpx;
- WCHAR wmsgfile[MAX_PATH], wregPath[MAX_PATH], *wstrings[16];
+ WCHAR wmsgfile[MAX_PATH], wregPath[MAX_PATH], **wstrings;
WCHAR wsource[MAX_PATH+1], *wMsgBuf, *wlongstring;
char *MsgBuf;
DWORD i, id2;
@@ -427,6 +427,8 @@
WCHAR *percent;
int percentLen, msgLen;
+ New(0, wstrings, numstrings+1, WCHAR*);
+
/* Which EventLog are we reading? */
New(0, wlongstring, length, WCHAR);
@@ -480,32 +482,32 @@
RegCloseKey(hk);
XSRETURN_NO;
}
-
- if (FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER
- | FORMAT_MESSAGE_FROM_HMODULE
- | FORMAT_MESSAGE_ARGUMENT_ARRAY,
- dll, id2, 0, (LPWSTR)&wMsgBuf, 0,
- (va_list*)&wstrings[j]) == 0)
- {
- FreeLibrary(dll);
- RegCloseKey(hk);
- XSRETURN_NO;
- }
+ }
- percentLen = 2; /* for %% */
- do {
- percentLen++;
- } while (id2/=10); /* compute length of %%xxx string */
-
- msgLen = wcslen(wMsgBuf);
- Newz(0, tmpx, wcslen(wstrings[j])+msgLen-percentLen+1, WCHAR);
- wcsncpy(tmpx, wstrings[j], percent-wstrings[j]);
- wcsncat(tmpx, wMsgBuf,
- msgLen - ((wcscmp(wMsgBuf+msgLen-2, L"\r\n")==0) ? 2 : 0));
- wcscat(tmpx, percent+percentLen);
- wstrings[j] = tmpx;
- LocalFree(wMsgBuf);
- }
+ if (FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER
+ | FORMAT_MESSAGE_FROM_HMODULE
+ | FORMAT_MESSAGE_ARGUMENT_ARRAY,
+ dll, id2, 0, (LPWSTR)&wMsgBuf, 0,
+ (va_list*)&wstrings[j]) == 0)
+ {
+ FreeLibrary(dll);
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ percentLen = 2; /* for %% */
+ do {
+ percentLen++;
+ } while (id2/=10); /* compute length of %%xxx string */
+
+ msgLen = wcslen(wMsgBuf);
+ Newz(0, tmpx, wcslen(wstrings[j])+msgLen-percentLen+1, WCHAR);
+ wcsncpy(tmpx, wstrings[j], percent-wstrings[j]);
+ wcsncat(tmpx, wMsgBuf,
+ msgLen - ((wcscmp(wMsgBuf+msgLen-2, L"\r\n")==0) ? 2 : 0));
+ wcscat(tmpx, percent+percentLen);
+ wstrings[j] = tmpx;
+ LocalFree(wMsgBuf);
}
}
@@ -541,6 +543,7 @@
if (wstrings[j] < wlongstring || wstrings[j] >= wlongstring+length)
Safefree(wstrings[j]);
Safefree(wlongstring);
+ Safefree(wstrings);
if (!result || !wMsgBuf) {
FreeLibrary(dll);
@@ -558,7 +561,7 @@
}
else {
static const char *EVFILE[] = {"System", "Security", "Application"};
- char *MsgBuf, *strings[16], *ptr, *tmpx;
+ char *MsgBuf, **strings, *ptr, *tmpx;
char msgfile[MAX_PATH], regPath[MAX_PATH];
DWORD i, id2;
BOOL result;
@@ -567,6 +570,8 @@
char *percent;
int percentLen, msgLen, gotPercent;
+ New(0, strings, numstrings+1, char*);
+
/* Which EventLog are we reading? */
for (j=0; j < (sizeof(EVFILE)/sizeof(EVFILE[0])); j++) {
sprintf(regPath,
@@ -617,34 +622,34 @@
RegCloseKey(hk);
XSRETURN_NO;
}
+ }
- if (FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
- | FORMAT_MESSAGE_FROM_HMODULE
- | FORMAT_MESSAGE_ARGUMENT_ARRAY,
- dll, id2, 0, (LPSTR)&MsgBuf, 0,
- (va_list*)&strings[j]) == 0)
- {
- FreeLibrary(dll);
- RegCloseKey(hk);
- XSRETURN_NO;
- }
-
- percentLen = 2; /* for %% */
- do {
- percentLen++;
- } while (id2/=10); /* compute length of %%xxx string */
-
- msgLen = strlen(MsgBuf);
- Newz(0, tmpx, strlen(strings[j])+msgLen-percentLen+1, char);
- strncpy(tmpx, strings[j], percent-strings[j]);
- strncat(tmpx, MsgBuf,
- msgLen - ((strcmp(MsgBuf+msgLen-2, "\r\n")==0) ? 2 : 0));
- strcat(tmpx, percent+percentLen);
- if (gotPercent)
- Safefree(strings[j]);
- strings[j] = tmpx;
- LocalFree(MsgBuf);
- }
+ if (FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
+ | FORMAT_MESSAGE_FROM_HMODULE
+ | FORMAT_MESSAGE_ARGUMENT_ARRAY,
+ dll, id2, 0, (LPSTR)&MsgBuf, 0,
+ (va_list*)&strings[j]) == 0)
+ {
+ FreeLibrary(dll);
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ percentLen = 2; /* for %% */
+ do {
+ percentLen++;
+ } while (id2/=10); /* compute length of %%xxx string */
+
+ msgLen = strlen(MsgBuf);
+ Newz(0, tmpx, strlen(strings[j])+msgLen-percentLen+1, char);
+ strncpy(tmpx, strings[j], percent-strings[j]);
+ strncat(tmpx, MsgBuf,
+ msgLen - ((strcmp(MsgBuf+msgLen-2, "\r\n")==0) ? 2 : 0));
+ strcat(tmpx, percent+percentLen);
+ if (gotPercent)
+ Safefree(strings[j]);
+ strings[j] = tmpx;
+ LocalFree(MsgBuf);
}
}
@@ -678,6 +683,8 @@
for (j=0; j<=numstrings; j++)
if (strings[j] < longstring || strings[j] >= longstring+length)
Safefree(strings[j]);
+
+ Safefree(strings);
if (!result || !MsgBuf) {
FreeLibrary(dll);
diff -ur libwin32-0.16/File/File.xs libwin32-0.171/File/File.xs
--- libwin32-0.16/File/File.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/File/File.xs Tue Sep 19 16:39:21 2000
@@ -146,7 +146,7 @@
bool
GetAttributes(filename,attribs)
char *filename
- DWORD attribs
+ DWORD attribs = NO_INIT
CODE:
if (USING_WIDE()) {
WCHAR wbuffer[MAX_PATH+1];
diff -ur libwin32-0.16/FileSecurity/FileSecurity.xs libwin32-0.171/FileSecurity/FileSecurity.xs
--- libwin32-0.16/FileSecurity/FileSecurity.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/FileSecurity/FileSecurity.xs Tue Sep 19 16:39:22 2000
@@ -350,7 +350,7 @@
);
}
- if (bResult) {
+ if (!bResult) {
Name = NoName ;
bDName = 0;
bName = strlen(Name);
diff -ur libwin32-0.16/Internet/Internet.pm libwin32-0.171/Internet/Internet.pm
--- libwin32-0.16/Internet/Internet.pm Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/Internet/Internet.pm Tue Sep 19 16:39:22 2000
@@ -1301,8 +1301,8 @@
$version,
$referer,
$accept,
- 0,
- $flags);
+ $flags,
+ 0);
if($newhandle) {
diff -ur libwin32-0.16/Internet/Internet.xs libwin32-0.171/Internet/Internet.xs
--- libwin32-0.16/Internet/Internet.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/Internet/Internet.xs Tue Sep 19 16:39:22 2000
@@ -398,84 +398,72 @@
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_HYPERLINK"))
#ifdef INTERNET_FLAG_HYPERLINK
return INTERNET_FLAG_HYPERLINK;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_KEEP_CONNECTION"))
#ifdef INTERNET_FLAG_KEEP_CONNECTION
return INTERNET_FLAG_KEEP_CONNECTION;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_MAKE_PERSISTENT"))
#ifdef INTERNET_FLAG_MAKE_PERSISTENT
return INTERNET_FLAG_MAKE_PERSISTENT;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_NO_AUTH"))
#ifdef INTERNET_FLAG_NO_AUTH
return INTERNET_FLAG_NO_AUTH;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_NO_AUTO_REDIRECT"))
#ifdef INTERNET_FLAG_NO_AUTO_REDIRECT
return INTERNET_FLAG_NO_AUTO_REDIRECT;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_NO_CACHE_WRITE"))
#ifdef INTERNET_FLAG_NO_CACHE_WRITE
return INTERNET_FLAG_NO_CACHE_WRITE;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_NO_COOKIES"))
#ifdef INTERNET_FLAG_NO_COOKIES
return INTERNET_FLAG_NO_COOKIES;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_READ_PREFETCH"))
#ifdef INTERNET_FLAG_READ_PREFETCH
return INTERNET_FLAG_READ_PREFETCH;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_RELOAD"))
#ifdef INTERNET_FLAG_RELOAD
return INTERNET_FLAG_RELOAD;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_RESYNCHRONIZE"))
#ifdef INTERNET_FLAG_RESYNCHRONIZE
return INTERNET_FLAG_RESYNCHRONIZE;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_TRANSFER_ASCII"))
#ifdef INTERNET_FLAG_TRANSFER_ASCII
return INTERNET_FLAG_TRANSFER_ASCII;
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_FLAG_TRANSFER_BINARY"))
#ifdef INTERNET_FLAG_TRANSFER_BINARY
return INTERNET_FLAG_TRANSFER_BINARY;
@@ -490,7 +478,6 @@
#else
goto not_there;
#endif
- break;
if(strEQ(name, "INTERNET_INVALID_STATUS_CALLBACK"))
#ifdef INTERNET_INVALID_STATUS_CALLBACK
return (DWORD) INTERNET_INVALID_STATUS_CALLBACK;
@@ -667,7 +654,6 @@
#else
goto not_there;
#endif
- break;
if (strEQ(name, "INTERNET_STATUS_CONNECTING_TO_SERVER"))
#ifdef INTERNET_STATUS_CONNECTING_TO_SERVER
return INTERNET_STATUS_CONNECTING_TO_SERVER;
diff -ur libwin32-0.16/NetResource/NetResource.xs libwin32-0.171/NetResource/NetResource.xs
--- libwin32-0.16/NetResource/NetResource.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/NetResource/NetResource.xs Tue Sep 19 16:39:22 2000
@@ -219,14 +219,14 @@
BOOL
-EnumerateFunc(SV* ARef, LPNETRESOURCEA lpnr,DWORD dwType)
-{
- DWORD dwResult, dwResultEnum;
- HANDLE hEnum;
+EnumerateFunc(SV* ARef, LPNETRESOURCEA lpnr,DWORD dwType)
+{
+ DWORD dwResult, dwResultEnum;
+ HANDLE hEnum;
DWORD cbBuffer = 16384; /* 16K is reasonable size */
DWORD cEntries = 0xFFFFFFFF; /* enumerate all possible entries */
LPNETRESOURCEA lpnrLocal; /* pointer to enumerated structures */
- DWORD i;
+ DWORD i;
HV* phvNet;
SV* svNetRes;
AV* av;
@@ -235,18 +235,19 @@
croak("Usage: EnumerateFunc(arrayref,lpresource,type)");
dwResult = WNetOpenEnumA(
- RESOURCE_GLOBALNET,
- dwType,
- 0, /* enumerate all resources */
- lpnr, /* NULL first time this function is called */
- &hEnum); /* handle to resource */
+ RESOURCE_GLOBALNET,
+ dwType,
+ 0, /* enumerate all resources */
+ lpnr, /* NULL first time this function is called */
+ &hEnum); /* handle to resource */
- if (dwResult != NO_ERROR){
+ if (dwResult != NO_ERROR){
dwLastError = dwResult;
- return FALSE;
+ /*PerlIO_printf(Perl_debug_log,"quit1 %ld\n",dwResult);*/
+ return FALSE;
}
- do {
+ do {
/* Allocate memory for NETRESOURCE structures. */
@@ -289,7 +290,10 @@
== (lpnrLocal[i].dwUsage & RESOURCEUSAGE_CONTAINER))
{
if (!EnumerateFunc(ARef, &lpnrLocal[i], dwType)) {
- if (dwLastError != ERROR_ACCESS_DENIED) {
+ if (dwLastError != ERROR_ACCESS_DENIED &&
+ dwLastError != ERROR_BAD_NETPATH &&
+ dwLastError != ERROR_INVALID_ADDRESS)
+ {
safefree(lpnrLocal);
return FALSE;
}
@@ -300,6 +304,7 @@
else if (dwResultEnum != ERROR_NO_MORE_ITEMS)
{
dwLastError = dwResultEnum;
+ /*PerlIO_printf(Perl_debug_log,"quit2 %ld\n",dwLastError);*/
safefree(lpnrLocal);
return(FALSE);
}
@@ -310,12 +315,13 @@
if(dwResult != NO_ERROR){
dwLastError = dwResult;
+ /*PerlIO_printf(Perl_debug_log,"quit3 %ld\n",dwLastError); */
return FALSE;
}
dwLastError = NO_ERROR;
return TRUE;
-}
+}
/*
* wide character allocation routines used to convert from
diff -ur libwin32-0.16/OLE/Changes libwin32-0.171/OLE/Changes
--- libwin32-0.16/OLE/Changes Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/OLE/Changes Tue Sep 19 16:39:23 2000
@@ -3,6 +3,19 @@
Changes in version 0.01-0.03 are by Gurusamy Sarathy. All other changes
are by Jan Dubois unless attributed otherwise.
+0.1401 Mon, September 11th, 2000
+ - fix bug in GetMultiByteEx() sometimes chopping off the last byte
+
+0.14 Tue, August 22th, 2000
+ - remove support for Perl 5.004 & 5.005
+ - don't built for 5.005 Threads (because it won't work anyways)
+ - make sure the other compile options for 5.6 work
+ - support embedded '\0's in BSTR return values
+
+0.1301 Thur, July 13th, 2000 (
[email protected])
+ - patch to fix exported functions
+ - lost UTF-8 support added back in
+
0.13 Sat, May 6th, 2000
- add Win32::OLE::Variant::nothing() function
- fix strrev() definition for Borland
diff -ur libwin32-0.16/OLE/OLE.xs libwin32-0.171/OLE/OLE.xs
--- libwin32-0.16/OLE/OLE.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/OLE/OLE.xs Tue Sep 19 16:39:23 2000
@@ -27,6 +27,8 @@
// #define _DEBUG
+#define register /* be gone */
+
#define MY_VERSION "Win32::OLE(" XS_VERSION ")"
#include <math.h> /* this hack gets around VC-5.0 brainmelt */
@@ -41,9 +43,7 @@
# define DEBUGBREAK
#endif
-#if defined (__cplusplus)
extern "C" {
-#endif
#ifdef __CYGWIN__
# undef WIN32 /* don't use with Cygwin & Perl */
@@ -54,7 +54,7 @@
char *_strrev(char*); /* from string.h (msvcrt40) */
#endif
-#define MIN_PERL_DEFINE
+#define PERL_NO_GET_CONTEXT
#define NO_XSLOCKS
#include "EXTERN.h"
#include "perl.h"
@@ -64,36 +64,15 @@
#undef WORD
typedef unsigned short WORD;
-#if (PATCHLEVEL < 4) || ((PATCHLEVEL == 4) && (SUBVERSION < 1))
-# error Win32::OLE module requires Perl 5.004_01 or later
-#endif
-
-#if (PATCHLEVEL < 5)
-# ifndef PL_dowarn
-# define PL_dowarn dowarn
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-# define PL_sv_no sv_no
-# endif
-# define PL_hints hints
-# define PL_modglobal modglobal
-#endif
-
-#ifndef CPERLarg
-# define CPERLarg
-# define CPERLarg_
-# define PERL_OBJECT_THIS
-# define PERL_OBJECT_THIS_
+#if PATCHLEVEL < 6
+# error Win32::OLE requires Perl 5.6.0 or later
#endif
-#ifndef pTHX_
-# define pTHX_
+#ifdef USE_5005THREADS
+# error Win32::OLE is incompatible with 5.005 style threads
#endif
-#undef THIS_
-#define THIS_ PERL_OBJECT_THIS_
-
-#if !defined(_DEBUG)
+#ifndef _DEBUG
# define DBG(a)
#else
# define DBG(a) MyDebug a
@@ -182,22 +161,14 @@
} PERINTERP;
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT)
-# if (PATCHLEVEL == 4) && (SUBVERSION < 68)
-# define dPERINTERP \
- SV *interp = perl_get_sv(MY_VERSION, FALSE); \
- if (!interp || !SvIOK(interp)) \
- warn(MY_VERSION ": Per-interpreter data not initialized"); \
- PERINTERP *pInterp = (PERINTERP*)SvIV(interp)
-# else
-# define dPERINTERP \
- SV **pinterp = hv_fetch(PL_modglobal, MY_VERSION, \
- sizeof(MY_VERSION)-1, FALSE); \
- if (!pinterp || !*pinterp || !SvIOK(*pinterp)) \
- warn(MY_VERSION ": Per-interpreter data not initialized"); \
- PERINTERP *pInterp = (PERINTERP*)SvIV(*pinterp)
-# endif
-# define INTERP pInterp
+#ifdef PERL_IMPLICIT_CONTEXT
+# define dPERINTERP \
+ SV **pinterp = hv_fetch(PL_modglobal, MY_VERSION, \
+ sizeof(MY_VERSION)-1, FALSE); \
+ if (!pinterp || !*pinterp || !SvIOK(*pinterp)) \
+ warn(MY_VERSION ": Per-interpreter data not initialized"); \
+ PERINTERP *pInterp = (PERINTERP*)SvIV(*pinterp)
+# define INTERP pInterp
#else
static PERINTERP Interp;
# define dPERINTERP extern int errno
@@ -223,7 +194,7 @@
long lMagic;
OBJECTHEADER *pNext;
OBJECTHEADER *pPrevious;
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT)
+#ifdef PERL_IMPLICIT_CONTEXT
PERINTERP *pInterp;
#endif
} OBJECTHEADER;
@@ -323,35 +294,7 @@
EXCEPINFO *pexcepinfo,
UINT *puArgErr);
-#ifdef _DEBUG
- STDMETHOD(Dummy1)();
- STDMETHOD(Dummy2)();
- STDMETHOD(Dummy3)();
- STDMETHOD(Dummy4)();
- STDMETHOD(Dummy5)();
- STDMETHOD(Dummy6)();
- STDMETHOD(Dummy7)();
- STDMETHOD(Dummy8)();
- STDMETHOD(Dummy9)();
- STDMETHOD(Dummy10)();
- STDMETHOD(Dummy11)();
- STDMETHOD(Dummy12)();
- STDMETHOD(Dummy13)();
- STDMETHOD(Dummy14)();
- STDMETHOD(Dummy15)();
- STDMETHOD(Dummy16)();
- STDMETHOD(Dummy17)();
- STDMETHOD(Dummy18)();
- STDMETHOD(Dummy19)();
- STDMETHOD(Dummy20)();
- STDMETHOD(Dummy21)();
- STDMETHOD(Dummy22)();
- STDMETHOD(Dummy23)();
- STDMETHOD(Dummy24)();
- STDMETHOD(Dummy25)();
-#endif
-
- EventSink(CPERLarg_ WINOLEOBJECT *pObj, SV *events,
+ EventSink(pTHX_ WINOLEOBJECT *pObj, SV *events,
REFIID riid, ITypeInfo *pTypeInfo);
~EventSink(void);
HRESULT Advise(IConnectionPoint *pConnectionPoint);
@@ -366,8 +309,8 @@
SV *m_events;
IID m_iid;
ITypeInfo *m_pTypeInfo;
-#ifdef PERL_OBJECT
- CPERLproto m_PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX;
#endif
};
@@ -402,69 +345,26 @@
EXCEPINFO *pexcepinfo,
UINT *puArgErr);
- Forwarder(CPERLarg_ HV *stash, SV *method);
+ Forwarder(pTHX_ HV *stash, SV *method);
~Forwarder(void);
private:
int m_refcount;
HV *m_stash;
SV *m_method;
-#ifdef PERL_OBJECT
- CPERLproto m_PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX;
#endif
};
/* forward declarations */
-HRESULT SetSVFromVariantEx(CPERLarg_ VARIANTARG *pVariant, SV* sv, HV *stash,
+HRESULT SetSVFromVariantEx(pTHX_ VARIANTARG *pVariant, SV* sv, HV *stash,
BOOL bByRefObj=FALSE);
-HRESULT SetVariantFromSVEx(CPERLarg_ SV* sv, VARIANT *pVariant, UINT cp,
+HRESULT SetVariantFromSVEx(pTHX_ SV* sv, VARIANT *pVariant, UINT cp,
LCID lcid);
-HRESULT AssignVariantFromSV(CPERLarg_ SV* sv, VARIANT *pVariant,
+HRESULT AssignVariantFromSV(pTHX_ SV* sv, VARIANT *pVariant,
UINT cp, LCID lcid);
-/* The following function from IO.xs is in the core starting with 5.004_63 */
-#if (PATCHLEVEL == 4) && (SUBVERSION < 63)
-void
-newCONSTSUB(HV *stash, char *name, SV *sv)
-{
-#ifdef dTHR
- dTHR;
-#endif
- U32 oldhints = PL_hints;
- HV *old_cop_stash = curcop->cop_stash;
- HV *old_curstash = curstash;
- line_t oldline = curcop->cop_line;
- curcop->cop_line = copline;
-
- PL_hints &= ~HINT_BLOCK_SCOPE;
- if(stash)
- curstash = curcop->cop_stash = stash;
-
- newSUB(
- start_subparse(FALSE, 0),
- newSVOP(OP_CONST, 0, newSVpv(name,0)),
- newSVOP(OP_CONST, 0, &sv_no), /* SvPV(&sv_no) == "" -- GMB */
- newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
- );
-
- PL_hints = oldhints;
- curcop->cop_stash = old_cop_stash;
- curstash = old_curstash;
- curcop->cop_line = oldline;
-}
-#endif
-
-/* SvPV_nolen() macro first defined in 5.005_55 */
-#if (PATCHLEVEL == 4) || ((PATCHLEVEL == 5) && (SUBVERSION < 55))
-char *
-MySvPVX(CPERLarg_ SV *sv)
-{
- STRLEN n_a;
- return SvPV(sv, n_a);
-}
-# define SvPV_nolen(sv) (SvPOK(sv) ? (SvPVX(sv)) : MySvPVX(THIS_ sv))
-#endif
-
//------------------------------------------------------------------------
inline void
@@ -481,7 +381,7 @@
} /* SpinMessageLoop */
BOOL
-IsLocalMachine(CPERLarg_ char *pszMachine)
+IsLocalMachine(pTHX_ char *pszMachine)
{
char szComputerName[MAX_COMPUTERNAME_LENGTH+1];
DWORD dwSize = sizeof(szComputerName);
@@ -494,9 +394,19 @@
return TRUE;
/* Check against local computer name (from registry) */
- if (GetComputerName(szComputerName, &dwSize)
- && stricmp(pszName, szComputerName) == 0)
- return TRUE;
+ if (USING_WIDE()) {
+ WCHAR wComputerName[MAX_COMPUTERNAME_LENGTH+1];
+ WCHAR wHostName[MAX_COMPUTERNAME_LENGTH+1];
+ A2WHELPER(pszName, wHostName, sizeof(wHostName));
+ if (GetComputerNameW(wComputerName, &dwSize)
+ && _wcsicmp(wHostName, wComputerName) == 0)
+ return TRUE;
+ }
+ else {
+ if (GetComputerNameA(szComputerName, &dwSize)
+ && stricmp(pszName, szComputerName) == 0)
+ return TRUE;
+ }
/* gethostname(), gethostbyname() and inet_addr() all call proxy functions
* in the Perl socket layer wrapper in win32sck.c. Therefore calling
@@ -563,14 +473,21 @@
} /* IsLocalMachine */
HRESULT
-CLSIDFromRemoteRegistry(CPERLarg_ char *pszHost, char *pszProgID, CLSID *pCLSID)
+CLSIDFromRemoteRegistry(pTHX_ char *pszHost, char *pszProgID, CLSID *pCLSID)
{
HKEY hKeyLocalMachine;
HKEY hKeyProgID;
LONG err;
+ WCHAR wbuffer[MAX_PATH+1];
HRESULT hr = S_OK;
- err = RegConnectRegistry(pszHost, HKEY_LOCAL_MACHINE, &hKeyLocalMachine);
+ if (USING_WIDE()) {
+ A2WHELPER(pszHost, wbuffer, sizeof(wbuffer));
+ err = RegConnectRegistryW(wbuffer, HKEY_LOCAL_MACHINE, &hKeyLocalMachine);
+ }
+ else {
+ err = RegConnectRegistryA(pszHost, HKEY_LOCAL_MACHINE, &hKeyLocalMachine);
+ }
if (err != ERROR_SUCCESS)
return HRESULT_FROM_WIN32(err);
@@ -578,8 +495,15 @@
sv_catpv(subkey, pszProgID);
sv_catpv(subkey, "\\CLSID");
- err = RegOpenKeyEx(hKeyLocalMachine, SvPV_nolen(subkey), 0, KEY_READ,
- &hKeyProgID);
+ if (USING_WIDE()) {
+ A2WHELPER(SvPV_nolen(subkey), wbuffer, sizeof(wbuffer));
+ err = RegOpenKeyExW(hKeyLocalMachine, wbuffer, 0, KEY_READ,
+ &hKeyProgID);
+ }
+ else {
+ err = RegOpenKeyExA(hKeyLocalMachine, SvPV_nolen(subkey), 0, KEY_READ,
+ &hKeyProgID);
+ }
if (err != ERROR_SUCCESS)
hr = HRESULT_FROM_WIN32(err);
else {
@@ -617,64 +541,81 @@
* The caller must free this buffer using the ReleaseBuffer function. */
inline void
-ReleaseBuffer(CPERLarg_ void *pszHeap, void *pszStack)
+ReleaseBuffer(pTHX_ void *pszHeap, void *pszStack)
{
if (pszHeap != pszStack && pszHeap)
Safefree(pszHeap);
}
char *
-GetMultiByte(CPERLarg_ OLECHAR *wide, char *psz, int len, UINT cp)
+GetMultiByteEx(pTHX_ OLECHAR *wide, int *pcch, char *psz, int len, UINT cp)
{
int count;
if (psz) {
- if (!wide) {
- *psz = (char) 0;
+ if (!wide || !*pcch) {
+ fail:
+ *psz = (char)0;
+ *pcch = 0;
return psz;
}
- count = WideCharToMultiByte(cp, 0, wide, -1, psz, len, NULL, NULL);
+ count = WideCharToMultiByte(cp, 0, wide, *pcch, psz, len, NULL, NULL);
if (count > 0)
- return psz;
+ goto succeed;
}
- else if (!wide) {
+ else if (!wide || !*pcch) {
Newz(0, psz, 1, char);
+ *pcch = 0;
return psz;
}
- count = WideCharToMultiByte(cp, 0, wide, -1, NULL, 0, NULL, NULL);
+ count = WideCharToMultiByte(cp, 0, wide, *pcch, NULL, 0, NULL, NULL);
if (count == 0) { /* should never happen */
warn(MY_VERSION ": GetMultiByte() failure: %lu", GetLastError());
DEBUGBREAK;
if (!psz)
New(0, psz, 1, char);
- *psz = (char) 0;
- return psz;
+ goto fail;
}
Newz(0, psz, count, char);
- WideCharToMultiByte(cp, 0, wide, -1, psz, count, NULL, NULL);
+ WideCharToMultiByte(cp, 0, wide, *pcch, psz, count, NULL, NULL);
+
+ succeed:
+ if (*pcch == -1)
+ *pcch = count - 1; /* because count includes the trailing '\0' */
+ else
+ *pcch = count;
return psz;
-} /* GetMultiByte */
+} /* GetMultiByteEx */
+
+char *
+GetMultiByte(pTHX_ OLECHAR *wide, char *psz, int len, UINT cp)
+{
+ int cch = -1;
+ return GetMultiByteEx(aTHX_ wide, &cch, psz, len, cp);
+}
SV *
-sv_setwide(CPERLarg_ SV *sv, OLECHAR *wide, UINT cp)
+sv_setbstr(pTHX_ SV *sv, BSTR bstr, UINT cp)
{
char szBuffer[OLE_BUF_SIZ];
char *pszBuffer;
+ int len = SysStringLen(bstr);
- pszBuffer = GetMultiByte(THIS_ wide, szBuffer, sizeof(szBuffer), cp);
+ pszBuffer = GetMultiByteEx(aTHX_ bstr, &len,
+ szBuffer, sizeof(szBuffer), cp);
if (!sv)
- sv = newSVpv(pszBuffer, 0);
+ sv = newSVpvn(pszBuffer, len);
else
- sv_setpv(sv, pszBuffer);
- ReleaseBuffer(THIS_ pszBuffer, szBuffer);
+ sv_setpvn(sv, pszBuffer, len);
+ ReleaseBuffer(aTHX_ pszBuffer, szBuffer);
return sv;
}
OLECHAR *
-GetWideChar(CPERLarg_ char *psz, OLECHAR *wide, int len, UINT cp)
+GetWideChar(pTHX_ char *psz, OLECHAR *wide, int len, UINT cp)
{
/* Note: len is number of OLECHARs, not bytes! */
int count;
@@ -710,7 +651,7 @@
} /* GetWideChar */
HV *
-GetStash(CPERLarg_ SV *sv)
+GetStash(pTHX_ SV *sv)
{
if (sv_isobject(sv))
return SvSTASH(SvRV(sv));
@@ -722,7 +663,7 @@
} /* GetStash */
HV *
-GetWin32OleStash(CPERLarg_ SV *sv)
+GetWin32OleStash(pTHX_ SV *sv)
{
SV *pkg;
@@ -749,7 +690,7 @@
} /* GetWin32OleStash */
IV
-QueryPkgVar(CPERLarg_ HV *stash, char *var, STRLEN len, IV def=0)
+QueryPkgVar(pTHX_ HV *stash, char *var, STRLEN len, IV def=0)
{
SV *sv;
GV **gv = (GV**)hv_fetch(stash, var, len, FALSE);
@@ -764,7 +705,7 @@
}
void
-SetLastOleError(CPERLarg_ HV *stash, HRESULT hr=S_OK, char *pszMsg=NULL)
+SetLastOleError(pTHX_ HV *stash, HRESULT hr=S_OK, char *pszMsg=NULL)
{
/* Find $Win32::OLE::LastError */
SV *sv = sv_2mortal(newSVpv(HvNAME(stash), 0));
@@ -786,13 +727,13 @@
}
void
-ReportOleError(CPERLarg_ HV *stash, HRESULT hr, EXCEPINFO *pExcep=NULL,
+ReportOleError(pTHX_ HV *stash, HRESULT hr, EXCEPINFO *pExcep=NULL,
SV *svAdd=NULL)
{
dSP;
SV *sv;
- IV warnlvl = QueryPkgVar(THIS_ stash, WARN_NAME, WARN_LEN);
+ IV warnlvl = QueryPkgVar(aTHX_ stash, WARN_NAME, WARN_LEN);
GV **pgv = (GV**)hv_fetch(stash, WARN_NAME, WARN_LEN, FALSE);
CV *cv = Nullcv;
@@ -810,20 +751,20 @@
char *pszSource = szSource;
char *pszDesc = szDesc;
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
if (pExcep->bstrSource)
- pszSource = GetMultiByte(THIS_ pExcep->bstrSource,
+ pszSource = GetMultiByte(aTHX_ pExcep->bstrSource,
szSource, sizeof(szSource), cp);
if (pExcep->bstrDescription)
- pszDesc = GetMultiByte(THIS_ pExcep->bstrDescription,
+ pszDesc = GetMultiByte(aTHX_ pExcep->bstrDescription,
szDesc, sizeof(szDesc), cp);
sv_setpvf(sv, "OLE exception from \"%s\":\n\n%s\n\n",
pszSource, pszDesc);
- ReleaseBuffer(THIS_ pszSource, szSource);
- ReleaseBuffer(THIS_ pszDesc, szDesc);
+ ReleaseBuffer(aTHX_ pszSource, szSource);
+ ReleaseBuffer(aTHX_ pszDesc, szDesc);
/* SysFreeString accepts NULL too */
SysFreeString(pExcep->bstrSource);
SysFreeString(pExcep->bstrDescription);
@@ -835,11 +776,30 @@
/* try to append ': "error text"' from message catalog */
char *pszMsgText;
- DWORD dwCount = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ DWORD dwCount;
+ if (USING_WIDE()) {
+ WCHAR *wzMsgText;
+ dwCount = FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ FORMAT_MESSAGE_FROM_SYSTEM |
+ FORMAT_MESSAGE_IGNORE_INSERTS,
+ NULL, hr, lcidSystemDefault,
+ (LPWSTR)&wzMsgText, 0, NULL);
+ pszMsgText = (LPSTR)LocalAlloc(0, (dwCount+1)*2);
+ if(pszMsgText) {
+ W2AHELPER(wzMsgText, pszMsgText, (dwCount+1)*2);
+ dwCount = strlen(pszMsgText);
+ }
+ else
+ dwCount = 0;
+ LocalFree(wzMsgText);
+ }
+ else {
+ dwCount = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER |
FORMAT_MESSAGE_FROM_SYSTEM |
FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, hr, lcidSystemDefault,
- (LPTSTR)&pszMsgText, 0, NULL);
+ (LPSTR)&pszMsgText, 0, NULL);
+ }
if (dwCount > 0) {
sv_catpv(sv, ": \"");
/* remove trailing dots and CRs/LFs from message */
@@ -886,7 +846,7 @@
}
}
- SetLastOleError(THIS_ stash, hr, SvPVX(sv));
+ SetLastOleError(aTHX_ stash, hr, SvPVX(sv));
DBG(("ReportOleError: hr=0x%08x warnlvl=%d\n%s", hr, warnlvl, SvPVX(sv)));
@@ -913,18 +873,18 @@
} /* ReportOleError */
inline BOOL
-CheckOleError(CPERLarg_ HV *stash, HRESULT hr, EXCEPINFO *pExcep=NULL,
+CheckOleError(pTHX_ HV *stash, HRESULT hr, EXCEPINFO *pExcep=NULL,
SV *svAdd=NULL)
{
if (FAILED(hr)) {
- ReportOleError(THIS_ stash, hr, pExcep, svAdd);
+ ReportOleError(aTHX_ stash, hr, pExcep, svAdd);
return TRUE;
}
return FALSE;
}
SV *
-CheckDestroyFunction(CPERLarg_ SV *sv, char *szMethod)
+CheckDestroyFunction(pTHX_ SV *sv, char *szMethod)
{
/* undef */
if (!SvOK(sv))
@@ -940,7 +900,7 @@
}
void
-AddToObjectChain(CPERLarg_ OBJECTHEADER *pHeader, long lMagic)
+AddToObjectChain(pTHX_ OBJECTHEADER *pHeader, long lMagic)
{
dPERINTERP;
DBG(("AddToObjectChain(0x%08x) lMagic=0x%08x", pHeader, lMagic));
@@ -950,7 +910,7 @@
pHeader->pPrevious = NULL;
pHeader->pNext = g_pObj;
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT)
+#ifdef PERL_IMPLICIT_CONTEXT
pHeader->pInterp = INTERP;
#endif
@@ -961,7 +921,7 @@
}
void
-RemoveFromObjectChain(CPERLarg_ OBJECTHEADER *pHeader)
+RemoveFromObjectChain(pTHX_ OBJECTHEADER *pHeader)
{
DBG(("RemoveFromObjectChain(0x%08x) lMagic=0x%08x\n", pHeader,
pHeader ? pHeader->lMagic : 0));
@@ -969,7 +929,7 @@
if (!pHeader)
return;
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT)
+#ifdef PERL_IMPLICIT_CONTEXT
PERINTERP *pInterp = pHeader->pInterp;
#endif
@@ -990,13 +950,13 @@
}
SV *
-CreatePerlObject(CPERLarg_ HV *stash, IDispatch *pDispatch, SV *destroy)
+CreatePerlObject(pTHX_ HV *stash, IDispatch *pDispatch, SV *destroy)
{
dPERINTERP;
/* returns a mortal reference to a new Perl OLE object */
- IV unique = QueryPkgVar(THIS_ stash, _UNIQUE_NAME, _UNIQUE_LEN);
+ IV unique = QueryPkgVar(aTHX_ stash, _UNIQUE_NAME, _UNIQUE_LEN);
if (unique) {
IUnknown *punk; // XXX check error?
pDispatch->QueryInterface(IID_IUnknown, (void**)&punk);
@@ -1051,7 +1011,7 @@
pObj->flags |= OBJFLAG_UNIQUE;
}
- AddToObjectChain(THIS_ &pObj->header, WINOLE_MAGIC);
+ AddToObjectChain(aTHX_ &pObj->header, WINOLE_MAGIC);
DBG(("CreatePerlObject=|%lx| Class=%s Tie=%s pDispatch=0x%x\n", pObj,
HvNAME(stash), szTie, pDispatch));
@@ -1066,7 +1026,7 @@
} /* CreatePerlObject */
void
-ReleasePerlObject(CPERLarg_ WINOLEOBJECT *pObj)
+ReleasePerlObject(pTHX_ WINOLEOBJECT *pObj)
{
dSP;
HV *stash = SvSTASH(pObj->self);
@@ -1164,7 +1124,7 @@
} /* ReleasePerlObject */
WINOLEOBJECT *
-GetOleObject(CPERLarg_ SV *sv, BOOL bDESTROY=FALSE)
+GetOleObject(pTHX_ SV *sv, BOOL bDESTROY=FALSE)
{
if (sv_isobject(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) {
SV **psv = hv_fetch((HV*)SvRV(sv), PERL_OLE_ID, PERL_OLE_IDLEN, 0);
@@ -1173,14 +1133,10 @@
if (!psv && bDESTROY)
return NULL;
-#if (PATCHLEVEL > 4) || ((PATCHLEVEL == 4) && (SUBVERSION > 4))
if (psv && SvGMAGICAL(*psv))
mg_get(*psv);
if (psv && SvIOK(*psv)) {
-#else
- if (psv) {
-#endif
WINOLEOBJECT *pObj = (WINOLEOBJECT*)SvIV(*psv);
DBG(("GetOleObject = |%lx|\n", pObj));
@@ -1195,7 +1151,7 @@
}
WINOLEENUMOBJECT *
-GetOleEnumObject(CPERLarg_ SV *sv, BOOL bDESTROY=FALSE)
+GetOleEnumObject(pTHX_ SV *sv, BOOL bDESTROY=FALSE)
{
if (sv_isobject(sv) && sv_derived_from(sv, szWINOLEENUM)) {
WINOLEENUMOBJECT *pEnumObj = (WINOLEENUMOBJECT*)SvIV(SvRV(sv));
@@ -1210,7 +1166,7 @@
}
WINOLEVARIANTOBJECT *
-GetOleVariantObject(CPERLarg_ SV *sv, BOOL bWarn=TRUE)
+GetOleVariantObject(pTHX_ SV *sv, BOOL bWarn=TRUE)
{
if (sv_isobject(sv) && sv_derived_from(sv, szWINOLEVARIANT)) {
WINOLEVARIANTOBJECT *pVarObj = (WINOLEVARIANTOBJECT*)SvIV(SvRV(sv));
@@ -1227,7 +1183,7 @@
}
SV *
-CreateTypeLibObject(CPERLarg_ ITypeLib *pTypeLib, TLIBATTR *pTLibAttr)
+CreateTypeLibObject(pTHX_ ITypeLib *pTypeLib, TLIBATTR *pTLibAttr)
{
WINOLETYPELIBOBJECT *pObj;
New(0, pObj, 1, WINOLETYPELIBOBJECT);
@@ -1235,14 +1191,14 @@
pObj->pTypeLib = pTypeLib;
pObj->pTLibAttr = pTLibAttr;
- AddToObjectChain(THIS_ (OBJECTHEADER*)pObj, WINOLETYPELIB_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pObj, WINOLETYPELIB_MAGIC);
return sv_bless(newRV_noinc(newSViv((IV)pObj)),
gv_stashpv(szWINOLETYPELIB, TRUE));
}
WINOLETYPELIBOBJECT *
-GetOleTypeLibObject(CPERLarg_ SV *sv)
+GetOleTypeLibObject(pTHX_ SV *sv)
{
if (sv_isobject(sv) && sv_derived_from(sv, szWINOLETYPELIB)) {
WINOLETYPELIBOBJECT *pObj = (WINOLETYPELIBOBJECT*)SvIV(SvRV(sv));
@@ -1256,7 +1212,7 @@
}
SV *
-CreateTypeInfoObject(CPERLarg_ ITypeInfo *pTypeInfo, TYPEATTR *pTypeAttr)
+CreateTypeInfoObject(pTHX_ ITypeInfo *pTypeInfo, TYPEATTR *pTypeAttr)
{
WINOLETYPEINFOOBJECT *pObj;
New(0, pObj, 1, WINOLETYPEINFOOBJECT);
@@ -1264,14 +1220,14 @@
pObj->pTypeInfo = pTypeInfo;
pObj->pTypeAttr = pTypeAttr;
- AddToObjectChain(THIS_ (OBJECTHEADER*)pObj, WINOLETYPEINFO_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pObj, WINOLETYPEINFO_MAGIC);
return sv_bless(newRV_noinc(newSViv((IV)pObj)),
gv_stashpv(szWINOLETYPEINFO, TRUE));
}
WINOLETYPEINFOOBJECT *
-GetOleTypeInfoObject(CPERLarg_ SV *sv)
+GetOleTypeInfoObject(pTHX_ SV *sv)
{
if (sv_isobject(sv) && sv_derived_from(sv, szWINOLETYPEINFO)) {
WINOLETYPEINFOOBJECT *pObj = (WINOLETYPEINFOOBJECT*)SvIV(SvRV(sv));
@@ -1286,7 +1242,7 @@
}
BSTR
-AllocOleString(CPERLarg_ char* pStr, int length, UINT cp)
+AllocOleString(pTHX_ char* pStr, int length, UINT cp)
{
int count = MultiByteToWideChar(cp, 0, pStr, length, NULL, 0);
BSTR bstr = SysAllocStringLen(NULL, count);
@@ -1295,7 +1251,7 @@
}
HRESULT
-GetHashedDispID(CPERLarg_ WINOLEOBJECT *pObj, char *buffer, STRLEN len,
+GetHashedDispID(pTHX_ WINOLEOBJECT *pObj, char *buffer, STRLEN len,
DISPID &dispID, LCID lcid, UINT cp)
{
HRESULT hr;
@@ -1316,9 +1272,9 @@
OLECHAR Buffer[OLE_BUF_SIZ];
OLECHAR *pBuffer;
- pBuffer = GetWideChar(THIS_ buffer, Buffer, OLE_BUF_SIZ, cp);
+ pBuffer = GetWideChar(aTHX_ buffer, Buffer, OLE_BUF_SIZ, cp);
hr = pObj->pDispatch->GetIDsOfNames(IID_NULL, &pBuffer, 1, lcid, &id);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
/* Don't call CheckOleError! Caller might retry the "unnamed" method */
if (SUCCEEDED(hr)) {
hv_store(pObj->hashTable, buffer, len, newSViv(id), 0);
@@ -1329,7 +1285,7 @@
} /* GetHashedDispID */
void
-FetchTypeInfo(CPERLarg_ WINOLEOBJECT *pObj)
+FetchTypeInfo(pTHX_ WINOLEOBJECT *pObj)
{
unsigned int count;
ITypeInfo *pTypeInfo;
@@ -1345,21 +1301,21 @@
return;
}
- if (CheckOleError(THIS_ stash, hr)) {
+ if (CheckOleError(aTHX_ stash, hr)) {
warn(MY_VERSION ": FetchTypeInfo() GetTypeInfoCount failed");
DEBUGBREAK;
return;
}
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
hr = pObj->pDispatch->GetTypeInfo(0, lcid, &pTypeInfo);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
return;
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
return;
}
@@ -1400,7 +1356,7 @@
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
return;
}
@@ -1420,7 +1376,7 @@
} /* FetchTypeInfo */
SV *
-NextPropertyName(CPERLarg_ WINOLEOBJECT *pObj)
+NextPropertyName(pTHX_ WINOLEOBJECT *pObj)
{
HRESULT hr;
unsigned int cName;
@@ -1430,8 +1386,8 @@
return &PL_sv_undef;
HV *stash = SvSTASH(pObj->self);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
- int newenum = QueryPkgVar(THIS_ stash, _NEWENUM_NAME, _NEWENUM_LEN);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
+ int newenum = QueryPkgVar(aTHX_ stash, _NEWENUM_NAME, _NEWENUM_LEN);
while (pObj->PropIndex < pObj->cFuncs+pObj->cVars) {
ULONG index = pObj->PropIndex++;
@@ -1440,7 +1396,7 @@
FUNCDESC *pFuncDesc;
hr = pObj->pTypeInfo->GetFuncDesc(index, &pFuncDesc);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
continue;
if (newenum && pFuncDesc->memid == DISPID_NEWENUM)
@@ -1458,10 +1414,10 @@
hr = pObj->pTypeInfo->GetNames(pFuncDesc->memid, &bstr, 1, &cName);
pObj->pTypeInfo->ReleaseFuncDesc(pFuncDesc);
- if (CheckOleError(THIS_ stash, hr) || cName == 0 || !bstr)
+ if (CheckOleError(aTHX_ stash, hr) || cName == 0 || !bstr)
continue;
- SV *sv = sv_setwide(THIS_ NULL, bstr, cp);
+ SV *sv = sv_setbstr(aTHX_ NULL, bstr, cp);
SysFreeString(bstr);
return sv;
}
@@ -1471,7 +1427,7 @@
index -= pObj->cFuncs;
hr = pObj->pTypeInfo->GetVarDesc(index, &pVarDesc);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
continue;
if (!(pVarDesc->varkind & VAR_DISPATCH) ||
@@ -1485,10 +1441,10 @@
hr = pObj->pTypeInfo->GetNames(pVarDesc->memid, &bstr, 1, &cName);
pObj->pTypeInfo->ReleaseVarDesc(pVarDesc);
- if (CheckOleError(THIS_ stash, hr) || cName == 0 || !bstr)
+ if (CheckOleError(aTHX_ stash, hr) || cName == 0 || !bstr)
continue;
- SV *sv = sv_setwide(THIS_ NULL, bstr, cp);
+ SV *sv = sv_setbstr(aTHX_ NULL, bstr, cp);
SysFreeString(bstr);
return sv;
}
@@ -1498,7 +1454,7 @@
} /* NextPropertyName */
HV *
-GetDocumentation(CPERLarg_ BSTR bstrName, BSTR bstrDocString,
+GetDocumentation(pTHX_ BSTR bstrName, BSTR bstrDocString,
DWORD dwHelpContext, BSTR bstrHelpFile)
{
HV *hv = newHV();
@@ -1507,19 +1463,19 @@
// XXX use correct codepage ???
UINT cp = CP_ACP;
- pszStr = GetMultiByte(THIS_ bstrName, szStr, sizeof(szStr), cp);
+ pszStr = GetMultiByte(aTHX_ bstrName, szStr, sizeof(szStr), cp);
hv_store(hv, "Name", 4, newSVpv(pszStr, 0), 0);
- ReleaseBuffer(THIS_ pszStr, szStr);
+ ReleaseBuffer(aTHX_ pszStr, szStr);
SysFreeString(bstrName);
- pszStr = GetMultiByte(THIS_ bstrDocString, szStr, sizeof(szStr), cp);
+ pszStr = GetMultiByte(aTHX_ bstrDocString, szStr, sizeof(szStr), cp);
hv_store(hv, "DocString", 9, newSVpv(pszStr, 0), 0);
- ReleaseBuffer(THIS_ pszStr, szStr);
+ ReleaseBuffer(aTHX_ pszStr, szStr);
SysFreeString(bstrDocString);
- pszStr = GetMultiByte(THIS_ bstrHelpFile, szStr, sizeof(szStr), cp);
+ pszStr = GetMultiByte(aTHX_ bstrHelpFile, szStr, sizeof(szStr), cp);
hv_store(hv, "HelpFile", 8, newSVpv(pszStr, 0), 0);
- ReleaseBuffer(THIS_ pszStr, szStr);
+ ReleaseBuffer(aTHX_ pszStr, szStr);
SysFreeString(bstrHelpFile);
hv_store(hv, "HelpContext", 11, newSViv(dwHelpContext), 0);
@@ -1529,7 +1485,7 @@
} /* GetDocumentation */
HRESULT
-TranslateTypeDesc(CPERLarg_ TYPEDESC *pTypeDesc, WINOLETYPEINFOOBJECT *pObj,
+TranslateTypeDesc(pTHX_ TYPEDESC *pTypeDesc, WINOLETYPEINFOOBJECT *pObj,
AV *av)
{
HRESULT hr = S_OK;
@@ -1542,7 +1498,7 @@
if (SUCCEEDED(hr)) {
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (SUCCEEDED(hr))
- sv = CreateTypeInfoObject(THIS_ pTypeInfo, pTypeAttr);
+ sv = CreateTypeInfoObject(aTHX_ pTypeInfo, pTypeAttr);
else
pTypeInfo->Release();
}
@@ -1560,19 +1516,19 @@
av_push(av, sv);
if (pTypeDesc->vt == VT_PTR || pTypeDesc->vt == VT_SAFEARRAY)
- hr = TranslateTypeDesc(THIS_ pTypeDesc->lptdesc, pObj, av);
+ hr = TranslateTypeDesc(aTHX_ pTypeDesc->lptdesc, pObj, av);
return hr;
}
HV *
-TranslateElemDesc(CPERLarg_ ELEMDESC *pElemDesc, WINOLETYPEINFOOBJECT *pObj,
+TranslateElemDesc(pTHX_ ELEMDESC *pElemDesc, WINOLETYPEINFOOBJECT *pObj,
HV *olestash)
{
HV *hv = newHV();
AV *av = newAV();
- TranslateTypeDesc(THIS_ &pElemDesc->tdesc, pObj, av);
+ TranslateTypeDesc(aTHX_ &pElemDesc->tdesc, pObj, av);
hv_store(hv, "vt", 2, newRV_noinc((SV*)av), 0);
USHORT wParamFlags = pElemDesc->paramdesc.wParamFlags;
@@ -1585,7 +1541,7 @@
// XXX should be stored as a Win32::OLE::Variant object ?
SV *sv = newSV(0);
// XXX check return code
- SetSVFromVariantEx(THIS_ &pParamDescEx->varDefaultValue,
+ SetSVFromVariantEx(aTHX_ &pParamDescEx->varDefaultValue,
sv, olestash);
hv_store(hv, "varDefaultValue", 15, sv, 0);
}
@@ -1595,7 +1551,7 @@
} /* TranslateElemDesc */
HRESULT
-FindIID(CPERLarg_ WINOLEOBJECT *pObj, char *pszItf, IID *piid,
+FindIID(pTHX_ WINOLEOBJECT *pObj, char *pszItf, IID *piid,
ITypeInfo **ppTypeInfo, UINT cp, LCID lcid)
{
ITypeInfo *pTypeInfo;
@@ -1668,7 +1624,7 @@
}
char szStr[OLE_BUF_SIZ];
- char *pszStr = GetMultiByte(THIS_ bstr, szStr,
+ char *pszStr = GetMultiByte(aTHX_ bstr, szStr,
sizeof(szStr), cp);
if (strEQ(pszItf, pszStr)) {
TYPEATTR *pImplTypeAttr;
@@ -1685,7 +1641,7 @@
}
}
- ReleaseBuffer(THIS_ pszStr, szStr);
+ ReleaseBuffer(aTHX_ pszStr, szStr);
pImplTypeInfo->Release();
if (bFound || FAILED(hr))
break;
@@ -1712,9 +1668,9 @@
OLECHAR wszGUID[80];
int len = StringFromGUID2(*piid, wszGUID, sizeof(wszGUID)/sizeof(OLECHAR));
char szStr[OLE_BUF_SIZ];
- char *pszStr = GetMultiByte(THIS_ wszGUID, szStr, sizeof(szStr), cp);
+ char *pszStr = GetMultiByte(aTHX_ wszGUID, szStr, sizeof(szStr), cp);
DBG(("FindIID: %s is %s", pszItf, pszStr));
- ReleaseBuffer(THIS_ pszStr, szStr);
+ ReleaseBuffer(aTHX_ pszStr, szStr);
#endif
return S_OK;
@@ -1722,7 +1678,7 @@
} /* FindIID */
HRESULT
-FindDefaultSource(CPERLarg_ WINOLEOBJECT *pObj, IID *piid,
+FindDefaultSource(pTHX_ WINOLEOBJECT *pObj, IID *piid,
ITypeInfo **ppTypeInfo, UINT cp, LCID lcid)
{
HRESULT hr;
@@ -1738,7 +1694,7 @@
piid);
pProvideClassInfo2->Release();
DBG(("GetGUID: hr=0x%08x\n", hr));
- return FindIID(THIS_ pObj, NULL, piid, ppTypeInfo, cp, lcid);
+ return FindIID(aTHX_ pObj, NULL, piid, ppTypeInfo, cp, lcid);
}
IProvideClassInfo *pProvideClassInfo;
@@ -1817,7 +1773,7 @@
} /* FindDefaultSource */
IEnumVARIANT *
-CreateEnumVARIANT(CPERLarg_ WINOLEOBJECT *pObj)
+CreateEnumVARIANT(pTHX_ WINOLEOBJECT *pObj)
{
unsigned int argErr;
EXCEPINFO excepinfo;
@@ -1833,7 +1789,7 @@
dispParams.cArgs = 0;
HV *stash = SvSTASH(pObj->self);
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
Zero(&excepinfo, 1, EXCEPINFO);
hr = pObj->pDispatch->Invoke(DISPID_NEWENUM, IID_NULL,
@@ -1848,13 +1804,13 @@
(void**)&pEnum);
}
VariantClear(&result);
- CheckOleError(THIS_ stash, hr, &excepinfo);
+ CheckOleError(aTHX_ stash, hr, &excepinfo);
return pEnum;
} /* CreateEnumVARIANT */
SV *
-NextEnumElement(CPERLarg_ IEnumVARIANT *pEnum, HV *stash)
+NextEnumElement(pTHX_ IEnumVARIANT *pEnum, HV *stash)
{
HRESULT hr = S_OK;
SV *sv = &PL_sv_undef;
@@ -1863,13 +1819,13 @@
VariantInit(&variant);
if (SUCCEEDED(pEnum->Next(1, &variant, NULL))) {
sv = newSV(0);
- hr = SetSVFromVariantEx(THIS_ &variant, sv, stash);
+ hr = SetSVFromVariantEx(aTHX_ &variant, sv, stash);
}
VariantClear(&variant);
if (FAILED(hr)) {
SvREFCNT_dec(sv);
sv = &PL_sv_undef;
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
}
return sv;
@@ -1877,7 +1833,7 @@
//------------------------------------------------------------------------
-EventSink::EventSink(CPERLarg_ WINOLEOBJECT *pObj, SV *events,
+EventSink::EventSink(pTHX_ WINOLEOBJECT *pObj, SV *events,
REFIID riid, ITypeInfo *pTypeInfo)
{
DBG(("EventSink::EventSink\n"));
@@ -1886,20 +1842,26 @@
m_iid = riid;
m_pTypeInfo = pTypeInfo;
m_refcount = 1;
-#ifdef PERL_OBJECT
- m_PERL_OBJECT_THIS = PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ this->aTHX = aTHX;
#endif
}
EventSink::~EventSink(void)
{
-#ifdef PERL_OBJECT
- CPERLarg = m_PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX = PERL_GET_THX;
+ PERL_SET_THX(this->aTHX);
#endif
+
DBG(("EventSink::~EventSink\n"));
if (m_pTypeInfo)
m_pTypeInfo->Release();
SvREFCNT_dec(m_events);
+
+#ifdef PERL_IMPLICIT_CONTEXT
+ PERL_SET_THX(aTHX);
+#endif
}
HRESULT
@@ -1928,15 +1890,21 @@
EventSink::QueryInterface(REFIID iid, void **ppv)
{
#ifdef _DEBUG
-# ifdef PERL_OBJECT
- CPERLarg = m_PERL_OBJECT_THIS;
+# ifdef PERL_IMPLICIT_CONTEXT
+ pTHX = PERL_GET_THX;
+ PERL_SET_THX(this->aTHX);
# endif
+
OLECHAR wszGUID[80];
int len = StringFromGUID2(iid, wszGUID, sizeof(wszGUID)/sizeof(OLECHAR));
char szStr[OLE_BUF_SIZ];
- char *pszStr = GetMultiByte(THIS_ wszGUID, szStr, sizeof(szStr), CP_ACP);
+ char *pszStr = GetMultiByte(aTHX_ wszGUID, szStr, sizeof(szStr), CP_ACP);
DBG(("***QueryInterface %s\n", pszStr));
- ReleaseBuffer(THIS_ pszStr, szStr);
+ ReleaseBuffer(aTHX_ pszStr, szStr);
+
+# ifdef PERL_IMPLICIT_CONTEXT
+ PERL_SET_THX(aTHX);
+# endif
#endif
if (iid == IID_IUnknown || iid == IID_IDispatch || iid == m_iid)
@@ -2010,8 +1978,9 @@
EXCEPINFO *pexcepinfo,
UINT *puArgErr)
{
-#ifdef PERL_OBJECT
- CPERLarg = m_PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX = PERL_GET_THX;
+ PERL_SET_THX(this->aTHX);
#endif
DBG(("***Invoke dispid=%d args=%d\n", dispidMember, pdispparams->cArgs));
@@ -2024,10 +1993,13 @@
hr = m_pTypeInfo->GetNames(dispidMember, &bstr, 1, &count);
if (FAILED(hr)) {
DBG((" GetNames failed: 0x%08x\n", hr));
+#ifdef PERL_IMPLICIT_CONTEXT
+ PERL_SET_THX(aTHX);
+#endif
return S_OK;
}
- event = sv_2mortal(sv_setwide(THIS_ NULL, bstr, CP_ACP));
+ event = sv_2mortal(sv_setbstr(aTHX_ NULL, bstr, CP_ACP));
SysFreeString(bstr);
}
else {
@@ -2072,7 +2044,7 @@
DBG((" Arg %d vt=0x%04x\n", i, V_VT(pVariant)));
SV *sv = sv_newmortal();
// XXX Check return code
- SetSVFromVariantEx(THIS_ pVariant, sv, SvSTASH(m_pObj->self), TRUE);
+ SetSVFromVariantEx(aTHX_ pVariant, sv, SvSTASH(m_pObj->self), TRUE);
XPUSHs(sv);
}
PUTBACK;
@@ -2082,38 +2054,36 @@
LEAVE;
}
+#ifdef PERL_IMPLICIT_CONTEXT
+ PERL_SET_THX(aTHX);
+#endif
return S_OK;
}
-#ifdef _DEBUG
-#define Dummy(i) STDMETHODIMP EventSink::Dummy##i(void) \
- { DBG(("***Dummy%d\n", i)); return S_OK; }
-
-Dummy(1) Dummy(2) Dummy(3) Dummy(4) Dummy(5)
-Dummy(6) Dummy(7) Dummy(8) Dummy(9) Dummy(10)
-Dummy(11) Dummy(12) Dummy(13) Dummy(14) Dummy(15)
-Dummy(16) Dummy(17) Dummy(18) Dummy(19) Dummy(20)
-Dummy(21) Dummy(22) Dummy(23) Dummy(24) Dummy(25)
-#endif
-
//------------------------------------------------------------------------
-Forwarder::Forwarder(CPERLarg_ HV *stash, SV *method)
+Forwarder::Forwarder(pTHX_ HV *stash, SV *method)
{
m_stash = stash; // XXX refcount?
m_method = newSVsv(method);
m_refcount = 1;
-#ifdef PERL_OBJECT
- m_PERL_OBJECT_THIS = PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ this->aTHX = aTHX;
#endif
}
Forwarder::~Forwarder(void)
{
-#ifdef PERL_OBJECT
- CPERLarg = m_PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX = PERL_GET_THX;
+ PERL_SET_THX(this->aTHX);
#endif
+
SvREFCNT_dec(m_method);
+
+#ifdef PERL_IMPLICIT_CONTEXT
+ PERL_SET_THX(aTHX);
+#endif
}
STDMETHODIMP
@@ -2181,8 +2151,9 @@
EXCEPINFO *pexcepinfo,
UINT *puArgErr)
{
-#ifdef PERL_OBJECT
- CPERLarg = m_PERL_OBJECT_THIS;
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX = PERL_GET_THX;
+ PERL_SET_THX(this->aTHX);
#endif
DBG(("Forwarder::Invoke dispid=%d args=%d\n",
@@ -2196,7 +2167,7 @@
DBG((" Arg %d vt=0x%04x\n", i, V_VT(pVariant)));
SV *sv = sv_newmortal();
// XXX Check return code
- SetSVFromVariantEx(THIS_ pVariant, sv, m_stash, TRUE);
+ SetSVFromVariantEx(aTHX_ pVariant, sv, m_stash, TRUE);
XPUSHs(sv);
}
PUTBACK;
@@ -2204,13 +2175,18 @@
SPAGAIN;
FREETMPS;
LEAVE;
+
+#ifdef PERL_IMPLICIT_CONTEXT
+ PERL_SET_THX(aTHX);
+#endif
+
return S_OK;
}
//------------------------------------------------------------------------
SV *
-SetSVFromGUID(CPERLarg_ REFGUID rguid)
+SetSVFromGUID(pTHX_ REFGUID rguid)
{
dSP;
SV *sv = newSVsv(&PL_sv_undef);
@@ -2232,16 +2208,17 @@
OLECHAR wszGUID[80];
int len = StringFromGUID2(rguid, wszGUID,
sizeof(wszGUID)/sizeof(OLECHAR));
- if (len > 0) {
- wszGUID[len-2] = (OLECHAR) 0;
- sv_setwide(THIS_ sv, wszGUID+1, CP_ACP);
+ if (len > 3) {
+ BSTR bstr = SysAllocStringLen(wszGUID+1, len-3);
+ sv_setbstr(aTHX_ sv, bstr, CP_ACP);
+ SysFreeString(bstr);
}
}
return sv;
}
HRESULT
-SetSafeArrayFromAV(CPERLarg_ AV* av, VARTYPE vt, SAFEARRAY *psa,
+SetSafeArrayFromAV(pTHX_ AV* av, VARTYPE vt, SAFEARRAY *psa,
UINT cDims, UINT cp, LCID lcid)
{
HRESULT hr = SafeArrayLock(psa);
@@ -2293,12 +2270,12 @@
if (vt == VT_VARIANT) {
hr = SafeArrayPtrOfIndex(psa, pix, (void**)&pElement);
if (SUCCEEDED(hr))
- hr = SetVariantFromSVEx(THIS_ *psv, pElement, cp, lcid);
+ hr = SetVariantFromSVEx(aTHX_ *psv, pElement, cp, lcid);
}
else {
hr = SafeArrayPtrOfIndex(psa, pix, &V_BYREF(pElement));
if (SUCCEEDED(hr))
- hr = AssignVariantFromSV(THIS_ *psv, pElement,
+ hr = AssignVariantFromSV(aTHX_ *psv, pElement,
cp, lcid);
}
if (hr == DISP_E_BADINDEX)
@@ -2325,7 +2302,7 @@
}
HRESULT
-SetVariantFromSVEx(CPERLarg_ SV* sv, VARIANT *pVariant, UINT cp, LCID lcid)
+SetVariantFromSVEx(pTHX_ SV* sv, VARIANT *pVariant, UINT cp, LCID lcid)
{
HRESULT hr = S_OK;
VariantClear(pVariant);
@@ -2337,7 +2314,7 @@
/* Objects */
if (SvROK(sv)) {
if (sv_derived_from(sv, szWINOLE)) {
- WINOLEOBJECT *pObj = GetOleObject(THIS_ sv);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ sv);
if (pObj) {
pObj->pDispatch->AddRef();
V_VT(pVariant) = VT_DISPATCH;
@@ -2349,7 +2326,7 @@
if (sv_derived_from(sv, szWINOLEVARIANT)) {
WINOLEVARIANTOBJECT *pVarObj =
- GetOleVariantObject(THIS_ sv);
+ GetOleVariantObject(aTHX_ sv);
if (pVarObj) {
/* XXX Should we use VariantCopyInd? */
@@ -2423,7 +2400,7 @@
/* Create and fill VARIANT array */
SAFEARRAY *psa = SafeArrayCreate(VT_VARIANT, dim, psab);
if (psa)
- hr = SetSafeArrayFromAV(THIS_ (AV*)sv, VT_VARIANT, psa, dim,
+ hr = SetSafeArrayFromAV(aTHX_ (AV*)sv, VT_VARIANT, psa, dim,
cp, lcid);
else
hr = E_OUTOFMEMORY;
@@ -2454,7 +2431,7 @@
}
else if (SvPOK(sv)) {
V_VT(pVariant) = VT_BSTR;
- V_BSTR(pVariant) = AllocOleString(THIS_ SvPVX(sv), SvCUR(sv), cp);
+ V_BSTR(pVariant) = AllocOleString(aTHX_ SvPVX(sv), SvCUR(sv), cp);
}
else {
V_VT(pVariant) = VT_ERROR;
@@ -2466,14 +2443,14 @@
} /* SetVariantFromSVEx */
HRESULT
-SetVariantFromSV(CPERLarg_ SV* sv, VARIANT *pVariant, UINT cp)
+SetVariantFromSV(pTHX_ SV* sv, VARIANT *pVariant, UINT cp)
{
/* old API for PerlScript compatibility */
- return SetVariantFromSVEx(THIS_ sv, pVariant, cp, lcidDefault);
+ return SetVariantFromSVEx(aTHX_ sv, pVariant, cp, lcidDefault);
} /* SetVariantFromSV */
HRESULT
-AssignVariantFromSV(CPERLarg_ SV* sv, VARIANT *pVariant, UINT cp, LCID lcid)
+AssignVariantFromSV(pTHX_ SV* sv, VARIANT *pVariant, UINT cp, LCID lcid)
{
/* This function is similar to SetVariantFromSVEx except that
* it does NOT choose the variant type itself.
@@ -2564,7 +2541,7 @@
STRLEN len;
char *ptr = SvPV(sv, len);
V_VT(&variant) = VT_BSTR;
- V_BSTR(&variant) = AllocOleString(THIS_ ptr, len, cp);
+ V_BSTR(&variant) = AllocOleString(aTHX_ ptr, len, cp);
}
VARTYPE vt_base = vt & ~VT_BYREF;
@@ -2591,7 +2568,7 @@
{
STRLEN len;
char *ptr = SvPV(sv, len);
- BSTR bstr = AllocOleString(THIS_ ptr, len, cp);
+ BSTR bstr = AllocOleString(aTHX_ ptr, len, cp);
if (vt & VT_BYREF) {
SysFreeString(*V_BSTRREF(pVariant));
@@ -2617,7 +2594,7 @@
}
if (sv_isobject(sv)) {
/* Argument MUST be a valid Perl OLE object! */
- WINOLEOBJECT *pObj = GetOleObject(THIS_ sv);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ sv);
if (pObj) {
pObj->pDispatch->AddRef();
if (vt & VT_BYREF)
@@ -2641,7 +2618,7 @@
case VT_VARIANT:
if (vt & VT_BYREF)
- hr = SetVariantFromSVEx(THIS_ sv, V_VARIANTREF(pVariant), cp, lcid);
+ hr = SetVariantFromSVEx(aTHX_ sv, V_VARIANTREF(pVariant), cp, lcid);
else {
warn(MY_VERSION ": AssignVariantFromSV() with invalid type: "
"VT_VARIANT without VT_BYREF");
@@ -2653,7 +2630,7 @@
{
/* Argument MUST be a valid Perl OLE object! */
/* Query IUnknown interface to allow identity tests */
- WINOLEOBJECT *pObj = GetOleObject(THIS_ sv);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ sv);
if (pObj) {
IUnknown *punk;
hr = pObj->pDispatch->QueryInterface(IID_IUnknown, (void**)&punk);
@@ -2681,7 +2658,7 @@
VARIANT variant;
VariantInit(&variant);
V_VT(&variant) = VT_BSTR;
- V_BSTR(&variant) = AllocOleString(THIS_ ptr, len, cp);
+ V_BSTR(&variant) = AllocOleString(aTHX_ ptr, len, cp);
hr = VariantChangeTypeEx(&variant, &variant, lcid, 0, VT_DECIMAL);
if (SUCCEEDED(hr)) {
@@ -2718,7 +2695,7 @@
} /* AssignVariantFromSV */
HRESULT
-SetSVFromVariantEx(CPERLarg_ VARIANTARG *pVariant, SV* sv, HV *stash,
+SetSVFromVariantEx(pTHX_ VARIANTARG *pVariant, SV* sv, HV *stash,
BOOL bByRefObj)
{
HRESULT hr = S_OK;
@@ -2741,10 +2718,10 @@
hr = VariantCopy(&pVarObj->variant, pVariant);
if (FAILED(hr)) {
Safefree(pVarObj);
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
}
- AddToObjectChain(THIS_ (OBJECTHEADER*)pVarObj, WINOLEVARIANT_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pVarObj, WINOLEVARIANT_MAGIC);
SV *classname = newSVpv(HvNAME(stash), 0);
sv_catpvn(classname, "::Variant", 9);
sv_setref_pv(sv, SvPVX(classname), pVarObj);
@@ -2807,7 +2784,7 @@
break;
SV *val = newSV(0);
- hr = SetSVFromVariantEx(THIS_ &variant, val, stash);
+ hr = SetSVFromVariantEx(aTHX_ &variant, val, stash);
if (FAILED(hr)) {
SvREFCNT_dec(val);
break;
@@ -2877,12 +2854,12 @@
case VT_BSTR:
{
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
if (V_ISBYREF(pVariant))
- sv_setwide(THIS_ sv, *V_BSTRREF(pVariant), cp);
+ sv_setbstr(aTHX_ sv, *V_BSTRREF(pVariant), cp);
else
- sv_setwide(THIS_ sv, V_BSTR(pVariant), cp);
+ sv_setbstr(aTHX_ sv, V_BSTR(pVariant), cp);
break;
}
@@ -2897,11 +2874,11 @@
hr = VariantCopy(&pVarObj->variant, pVariant);
if (FAILED(hr)) {
Safefree(pVarObj);
- ReportOleError(THIS_ stash, hr, NULL, NULL);
+ ReportOleError(aTHX_ stash, hr, NULL, NULL);
break;
}
- AddToObjectChain(THIS_ (OBJECTHEADER*)pVarObj, WINOLEVARIANT_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pVarObj, WINOLEVARIANT_MAGIC);
classname = newSVpv(HvNAME(stash), 0);
sv_catpvn(classname, "::Variant", 9);
sv_setref_pv(sv, SvPVX(classname), pVarObj);
@@ -2927,7 +2904,7 @@
if (pDispatch) {
pDispatch->AddRef();
- sv_setsv(sv, CreatePerlObject(THIS_ stash, pDispatch, NULL));
+ sv_setsv(sv, CreatePerlObject(aTHX_ stash, pDispatch, NULL));
}
break;
}
@@ -2945,7 +2922,7 @@
if (punk &&
SUCCEEDED(punk->QueryInterface(IID_IDispatch, (void**)&pDispatch)))
{
- sv_setsv(sv, CreatePerlObject(THIS_ stash, pDispatch, NULL));
+ sv_setsv(sv, CreatePerlObject(aTHX_ stash, pDispatch, NULL));
}
break;
}
@@ -2964,14 +2941,14 @@
case VT_CY:
default:
{
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
VARIANT variant;
VariantInit(&variant);
hr = VariantChangeTypeEx(&variant, pVariant, lcid, 0, VT_BSTR);
if (SUCCEEDED(hr) && V_VT(&variant) == VT_BSTR)
- sv_setwide(THIS_ sv, V_BSTR(&variant), cp);
+ sv_setbstr(aTHX_ sv, V_BSTR(&variant), cp);
VariantClear(&variant);
break;
}
@@ -2982,13 +2959,13 @@
} /* SetSVFromVariantEx */
HRESULT
-SetSVFromVariant(CPERLarg_ VARIANTARG *pVariant, SV* sv, HV *stash)
+SetSVFromVariant(pTHX_ VARIANTARG *pVariant, SV* sv, HV *stash)
{
- return SetSVFromVariantEx(THIS_ pVariant, sv, stash);
+ return SetSVFromVariantEx(aTHX_ pVariant, sv, stash);
}
IV
-GetLocaleNumber(CPERLarg_ HV *hv, char *key, LCID lcid, LCTYPE lctype)
+GetLocaleNumber(pTHX_ HV *hv, char *key, LCID lcid, LCTYPE lctype)
{
if (hv) {
SV **psv = hv_fetch(hv, key, strlen(key), FALSE);
@@ -2996,17 +2973,51 @@
return SvIV(*psv);
}
- char *info;
- int len = GetLocaleInfo(lcid, lctype, NULL, 0);
- New(0, info, len, char);
- GetLocaleInfo(lcid, lctype, info, len);
- IV number = atol(info);
- Safefree(info);
+ IV number;
+ if (USING_WIDE()) {
+ WCHAR *info;
+ int len = GetLocaleInfoW(lcid, lctype, NULL, 0);
+ New(0, info, len, WCHAR);
+ GetLocaleInfoW(lcid, lctype, info, len);
+ number = _wtol(info);
+ Safefree(info);
+ }
+ else {
+ char *info;
+ int len = GetLocaleInfoA(lcid, lctype, NULL, 0);
+ New(0, info, len, char);
+ GetLocaleInfoA(lcid, lctype, info, len);
+ number = atol(info);
+ Safefree(info);
+ }
return number;
}
+WCHAR *
+GetLocaleStringW(pTHX_ HV *hv, char *key, LCID lcid, LCTYPE lctype)
+{
+ STRLEN len;
+ SV *sv;
+ if (hv) {
+ SV **psv = hv_fetch(hv, key, strlen(key), FALSE);
+ if (psv) {
+ char* ptr = SvPV(*psv, len);
+ ++len;
+ sv = sv_2mortal(newSV(len*sizeof(WCHAR)));
+ WCHAR* wptr = (WCHAR*)SvPVX(sv);
+ A2WHELPER(ptr, wptr, len*sizeof(WCHAR));
+ return wptr;
+ }
+ }
+
+ len = GetLocaleInfoW(lcid, lctype, NULL, 0);
+ sv = sv_2mortal(newSV(len*2));
+ GetLocaleInfoW(lcid, lctype, (WCHAR*)SvPVX(sv), len);
+ return (WCHAR*)SvPVX(sv);
+}
+
char *
-GetLocaleString(CPERLarg_ HV *hv, char *key, LCID lcid, LCTYPE lctype)
+GetLocaleString(pTHX_ HV *hv, char *key, LCID lcid, LCTYPE lctype)
{
if (hv) {
SV **psv = hv_fetch(hv, key, strlen(key), FALSE);
@@ -3014,14 +3025,14 @@
return SvPV_nolen(*psv);
}
- int len = GetLocaleInfo(lcid, lctype, NULL, 0);
+ int len = GetLocaleInfoA(lcid, lctype, NULL, 0);
SV *sv = sv_2mortal(newSV(len));
- GetLocaleInfo(lcid, lctype, SvPVX(sv), len);
+ GetLocaleInfoA(lcid, lctype, SvPVX(sv), len);
return SvPVX(sv);
}
void
-Initialize(CPERLarg_ HV *stash, DWORD dwCoInit=COINIT_MULTITHREADED)
+Initialize(pTHX_ HV *stash, DWORD dwCoInit=COINIT_MULTITHREADED)
{
dPERINTERP;
@@ -3053,7 +3064,7 @@
}
if (FAILED(hr) && hr != RPC_E_CHANGED_MODE)
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
}
LeaveCriticalSection(&g_CriticalSection);
@@ -3061,7 +3072,7 @@
} /* Initialize */
void
-Uninitialize(CPERLarg_ PERINTERP *pInterp)
+Uninitialize(pTHX_ PERINTERP *pInterp)
{
DBG(("Uninitialize\n"));
EnterCriticalSection(&g_CriticalSection);
@@ -3073,7 +3084,7 @@
switch (pHeader->lMagic) {
case WINOLE_MAGIC:
- ReleasePerlObject(THIS_ (WINOLEOBJECT*)pHeader);
+ ReleasePerlObject(aTHX_ (WINOLEOBJECT*)pHeader);
break;
case WINOLEENUM_MAGIC: {
@@ -3127,7 +3138,7 @@
} /* Uninitialize */
static void
-AtExit(pTHX_ CPERLarg_ void *pVoid)
+AtExit(pTHX_ void *pVoid)
{
PERINTERP *pInterp = (PERINTERP*)pVoid;
@@ -3136,7 +3147,7 @@
FreeLibrary(g_hOLE32);
if (g_hHHCTRL)
FreeLibrary(g_hHHCTRL);
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT)
+#ifdef PERL_IMPLICIT_CONTEXT
Safefree(pInterp);
#endif
DBG(("AtExit done\n"));
@@ -3144,18 +3155,13 @@
} /* AtExit */
void
-Bootstrap(CPERLarg)
+Bootstrap(pTHX)
{
dSP;
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT)
+#ifdef PERL_IMPLICIT_CONTEXT
PERINTERP *pInterp;
New(0, pInterp, 1, PERINTERP);
-
-# if (PATCHLEVEL == 4) && (SUBVERSION < 68)
- SV *sv = perl_get_sv(MY_VERSION, TRUE);
-# else
SV *sv = *hv_fetch(PL_modglobal, MY_VERSION, sizeof(MY_VERSION)-1, TRUE);
-# endif
if (SvOK(sv))
warn(MY_VERSION ": Per-interpreter data already set");
@@ -3189,15 +3195,12 @@
SPAGAIN;
SvREFCNT_dec(cmd);
-
-#if (PATCHLEVEL > 4) || (SUBVERSION >= 68)
perl_atexit(AtExit, INTERP);
-#endif
} /* Bootstrap */
BOOL
-CallObjectMethod(CPERLarg_ SV **mark, I32 ax, I32 items, char *pszMethod)
+CallObjectMethod(pTHX_ SV **mark, I32 ax, I32 items, char *pszMethod)
{
/* If the 1st arg on the stack is a Win32::OLE object then the method
* is called as an object method through Win32::OLE::Dispatch (like
@@ -3239,9 +3242,7 @@
} /* CallObjectMethod */
-#if defined (__cplusplus)
-}
-#endif
+} /* extern "C" */
/*##########################################################################*/
@@ -3250,7 +3251,7 @@
PROTOTYPES: DISABLE
BOOT:
- Bootstrap(PERL_OBJECT_THIS);
+ Bootstrap(aTHX);
void
Initialize(...)
@@ -3267,7 +3268,7 @@
"MessageLoop", "QuitMessageLoop",
"FreeUnusedLibraries", "_Unique"};
- if (CallObjectMethod(THIS_ mark, ax, items, paszMethod[ix]))
+ if (CallObjectMethod(aTHX_ mark, ax, items, paszMethod[ix]))
return;
DBG(("Win32::OLE->%s()\n", paszMethod[ix]));
@@ -3278,7 +3279,7 @@
}
HV *stash = gv_stashsv(ST(0), TRUE);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
switch (ix) {
case 0: { // Initialize
@@ -3286,12 +3287,12 @@
if (items > 1 && SvOK(ST(1)))
dwCoInit = SvIV(ST(1));
- Initialize(THIS_ gv_stashsv(ST(0), TRUE), dwCoInit);
+ Initialize(aTHX_ gv_stashsv(ST(0), TRUE), dwCoInit);
break;
}
case 1: { // Uninitialize
dPERINTERP;
- Uninitialize(THIS_ INTERP);
+ Uninitialize(aTHX_ INTERP);
break;
}
case 2: // SpinMessageLoop
@@ -3337,7 +3338,7 @@
OLECHAR *pBuffer;
HRESULT hr;
- if (CallObjectMethod(THIS_ mark, ax, items, "new"))
+ if (CallObjectMethod(aTHX_ mark, ax, items, "new"))
return;
if (items < 2 || items > 3) {
@@ -3349,13 +3350,13 @@
HV *stash = gv_stashsv(self, TRUE);
SV *progid = ST(1);
SV *destroy = NULL;
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
- Initialize(THIS_ stash);
- SetLastOleError(THIS_ stash);
+ Initialize(aTHX_ stash);
+ SetLastOleError(aTHX_ stash);
if (items == 3)
- destroy = CheckDestroyFunction(THIS_ ST(2), "Win32::OLE->new");
+ destroy = CheckDestroyFunction(aTHX_ ST(2), "Win32::OLE->new");
ST(0) = &PL_sv_undef;
@@ -3363,18 +3364,18 @@
char *pszProgID;
if (!SvROK(progid) || SvTYPE(SvRV(progid)) != SVt_PVAV) {
pszProgID = SvPV_nolen(progid);
- pBuffer = GetWideChar(THIS_ pszProgID, Buffer, OLE_BUF_SIZ, cp);
+ pBuffer = GetWideChar(aTHX_ pszProgID, Buffer, OLE_BUF_SIZ, cp);
if (isalpha(pszProgID[0]))
hr = CLSIDFromProgID(pBuffer, &clsid);
else
hr = CLSIDFromString(pBuffer, &clsid);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
if (SUCCEEDED(hr)) {
hr = CoCreateInstance(clsid, NULL, CLSCTX_SERVER,
IID_IDispatch, (void**)&pDispatch);
}
- if (!CheckOleError(THIS_ stash, hr)) {
- ST(0) = CreatePerlObject(THIS_ stash, pDispatch, destroy);
+ if (!CheckOleError(aTHX_ stash, hr)) {
+ ST(0) = CreatePerlObject(aTHX_ stash, pDispatch, destroy);
DBG(("Win32::OLE::new |%lx| |%lx|\n", ST(0), pDispatch));
}
XSRETURN(1);
@@ -3384,7 +3385,7 @@
dPERINTERP;
if (!g_pfnCoCreateInstanceEx) {
hr = HRESULT_FROM_WIN32(ERROR_SERVICE_DOES_NOT_EXIST);
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN(1);
}
@@ -3401,23 +3402,23 @@
char *pszHost = NULL;
if (SvPOK(host)) {
pszHost = SvPVX(host);
- if (IsLocalMachine(THIS_ pszHost))
+ if (IsLocalMachine(aTHX_ pszHost))
pszHost = NULL;
}
/* determine CLSID */
pszProgID = SvPV_nolen(progid);
- pBuffer = GetWideChar(THIS_ pszProgID, Buffer, OLE_BUF_SIZ, cp);
+ pBuffer = GetWideChar(aTHX_ pszProgID, Buffer, OLE_BUF_SIZ, cp);
if (isalpha(pszProgID[0])) {
hr = CLSIDFromProgID(pBuffer, &clsid);
if (FAILED(hr) && pszHost)
- hr = CLSIDFromRemoteRegistry(THIS_ pszHost, pszProgID, &clsid);
+ hr = CLSIDFromRemoteRegistry(aTHX_ pszHost, pszProgID, &clsid);
}
else
hr = CLSIDFromString(pBuffer, &clsid);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
if (FAILED(hr)) {
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN(1);
}
@@ -3429,7 +3430,7 @@
Zero(&ServerInfo, 1, COSERVERINFO);
if (pszHost)
- ServerInfo.pwszName = GetWideChar(THIS_ pszHost, ServerName,
+ ServerInfo.pwszName = GetWideChar(aTHX_ pszHost, ServerName,
OLE_BUF_SIZ, cp);
else
clsctx = CLSCTX_SERVER;
@@ -3440,10 +3441,10 @@
/* create instance on remote server */
hr = g_pfnCoCreateInstanceEx(clsid, NULL, clsctx, &ServerInfo,
1, &multi_qi);
- ReleaseBuffer(THIS_ ServerInfo.pwszName, ServerName);
- if (!CheckOleError(THIS_ stash, hr)) {
+ ReleaseBuffer(aTHX_ ServerInfo.pwszName, ServerName);
+ if (!CheckOleError(aTHX_ stash, hr)) {
pDispatch = (IDispatch*)multi_qi.pItf;
- ST(0) = CreatePerlObject(THIS_ stash, pDispatch, destroy);
+ ST(0) = CreatePerlObject(aTHX_ stash, pDispatch, destroy);
DBG(("Win32::OLE::new |%lx| |%lx|\n", ST(0), pDispatch));
}
XSRETURN(1);
@@ -3454,11 +3455,11 @@
SV *self
PPCODE:
{
- WINOLEOBJECT *pObj = GetOleObject(THIS_ self, TRUE);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self, TRUE);
DBG(("Win32::OLE::DESTROY |%lx| |%lx|\n", pObj,
pObj ? pObj->pDispatch : NULL));
if (pObj) {
- ReleasePerlObject(THIS_ pObj);
+ ReleasePerlObject(aTHX_ pObj);
pObj->flags |= OBJFLAG_DESTROYED;
}
XSRETURN_EMPTY;
@@ -3499,16 +3500,16 @@
XSRETURN(1);
}
- pObj = GetOleObject(THIS_ self);
+ pObj = GetOleObject(aTHX_ self);
if (!pObj) {
XSRETURN(1);
}
HV *stash = SvSTASH(pObj->self);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
/* allow [wFlags, 'Method'] instead of 'Method' */
if (SvROK(method) && (sv = SvRV(method)) && SvTYPE(sv) == SVt_PVAV &&
@@ -3521,7 +3522,7 @@
if (SvPOK(method)) {
buffer = SvPV(method, length);
if (length > 0) {
- int newenum = QueryPkgVar(THIS_ stash, _NEWENUM_NAME, _NEWENUM_LEN);
+ int newenum = QueryPkgVar(aTHX_ stash, _NEWENUM_NAME, _NEWENUM_LEN);
if (newenum && strEQ(buffer, "_NewEnum")) {
AV *av = newAV();
PUSHMARK(sp);
@@ -3536,11 +3537,11 @@
XSRETURN_YES;
}
- hr = GetHashedDispID(THIS_ pObj, buffer, length, dispID, lcid, cp);
+ hr = GetHashedDispID(aTHX_ pObj, buffer, length, dispID, lcid, cp);
if (FAILED(hr)) {
if (PL_hints & HINT_STRICT_SUBS) {
err = newSVpvf(" in GetIDsOfNames of \"%s\"", buffer);
- ReportOleError(THIS_ stash, hr, NULL, sv_2mortal(err));
+ ReportOleError(aTHX_ stash, hr, NULL, sv_2mortal(err));
}
XSRETURN_EMPTY;
}
@@ -3582,12 +3583,12 @@
New(0, rgszNames, 1+dispParams.cNamedArgs, OLECHAR*);
New(0, rgdispids, 1+dispParams.cNamedArgs, DISPID);
- rgszNames[0] = AllocOleString(THIS_ buffer, length, cp);
+ rgszNames[0] = AllocOleString(aTHX_ buffer, length, cp);
hv_iterinit(hv);
for (index = 0; index < dispParams.cNamedArgs; ++index) {
rghe[index] = hv_iternext(hv);
char *pszName = hv_iterkey(rghe[index], &len);
- rgszNames[1+index] = AllocOleString(THIS_ pszName, len, cp);
+ rgszNames[1+index] = AllocOleString(aTHX_ pszName, len, cp);
}
hr = pObj->pDispatch->GetIDsOfNames(IID_NULL, rgszNames,
@@ -3596,7 +3597,7 @@
if (SUCCEEDED(hr)) {
for (index = 0; index < dispParams.cNamedArgs; ++index) {
dispParams.rgdispidNamedArgs[index] = rgdispids[index+1];
- hr = SetVariantFromSVEx(THIS_ hv_iterval(hv, rghe[index]),
+ hr = SetVariantFromSVEx(aTHX_ hv_iterval(hv, rghe[index]),
&dispParams.rgvarg[index], cp, lcid);
if (FAILED(hr))
break;
@@ -3640,7 +3641,7 @@
for(index = dispParams.cNamedArgs; index < dispParams.cArgs; ++index) {
SV *sv = ST(items-1-(index-dispParams.cNamedArgs));
- hr = SetVariantFromSVEx(THIS_ sv, &dispParams.rgvarg[index],
+ hr = SetVariantFromSVEx(aTHX_ sv, &dispParams.rgvarg[index],
cp, lcid);
if (FAILED(hr))
goto Cleanup;
@@ -3671,7 +3672,7 @@
if (SUCCEEDED(hr)) {
if (sv_isobject(retval) && sv_derived_from(retval, szWINOLEVARIANT)) {
WINOLEVARIANTOBJECT *pVarObj =
- GetOleVariantObject(THIS_ retval);
+ GetOleVariantObject(aTHX_ retval);
if (pVarObj) {
VariantClear(&pVarObj->byref);
@@ -3681,7 +3682,7 @@
}
}
else {
- hr = SetSVFromVariantEx(THIS_ &result, retval, stash);
+ hr = SetSVFromVariantEx(aTHX_ &result, retval, stash);
ST(0) = &PL_sv_yes;
}
}
@@ -3731,7 +3732,7 @@
if (dispParams.rgdispidNamedArgs != &dispIDParam)
Safefree(dispParams.rgdispidNamedArgs);
- CheckOleError(THIS_ stash, hr, &excepinfo, err);
+ CheckOleError(aTHX_ stash, hr, &excepinfo, err);
XSRETURN(1);
}
@@ -3740,7 +3741,7 @@
EnumAllObjects(...)
PPCODE:
{
- if (CallObjectMethod(THIS_ mark, ax, items, "EnumAllObjects"))
+ if (CallObjectMethod(aTHX_ mark, ax, items, "EnumAllObjects"))
return;
if (items > 2) {
@@ -3790,7 +3791,7 @@
SV *method
PPCODE:
{
- if (CallObjectMethod(THIS_ mark, ax, items, "Forward"))
+ if (CallObjectMethod(aTHX_ mark, ax, items, "Forward"))
return;
if (!SvROK(method) || SvTYPE(SvRV(method)) != SVt_PVCV) {
@@ -3799,8 +3800,8 @@
}
HV *stash = gv_stashsv(self, TRUE);
- IDispatch *pDispatch = new Forwarder(THIS_ stash, method);
- ST(0) = CreatePerlObject(THIS_ stash, pDispatch, NULL);
+ IDispatch *pDispatch = new Forwarder(aTHX_ stash, method);
+ ST(0) = CreatePerlObject(aTHX_ stash, pDispatch, NULL);
XSRETURN(1);
}
@@ -3816,7 +3817,7 @@
IUnknown *pUnknown;
IDispatch *pDispatch;
- if (CallObjectMethod(THIS_ mark, ax, items, "GetActiveObject"))
+ if (CallObjectMethod(aTHX_ mark, ax, items, "GetActiveObject"))
return;
if (items < 2 || items > 3) {
@@ -3828,23 +3829,23 @@
HV *stash = gv_stashsv(self, TRUE);
SV *progid = ST(1);
SV *destroy = NULL;
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
- Initialize(THIS_ stash);
- SetLastOleError(THIS_ stash);
+ Initialize(aTHX_ stash);
+ SetLastOleError(aTHX_ stash);
if (items == 3)
- destroy = CheckDestroyFunction(THIS_ ST(2),
+ destroy = CheckDestroyFunction(aTHX_ ST(2),
"Win32::OLE->GetActiveObject");
buffer = SvPV_nolen(progid);
- pBuffer = GetWideChar(THIS_ buffer, Buffer, OLE_BUF_SIZ, cp);
+ pBuffer = GetWideChar(aTHX_ buffer, Buffer, OLE_BUF_SIZ, cp);
if (isalpha(buffer[0]))
hr = CLSIDFromProgID(pBuffer, &clsid);
else
hr = CLSIDFromString(pBuffer, &clsid);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
- if (CheckOleError(THIS_ stash, hr))
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
hr = GetActiveObject(clsid, 0, &pUnknown);
@@ -3854,10 +3855,10 @@
hr = pUnknown->QueryInterface(IID_IDispatch, (void**)&pDispatch);
pUnknown->Release();
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
- ST(0) = CreatePerlObject(THIS_ stash, pDispatch, destroy);
+ ST(0) = CreatePerlObject(aTHX_ stash, pDispatch, destroy);
DBG(("Win32::OLE::GetActiveObject |%lx| |%lx|\n", ST(0), pDispatch));
XSRETURN(1);
}
@@ -3875,7 +3876,7 @@
ULONG ulEaten;
HRESULT hr;
- if (CallObjectMethod(THIS_ mark, ax, items, "GetObject"))
+ if (CallObjectMethod(aTHX_ mark, ax, items, "GetObject"))
return;
if (items < 2 || items > 3) {
@@ -3887,27 +3888,27 @@
HV *stash = gv_stashsv(self, TRUE);
SV *pathname = ST(1);
SV *destroy = NULL;
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
- Initialize(THIS_ stash);
- SetLastOleError(THIS_ stash);
+ Initialize(aTHX_ stash);
+ SetLastOleError(aTHX_ stash);
if (items == 3)
- destroy = CheckDestroyFunction(THIS_ ST(2), "Win32::OLE->GetObject");
+ destroy = CheckDestroyFunction(aTHX_ ST(2), "Win32::OLE->GetObject");
hr = CreateBindCtx(0, &pBindCtx);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
buffer = SvPV_nolen(pathname);
- pBuffer = GetWideChar(THIS_ buffer, Buffer, OLE_BUF_SIZ, cp);
+ pBuffer = GetWideChar(aTHX_ buffer, Buffer, OLE_BUF_SIZ, cp);
hr = MkParseDisplayName(pBindCtx, pBuffer, &ulEaten, &pMoniker);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
if (FAILED(hr)) {
pBindCtx->Release();
SV *sv = sv_newmortal();
sv_setpvf(sv, "after character %lu in \"%s\"", ulEaten, buffer);
- ReportOleError(THIS_ stash, hr, NULL, sv);
+ ReportOleError(aTHX_ stash, hr, NULL, sv);
XSRETURN_EMPTY;
}
@@ -3915,10 +3916,10 @@
(void**)&pDispatch);
pBindCtx->Release();
pMoniker->Release();
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
- ST(0) = CreatePerlObject(THIS_ stash, pDispatch, destroy);
+ ST(0) = CreatePerlObject(aTHX_ stash, pDispatch, destroy);
XSRETURN(1);
}
@@ -3927,7 +3928,7 @@
SV *self
PPCODE:
{
- WINOLEOBJECT *pObj = GetOleObject(THIS_ self);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
@@ -3935,21 +3936,21 @@
TYPEATTR *pTypeAttr;
HV *stash = gv_stashsv(self, TRUE);
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
HRESULT hr = pObj->pDispatch->GetTypeInfo(0, lcid, &pTypeInfo);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN_EMPTY;
}
- ST(0) = sv_2mortal(CreateTypeInfoObject(THIS_ pTypeInfo, pTypeAttr));
+ ST(0) = sv_2mortal(CreateTypeInfoObject(aTHX_ pTypeInfo, pTypeAttr));
XSRETURN(1);
}
@@ -3959,7 +3960,7 @@
SV *itf
PPCODE:
{
- WINOLEOBJECT *pObj = GetOleObject(THIS_ self);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
@@ -3972,29 +3973,29 @@
DBG(("QueryInterface(%s)\n", pszItf));
HV *stash = SvSTASH(pObj->self);
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
- HRESULT hr = FindIID(THIS_ pObj, pszItf, &iid, NULL, cp, lcid);
- if (CheckOleError(THIS_ stash, hr))
+ HRESULT hr = FindIID(aTHX_ pObj, pszItf, &iid, NULL, cp, lcid);
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
IUnknown *pUnknown;
hr = pObj->pDispatch->QueryInterface(iid, (void**)&pUnknown);
DBG((" QueryInterface(iid): 0x%08x\n", hr));
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
IDispatch *pDispatch;
hr = pUnknown->QueryInterface(IID_IDispatch, (void**)&pDispatch);
DBG((" QueryInterface(IDispatch): 0x%08x\n", hr));
pUnknown->Release();
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
- ST(0) = CreatePerlObject(THIS_ stash, pDispatch, NULL);
+ ST(0) = CreatePerlObject(aTHX_ stash, pDispatch, NULL);
DBG(("Win32::OLE::QueryInterface |%lx| |%lx|\n", ST(0), pDispatch));
XSRETURN(1);
}
@@ -4003,7 +4004,7 @@
QueryObjectType(...)
PPCODE:
{
- if (CallObjectMethod(THIS_ mark, ax, items, "QueryObjectType"))
+ if (CallObjectMethod(aTHX_ mark, ax, items, "QueryObjectType"))
return;
if (items != 2) {
@@ -4018,7 +4019,7 @@
XSRETURN_EMPTY;
}
- WINOLEOBJECT *pObj = GetOleObject(THIS_ object);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ object);
if (!pObj)
XSRETURN_EMPTY;
@@ -4032,12 +4033,12 @@
XSRETURN_EMPTY;
HV *stash = gv_stashsv(ST(0), TRUE);
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
hr = pObj->pDispatch->GetTypeInfo(0, lcid, &pTypeInfo);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
/* Return ('TypeLib Name', 'Class Name') in array context */
@@ -4045,7 +4046,7 @@
hr = pTypeInfo->GetContainingTypeLib(&pTypeLib, &count);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN_EMPTY;
}
@@ -4053,20 +4054,20 @@
pTypeLib->Release();
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN_EMPTY;
}
- PUSHs(sv_2mortal(sv_setwide(THIS_ NULL, bstr, cp)));
+ PUSHs(sv_2mortal(sv_setbstr(aTHX_ NULL, bstr, cp)));
SysFreeString(bstr);
}
hr = pTypeInfo->GetDocumentation(MEMBERID_NIL, &bstr, NULL, NULL, NULL);
pTypeInfo->Release();
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
- PUSHs(sv_2mortal(sv_setwide(THIS_ NULL, bstr, cp)));
+ PUSHs(sv_2mortal(sv_setbstr(aTHX_ NULL, bstr, cp)));
SysFreeString(bstr);
}
@@ -4074,7 +4075,7 @@
WithEvents(...)
PPCODE:
{
- if (CallObjectMethod(THIS_ mark, ax, items, "WithEvents"))
+ if (CallObjectMethod(aTHX_ mark, ax, items, "WithEvents"))
return;
if (items < 2) {
@@ -4082,7 +4083,7 @@
XSRETURN_EMPTY;
}
- WINOLEOBJECT *pObj = GetOleObject(THIS_ ST(1));
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ ST(1));
if (!pObj)
XSRETURN_EMPTY;
@@ -4100,13 +4101,13 @@
// make sure we are running in a single threaded apartment
HRESULT hr = CoInitialize(NULL);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
CoUninitialize();
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
- SetLastOleError(THIS_ stash);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
+ SetLastOleError(aTHX_ stash);
IID iid;
ITypeInfo *pTypeInfo = NULL;
@@ -4115,7 +4116,7 @@
if (items > 3) {
SV *itf = ST(3);
if (sv_isobject(itf) && sv_derived_from(itf, szWINOLETYPEINFO)) {
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ itf);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ itf);
if (!pObj)
XSRETURN_EMPTY;
@@ -4174,19 +4175,19 @@
else { /* interface _not_ a Win32::OLE::TypeInfo object */
char *pszItf = SvPV_nolen(itf);
if (isalpha(pszItf[0]))
- hr = FindIID(THIS_ pObj, pszItf, &iid, &pTypeInfo, cp, lcid);
+ hr = FindIID(aTHX_ pObj, pszItf, &iid, &pTypeInfo, cp, lcid);
else {
OLECHAR Buffer[OLE_BUF_SIZ];
- OLECHAR *pBuffer = GetWideChar(THIS_ pszItf, Buffer, OLE_BUF_SIZ, cp);
+ OLECHAR *pBuffer = GetWideChar(aTHX_ pszItf, Buffer, OLE_BUF_SIZ, cp);
hr = IIDFromString(pBuffer, &iid);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
}
}
}
else
- hr = FindDefaultSource(THIS_ pObj, &iid, &pTypeInfo, cp, lcid);
+ hr = FindDefaultSource(aTHX_ pObj, &iid, &pTypeInfo, cp, lcid);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
// Get IConnectionPointContainer interface
@@ -4196,7 +4197,7 @@
DBG(("QueryInterFace(IConnectionPointContainer): hr=0x%08x\n", hr));
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN_EMPTY;
}
@@ -4208,12 +4209,12 @@
if (FAILED(hr)) {
if (pTypeInfo)
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN_EMPTY;
}
// Connect our EventSink object to it
- pObj->pEventSink = new EventSink(THIS_ pObj, handler, iid, pTypeInfo);
+ pObj->pEventSink = new EventSink(aTHX_ pObj, handler, iid, pTypeInfo);
hr = pObj->pEventSink->Advise(pConnectionPoint);
pConnectionPoint->Release();
DBG(("Advise: hr=0x%08x\n", hr));
@@ -4222,7 +4223,7 @@
pTypeInfo->Release();
pObj->pEventSink->Release();
pObj->pEventSink = NULL;
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
}
#ifdef _DEBUG
@@ -4249,7 +4250,7 @@
SV *self
PPCODE:
{
- WINOLEOBJECT *pObj = GetOleObject(THIS_ self, TRUE);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self, TRUE);
DBG(("Win32::OLE::Tie::DESTROY |%lx| |%lx|\n", pObj,
pObj ? pObj->pDispatch : NULL));
@@ -4261,12 +4262,12 @@
/* make sure the reference to the tied hash is still valid */
sv_unmagic((SV*)pObj->self, 'P');
sv_magic((SV*)pObj->self, self, 'P', Nullch, 0);
- ReleasePerlObject(THIS_ pObj);
+ ReleasePerlObject(aTHX_ pObj);
}
/* untie hash because we free the object *right now* */
sv_unmagic((SV*)pObj->self, 'P');
}
- RemoveFromObjectChain(THIS_ (OBJECTHEADER*)pObj);
+ RemoveFromObjectChain(aTHX_ (OBJECTHEADER*)pObj);
Safefree(pObj);
}
DBG(("End of Win32::OLE::Tie::DESTROY\n"));
@@ -4297,37 +4298,37 @@
XSRETURN(1);
}
- WINOLEOBJECT *pObj = GetOleObject(THIS_ self);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self);
DBG(("Win32::OLE::Tie::Fetch(0x%08x,'%s')\n", pObj, buffer));
if (!pObj)
XSRETURN_EMPTY;
HV *stash = SvSTASH(pObj->self);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
ST(0) = &PL_sv_undef;
VariantInit(&result);
VariantInit(&propName);
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
dispParams.cArgs = 0;
dispParams.rgvarg = NULL;
dispParams.cNamedArgs = 0;
dispParams.rgdispidNamedArgs = NULL;
- hr = GetHashedDispID(THIS_ pObj, buffer, length, dispID, lcid, cp);
+ hr = GetHashedDispID(aTHX_ pObj, buffer, length, dispID, lcid, cp);
if (FAILED(hr)) {
if (!SvTRUE(def)) {
SV *err = newSVpvf(" in GetIDsOfNames \"%s\"", buffer);
- ReportOleError(THIS_ stash, hr, NULL, sv_2mortal(err));
+ ReportOleError(aTHX_ stash, hr, NULL, sv_2mortal(err));
XSRETURN(1);
}
/* default method call: $self->{Key} ---> $self->Item('Key') */
V_VT(&propName) = VT_BSTR;
- V_BSTR(&propName) = AllocOleString(THIS_ buffer, length, cp);
+ V_BSTR(&propName) = AllocOleString(aTHX_ buffer, length, cp);
dispParams.cArgs = 1;
dispParams.rgvarg = &propName;
}
@@ -4343,13 +4344,13 @@
SV *sv = sv_newmortal();
sv_setpvf(sv, "in METHOD/PROPERTYGET \"%s\"", buffer);
VariantClear(&result);
- ReportOleError(THIS_ stash, hr, &excepinfo, sv);
+ ReportOleError(aTHX_ stash, hr, &excepinfo, sv);
}
else {
ST(0) = sv_newmortal();
- hr = SetSVFromVariantEx(THIS_ &result, ST(0), stash);
+ hr = SetSVFromVariantEx(aTHX_ &result, ST(0), stash);
VariantClear(&result);
- CheckOleError(THIS_ stash, hr);
+ CheckOleError(aTHX_ stash, hr);
}
XSRETURN(1);
@@ -4375,15 +4376,15 @@
VARIANTARG propertyValue[2];
SV *err = NULL;
- WINOLEOBJECT *pObj = GetOleObject(THIS_ self);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
HV *stash = SvSTASH(pObj->self);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
- LCID lcid = QueryPkgVar(THIS_ stash, LCID_NAME, LCID_LEN, lcidDefault);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
dispParams.rgdispidNamedArgs = &dispIDParam;
dispParams.rgvarg = propertyValue;
@@ -4395,20 +4396,20 @@
Zero(&excepinfo, 1, EXCEPINFO);
buffer = SvPV(key, length);
- hr = GetHashedDispID(THIS_ pObj, buffer, length, dispID, lcid, cp);
+ hr = GetHashedDispID(aTHX_ pObj, buffer, length, dispID, lcid, cp);
if (FAILED(hr)) {
if (!SvTRUE(def)) {
SV *err = newSVpvf(" in GetIDsOfNames \"%s\"", buffer);
- ReportOleError(THIS_ stash, hr, NULL, sv_2mortal(err));
+ ReportOleError(aTHX_ stash, hr, NULL, sv_2mortal(err));
XSRETURN_EMPTY;
}
dispParams.cArgs = 2;
V_VT(&propertyValue[1]) = VT_BSTR;
- V_BSTR(&propertyValue[1]) = AllocOleString(THIS_ buffer, length, cp);
+ V_BSTR(&propertyValue[1]) = AllocOleString(aTHX_ buffer, length, cp);
}
- hr = SetVariantFromSVEx(THIS_ value, &propertyValue[0], cp, lcid);
+ hr = SetVariantFromSVEx(aTHX_ value, &propertyValue[0], cp, lcid);
if (SUCCEEDED(hr)) {
USHORT wFlags = DISPATCH_PROPERTYPUT;
@@ -4429,7 +4430,7 @@
for(index = 0; index < dispParams.cArgs; ++index)
VariantClear(&propertyValue[index]);
- if (CheckOleError(THIS_ stash, hr, &excepinfo, err))
+ if (CheckOleError(aTHX_ stash, hr, &excepinfo, err))
XSRETURN_EMPTY;
XSRETURN_YES;
@@ -4445,7 +4446,7 @@
PPCODE:
{
/* NEXTKEY has an additional "lastkey" arg, which is not needed here */
- WINOLEOBJECT *pObj = GetOleObject(THIS_ self);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self);
char *paszMethod[] = {"FIRSTKEY", "NEXTKEY", "FIRSTENUM", "NEXTENUM"};
DBG(("%s called, pObj=%p\n", paszMethod[ix], pObj));
@@ -4453,22 +4454,22 @@
XSRETURN_EMPTY;
HV *stash = SvSTASH(pObj->self);
- SetLastOleError(THIS_ stash);
+ SetLastOleError(aTHX_ stash);
switch (ix) {
case 0: /* FIRSTKEY */
- FetchTypeInfo(THIS_ pObj);
+ FetchTypeInfo(aTHX_ pObj);
pObj->PropIndex = 0;
case 1: /* NEXTKEY */
- ST(0) = NextPropertyName(THIS_ pObj);
+ ST(0) = NextPropertyName(aTHX_ pObj);
break;
case 2: /* FIRSTENUM */
if (pObj->pEnum)
pObj->pEnum->Release();
- pObj->pEnum = CreateEnumVARIANT(THIS_ pObj);
+ pObj->pEnum = CreateEnumVARIANT(aTHX_ pObj);
case 3: /* NEXTENUM */
- ST(0) = NextEnumElement(THIS_ pObj->pEnum, stash);
+ ST(0) = NextEnumElement(aTHX_ pObj->pEnum, stash);
if (!SvOK(ST(0))) {
pObj->pEnum->Release();
pObj->pEnum = NULL;
@@ -4507,35 +4508,35 @@
HV *stash = gv_stashpv(szWINOLE, TRUE);
unsigned int count;
- Initialize(THIS_ stash);
- SetLastOleError(THIS_ stash);
+ Initialize(aTHX_ stash);
+ SetLastOleError(aTHX_ stash);
char *pszBuffer = SvPV_nolen(classid);
- pBuffer = GetWideChar(THIS_ pszBuffer, Buffer, OLE_BUF_SIZ, cp);
+ pBuffer = GetWideChar(aTHX_ pszBuffer, Buffer, OLE_BUF_SIZ, cp);
hr = CLSIDFromString(pBuffer, &clsid);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
- if (CheckOleError(THIS_ stash, hr))
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
hr = LoadRegTypeLib(clsid, major, minor, lcid, &pTypeLib);
if (FAILED(hr) && SvPOK(typelib)) {
/* typelib not registerd, try to read from file "typelib" */
pszBuffer = SvPV_nolen(typelib);
- pBuffer = GetWideChar(THIS_ pszBuffer, Buffer, OLE_BUF_SIZ, cp);
+ pBuffer = GetWideChar(aTHX_ pszBuffer, Buffer, OLE_BUF_SIZ, cp);
hr = LoadTypeLibEx(pBuffer, REGKIND_NONE, &pTypeLib);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
}
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
hr = pTypeLib->GetLibAttr(&pTLibAttr);
if (FAILED(hr)) {
pTypeLib->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN_EMPTY;
}
- ST(0) = sv_2mortal(CreateTypeLibObject(THIS_ pTypeLib, pTLibAttr));
+ ST(0) = sv_2mortal(CreateTypeLibObject(aTHX_ pTypeLib, pTLibAttr));
XSRETURN(1);
}
@@ -4551,7 +4552,7 @@
HV *hv;
unsigned int count;
- WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(THIS_ typelib);
+ WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(aTHX_ typelib);
if (!pObj)
XSRETURN_EMPTY;
@@ -4573,13 +4574,13 @@
TYPEATTR *pTypeAttr;
hr = pObj->pTypeLib->GetTypeInfo(index, &pTypeInfo);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
continue;
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
continue;
}
@@ -4588,7 +4589,7 @@
hr = pTypeInfo->GetVarDesc(iVar, &pVarDesc);
/* XXX LEAK alert */
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
continue;
if (pVarDesc->varkind == VAR_CONST &&
@@ -4601,15 +4602,15 @@
char szName[64];
hr = pTypeInfo->GetNames(pVarDesc->memid, &bstr, 1, &cName);
- if (CheckOleError(THIS_ stash, hr) || cName == 0 || !bstr)
+ if (CheckOleError(aTHX_ stash, hr) || cName == 0 || !bstr)
continue;
- char *pszName = GetMultiByte(THIS_ bstr,
+ char *pszName = GetMultiByte(aTHX_ bstr,
szName, sizeof(szName), cp);
SV *sv = newSV(0);
/* XXX LEAK alert */
- hr = SetSVFromVariantEx(THIS_ pVarDesc->lpvarValue, sv, stash);
- if (!CheckOleError(THIS_ stash, hr)) {
+ hr = SetSVFromVariantEx(aTHX_ pVarDesc->lpvarValue, sv, stash);
+ if (!CheckOleError(aTHX_ stash, hr)) {
if (SvOK(caller)) {
/* XXX check for valid symbol name */
newCONSTSUB(hv, pszName, sv);
@@ -4618,7 +4619,7 @@
hv_store(hv, pszName, strlen(pszName), sv, 0);
}
SysFreeString(bstr);
- ReleaseBuffer(THIS_ pszName, szName);
+ ReleaseBuffer(aTHX_ pszName, szName);
}
pTypeInfo->ReleaseVarDesc(pVarDesc);
}
@@ -4638,7 +4639,12 @@
FILETIME ft;
LONG err;
- err = RegOpenKeyEx(HKEY_CLASSES_ROOT, "Typelib", 0, KEY_READ, &hKeyTypelib);
+ if (USING_WIDE()) {
+ err = RegOpenKeyExW(HKEY_CLASSES_ROOT, L"Typelib", 0, KEY_READ, &hKeyTypelib);
+ }
+ else {
+ err = RegOpenKeyExA(HKEY_CLASSES_ROOT, "Typelib", 0, KEY_READ, &hKeyTypelib);
+ }
if (err != ERROR_SUCCESS) {
warn("Cannot access HKEY_CLASSES_ROOT\\Typelib");
XSRETURN_EMPTY;
@@ -4648,47 +4654,106 @@
// Enumerate all Clsids
for (DWORD dwClsid=0;; ++dwClsid) {
- char szClsid[100];
- DWORD cbClsid = sizeof(szClsid);
- err = RegEnumKeyEx(hKeyTypelib, dwClsid, szClsid, &cbClsid,
- NULL, NULL, NULL, &ft);
- if (err != ERROR_SUCCESS)
- break;
-
HKEY hKeyClsid;
- err = RegOpenKeyEx(hKeyTypelib, szClsid, 0, KEY_READ, &hKeyClsid);
- if (err != ERROR_SUCCESS)
- continue;
+ char szClsid[200];
+ WCHAR wClsid[100];
+ DWORD cbClsid;
+ if (USING_WIDE()) {
+ cbClsid = (sizeof(wClsid)/sizeof(wClsid[0]));
+ err = RegEnumKeyExW(hKeyTypelib, dwClsid, wClsid, &cbClsid,
+ NULL, NULL, NULL, &ft);
+ if (err != ERROR_SUCCESS)
+ break;
- // Enumerate versions for current clsid
- for (DWORD dwVersion=0;; ++dwVersion) {
- char szVersion[10];
- DWORD cbVersion = sizeof(szVersion);
- err = RegEnumKeyEx(hKeyClsid, dwVersion, szVersion, &cbVersion,
+ err = RegOpenKeyExW(hKeyTypelib, wClsid, 0, KEY_READ, &hKeyClsid);
+ if (err != ERROR_SUCCESS)
+ continue;
+
+ W2AHELPER(wClsid, szClsid, sizeof(szClsid));
+ cbClsid = strlen(szClsid);
+ }
+ else {
+ cbClsid = (sizeof(szClsid)/sizeof(szClsid[0]));
+ err = RegEnumKeyExA(hKeyTypelib, dwClsid, szClsid, &cbClsid,
NULL, NULL, NULL, &ft);
if (err != ERROR_SUCCESS)
break;
- HKEY hKeyVersion;
- err = RegOpenKeyEx(hKeyClsid, szVersion, 0, KEY_READ, &hKeyVersion);
+ err = RegOpenKeyExA(hKeyTypelib, szClsid, 0, KEY_READ, &hKeyClsid);
if (err != ERROR_SUCCESS)
continue;
+ }
- char szTitle[300];
- LONG cbTitle = sizeof(szTitle);
- err = RegQueryValue(hKeyVersion, NULL, szTitle, &cbTitle);
- if (err != ERROR_SUCCESS || cbTitle <= 1)
- continue;
+ // Enumerate versions for current clsid
+ for (DWORD dwVersion=0;; ++dwVersion) {
+ HKEY hKeyVersion;
+ char szVersion[20];
+ char szTitle[600];
+ WCHAR wVersion[10];
+ WCHAR wTitle[300];
+ DWORD cbVersion;
+ LONG cbTitle;
+ if (USING_WIDE()) {
+ cbVersion = (sizeof(wVersion)/sizeof(wVersion[0]));
+ err = RegEnumKeyExW(hKeyClsid, dwVersion, wVersion, &cbVersion,
+ NULL, NULL, NULL, &ft);
+ if (err != ERROR_SUCCESS)
+ break;
- // Enumerate languages
- for (DWORD dwLangid=0;; ++dwLangid) {
- char szLangid[10];
- DWORD cbLangid = sizeof(szLangid);
- err = RegEnumKeyEx(hKeyVersion, dwLangid, szLangid, &cbLangid,
+ err = RegOpenKeyExW(hKeyClsid, wVersion, 0, KEY_READ, &hKeyVersion);
+ if (err != ERROR_SUCCESS)
+ continue;
+
+ cbTitle = (sizeof(wTitle)/sizeof(wTitle[0]));
+ err = RegQueryValueW(hKeyVersion, NULL, wTitle, &cbTitle);
+ if (err != ERROR_SUCCESS || cbTitle <= 1)
+ continue;
+
+ W2AHELPER(wVersion, szVersion, sizeof(szVersion));
+ cbVersion = strlen(szVersion);
+ W2AHELPER(wTitle, szTitle, sizeof(szTitle));
+ cbTitle = strlen(szTitle);
+ }
+ else {
+ cbVersion = (sizeof(szVersion)/sizeof(szVersion[0]));
+ err = RegEnumKeyExA(hKeyClsid, dwVersion, szVersion, &cbVersion,
NULL, NULL, NULL, &ft);
if (err != ERROR_SUCCESS)
break;
+ err = RegOpenKeyExA(hKeyClsid, szVersion, 0, KEY_READ, &hKeyVersion);
+ if (err != ERROR_SUCCESS)
+ continue;
+
+ cbTitle = (sizeof(szTitle)/sizeof(szTitle[0]));
+ err = RegQueryValueA(hKeyVersion, NULL, szTitle, &cbTitle);
+ if (err != ERROR_SUCCESS || cbTitle <= 1)
+ continue;
+ }
+
+ // Enumerate languages
+ for (DWORD dwLangid=0;; ++dwLangid) {
+ char szLangid[20];
+ WCHAR wLangid[10];
+ DWORD cbLangid;
+ if (USING_WIDE()) {
+ cbLangid = (sizeof(wLangid)/sizeof(wLangid[0]));
+ err = RegEnumKeyExW(hKeyVersion, dwLangid, wLangid, &cbLangid,
+ NULL, NULL, NULL, &ft);
+ if (err != ERROR_SUCCESS)
+ break;
+
+ W2AHELPER(wLangid, szLangid, sizeof(szLangid));
+ cbLangid = strlen(szLangid);
+ }
+ else {
+ cbLangid = (sizeof(szLangid)/sizeof(szLangid[0]));
+ err = RegEnumKeyExA(hKeyVersion, dwLangid, szLangid, &cbLangid,
+ NULL, NULL, NULL, &ft);
+ if (err != ERROR_SUCCESS)
+ break;
+ }
+
// Language ids must be strictly numeric
char *psz=szLangid;
while (isDIGIT(*psz))
@@ -4697,15 +4762,34 @@
continue;
HKEY hKeyLangid;
- err = RegOpenKeyEx(hKeyVersion, szLangid, 0, KEY_READ,
- &hKeyLangid);
- if (err != ERROR_SUCCESS)
- continue;
+ if (USING_WIDE()) {
+ // wLangid is still valid
+ err = RegOpenKeyExW(hKeyVersion, wLangid, 0, KEY_READ,
+ &hKeyLangid);
+ if (err != ERROR_SUCCESS)
+ continue;
+ }
+ else {
+ err = RegOpenKeyExA(hKeyVersion, szLangid, 0, KEY_READ,
+ &hKeyLangid);
+ if (err != ERROR_SUCCESS)
+ continue;
+ }
// Retrieve filename of type library
char szFile[MAX_PATH+1];
+ WCHAR wFile[MAX_PATH+1];
LONG cbFile = sizeof(szFile);
- err = RegQueryValue(hKeyLangid, "win32", szFile, &cbFile);
+ if (USING_WIDE()) {
+ cbFile = (sizeof(wFile)/sizeof(wFile[0]));
+ err = RegQueryValueW(hKeyLangid, L"win32", wFile, &cbFile);
+ W2AHELPER(wFile, szFile, sizeof(szFile));
+ cbFile = strlen(szFile)+1;
+ }
+ else {
+ cbFile = (sizeof(szFile)/sizeof(szFile[0]));
+ err = RegQueryValueA(hKeyLangid, "win32", szFile, &cbFile);
+ }
if (err == ERROR_SUCCESS && cbFile > 1) {
AV *av = newAV();
av_push(av, newSVpv(szClsid, cbClsid));
@@ -4771,21 +4855,21 @@
New(0, pEnumObj, 1, WINOLEENUMOBJECT);
if (ix == 0) { /* new */
- WINOLEOBJECT *pObj = GetOleObject(THIS_ object);
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ object);
if (pObj) {
- HV *olestash = GetWin32OleStash(THIS_ object);
- SetLastOleError(THIS_ olestash);
- pEnumObj->pEnum = CreateEnumVARIANT(THIS_ pObj);
+ HV *olestash = GetWin32OleStash(aTHX_ object);
+ SetLastOleError(aTHX_ olestash);
+ pEnumObj->pEnum = CreateEnumVARIANT(aTHX_ pObj);
}
}
else { /* Clone */
- WINOLEENUMOBJECT *pOriginal = GetOleEnumObject(THIS_ self);
+ WINOLEENUMOBJECT *pOriginal = GetOleEnumObject(aTHX_ self);
if (pOriginal) {
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
HRESULT hr = pOriginal->pEnum->Clone(&pEnumObj->pEnum);
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
}
}
@@ -4794,10 +4878,10 @@
XSRETURN_EMPTY;
}
- AddToObjectChain(THIS_ (OBJECTHEADER*)pEnumObj, WINOLEENUM_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pEnumObj, WINOLEENUM_MAGIC);
SV *sv = newSViv((IV)pEnumObj);
- ST(0) = sv_2mortal(sv_bless(newRV_noinc(sv), GetStash(THIS_ self)));
+ ST(0) = sv_2mortal(sv_bless(newRV_noinc(sv), GetStash(aTHX_ self)));
XSRETURN(1);
}
@@ -4806,9 +4890,9 @@
SV *self
PPCODE:
{
- WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(THIS_ self, TRUE);
+ WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(aTHX_ self, TRUE);
if (pEnumObj) {
- RemoveFromObjectChain(THIS_ (OBJECTHEADER*)pEnumObj);
+ RemoveFromObjectChain(aTHX_ (OBJECTHEADER*)pEnumObj);
if (pEnumObj->pEnum)
pEnumObj->pEnum->Release();
Safefree(pEnumObj);
@@ -4851,16 +4935,16 @@
}
}
- WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(THIS_ self);
+ WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(aTHX_ self);
if (!pEnumObj)
XSRETURN_EMPTY;
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
SV *sv = NULL;
while (ix == 0 || count-- > 0) {
- sv = NextEnumElement(THIS_ pEnumObj->pEnum, olestash);
+ sv = NextEnumElement(aTHX_ pEnumObj->pEnum, olestash);
if (!SvOK(sv))
break;
if (!SvIMMORTAL(sv))
@@ -4878,15 +4962,15 @@
SV *self
PPCODE:
{
- WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(THIS_ self);
+ WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(aTHX_ self);
if (!pEnumObj)
XSRETURN_NO;
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
HRESULT hr = pEnumObj->pEnum->Reset();
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
ST(0) = boolSV(hr == S_OK);
XSRETURN(1);
}
@@ -4896,15 +4980,15 @@
SV *self
PPCODE:
{
- WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(THIS_ self);
+ WINOLEENUMOBJECT *pEnumObj = GetOleEnumObject(aTHX_ self);
if (!pEnumObj)
XSRETURN_NO;
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
int count = (items > 1) ? SvIV(ST(1)) : 1;
HRESULT hr = pEnumObj->pEnum->Skip(count);
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
ST(0) = boolSV(hr == S_OK);
XSRETURN(1);
}
@@ -4925,8 +5009,8 @@
// XXX Initialize should be superfluous here
// Initialize();
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
VARTYPE vt_base = vt & VT_TYPEMASK;
if (!data && vt_base != VT_NULL && vt_base != VT_EMPTY &&
@@ -5007,7 +5091,7 @@
hr = SafeArrayAccessData(V_ARRAY(pVariant), (void**)&pDest);
if (FAILED(hr)) {
VariantClear(pVariant);
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
}
else {
memcpy(pDest, ptr, len);
@@ -5016,20 +5100,20 @@
}
}
else {
- UINT cp = QueryPkgVar(THIS_ olestash, CP_NAME, CP_LEN, cpDefault);
- LCID lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN,
+ UINT cp = QueryPkgVar(aTHX_ olestash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN,
lcidDefault);
- hr = AssignVariantFromSV(THIS_ data, pVariant, cp, lcid);
+ hr = AssignVariantFromSV(aTHX_ data, pVariant, cp, lcid);
if (FAILED(hr)) {
Safefree(pVarObj);
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
}
- AddToObjectChain(THIS_ (OBJECTHEADER*)pVarObj, WINOLEVARIANT_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pVarObj, WINOLEVARIANT_MAGIC);
- HV *stash = GetStash(THIS_ self);
+ HV *stash = GetStash(aTHX_ self);
SV *sv = newSViv((IV)pVarObj);
ST(0) = sv_2mortal(sv_bless(newRV_noinc(sv), stash));
XSRETURN(1);
@@ -5040,9 +5124,9 @@
SV *self
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (pVarObj) {
- RemoveFromObjectChain(THIS_ (OBJECTHEADER*)pVarObj);
+ RemoveFromObjectChain(aTHX_ (OBJECTHEADER*)pVarObj);
VariantClear(&pVarObj->byref);
VariantClear(&pVarObj->variant);
Safefree(pVarObj);
@@ -5057,32 +5141,32 @@
IV type
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
HRESULT hr;
VARIANT variant;
- HV *olestash = GetWin32OleStash(THIS_ self);
- LCID lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ LCID lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
ST(0) = &PL_sv_undef;
- SetLastOleError(THIS_ olestash);
+ SetLastOleError(aTHX_ olestash);
VariantInit(&variant);
hr = VariantChangeTypeEx(&variant, &pVarObj->variant, lcid, 0, type);
if (SUCCEEDED(hr)) {
ST(0) = sv_newmortal();
- hr = SetSVFromVariantEx(THIS_ &variant, ST(0), olestash);
+ hr = SetSVFromVariantEx(aTHX_ &variant, ST(0), olestash);
}
else if (V_VT(&pVarObj->variant) == VT_ERROR) {
/* special handling for VT_ERROR */
ST(0) = sv_newmortal();
V_VT(&variant) = VT_I4;
V_I4(&variant) = V_ERROR(&pVarObj->variant);
- hr = SetSVFromVariantEx(THIS_ &variant, ST(0), olestash, FALSE);
+ hr = SetSVFromVariantEx(aTHX_ &variant, ST(0), olestash, FALSE);
}
VariantClear(&variant);
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
XSRETURN(1);
}
@@ -5092,19 +5176,19 @@
IV type
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
HRESULT hr = E_INVALIDARG;
- HV *olestash = GetWin32OleStash(THIS_ self);
- LCID lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ LCID lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
- SetLastOleError(THIS_ olestash);
+ SetLastOleError(aTHX_ olestash);
/* XXX: Does it work with VT_BYREF? */
hr = VariantChangeTypeEx(&pVarObj->variant, &pVarObj->variant,
lcid, 0, type);
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
if (FAILED(hr))
ST(0) = &PL_sv_undef;
@@ -5118,12 +5202,12 @@
_Clone = 1
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
HRESULT hr;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
VARIANT *pSource = &pVarObj->variant;
VARIANT variant, byref;
@@ -5169,7 +5253,7 @@
hr = SafeArrayGetElement(psa, rgIndices, V_BYREF(&variant));
Safefree(rgIndices);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
pSource = &variant;
}
@@ -5187,13 +5271,13 @@
VariantClear(&byref);
if (FAILED(hr)) {
Safefree(pNewVar);
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
- AddToObjectChain(THIS_ (OBJECTHEADER*)pNewVar, WINOLEVARIANT_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pNewVar, WINOLEVARIANT_MAGIC);
- HV *stash = GetStash(THIS_ self);
+ HV *stash = GetStash(aTHX_ self);
SV *sv = newSViv((IV)pNewVar);
ST(0) = sv_2mortal(sv_bless(newRV_noinc(sv), stash));
XSRETURN(1);
@@ -5206,7 +5290,7 @@
Time = 1
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
@@ -5217,8 +5301,8 @@
XSRETURN_EMPTY;
}
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
char *fmt = NULL;
DWORD dwFlags = 0;
@@ -5233,39 +5317,72 @@
if (items > 2)
lcid = SvIV(ST(2));
else
- lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
+ lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
HRESULT hr;
VARIANT variant;
VariantInit(&variant);
hr = VariantChangeTypeEx(&variant, &pVarObj->variant, lcid, 0, VT_DATE);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
SYSTEMTIME systime;
VariantTimeToSystemTime(V_DATE(&variant), &systime);
+ WCHAR* wFmt = NULL;
int len;
- if (ix == 0)
- len = GetDateFormatA(lcid, dwFlags, &systime, fmt, NULL, 0);
- else
- len = GetTimeFormatA(lcid, dwFlags, &systime, fmt, NULL, 0);
+ if (USING_WIDE()) {
+ if(fmt) {
+ len = strlen(fmt)+1;
+ New(0, wFmt, len, WCHAR);
+ A2WHELPER(fmt, wFmt, len*sizeof(WCHAR));
+ }
- if (len > 1) {
- SV *sv = ST(0) = sv_2mortal(newSV(len));
+ if (ix == 0)
+ len = GetDateFormatW(lcid, dwFlags, &systime, wFmt, NULL, 0);
+ else
+ len = GetTimeFormatW(lcid, dwFlags, &systime, wFmt, NULL, 0);
+ }
+ else {
if (ix == 0)
- len = GetDateFormatA(lcid, dwFlags, &systime, fmt, SvPVX(sv), len);
+ len = GetDateFormatA(lcid, dwFlags, &systime, fmt, NULL, 0);
else
- len = GetTimeFormatA(lcid, dwFlags, &systime, fmt, SvPVX(sv), len);
+ len = GetTimeFormatA(lcid, dwFlags, &systime, fmt, NULL, 0);
+ }
+ if (len > 1) {
+ if (USING_WIDE()) {
+ WCHAR* wInfo;
+ char* pInfo;
+ New(0, wInfo, len+1, WCHAR);
+ if (ix == 0)
+ len = GetDateFormatW(lcid, dwFlags, &systime, wFmt, wInfo, len);
+ else
+ len = GetTimeFormatW(lcid, dwFlags, &systime, wFmt, wInfo, len);
+ New(0, pInfo, (len+1)*2, char);
+ W2AHELPER(wInfo, pInfo, (len+1)*2);
+ ST(0) = sv_2mortal(newSVpv(pInfo, 0));
+ Safefree(pInfo);
+ Safefree(wInfo);
+ }
+ else {
+ SV *sv = ST(0) = sv_2mortal(newSV(len));
+ if (ix == 0)
+ len = GetDateFormatA(lcid, dwFlags, &systime, fmt, SvPVX(sv), len);
+ else
+ len = GetTimeFormatA(lcid, dwFlags, &systime, fmt, SvPVX(sv), len);
- if (len > 1) {
- SvCUR_set(sv, len-1);
- SvPOK_on(sv);
+ if (len > 1) {
+ SvCUR_set(sv, len-1);
+ SvPOK_on(sv);
+ }
}
}
else
ST(0) = &PL_sv_undef;
+ if(wFmt)
+ Safefree(wFmt);
+
VariantClear(&variant);
XSRETURN(1);
}
@@ -5275,7 +5392,7 @@
SV *self
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
@@ -5285,8 +5402,8 @@
XSRETURN_EMPTY;
}
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
HV *hv = NULL;
DWORD dwFlags = 0;
@@ -5308,35 +5425,59 @@
if (items > 2)
lcid = SvIV(ST(2));
else
- lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
+ lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
HRESULT hr;
VARIANT variant;
VariantInit(&variant);
hr = VariantChangeTypeEx(&variant, &pVarObj->variant, lcid, 0, VT_CY);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
- CURRENCYFMT fmt;
- Zero(&fmt, 1, CURRENCYFMT);
+ CURRENCYFMTA afmt;
+ CURRENCYFMTW wfmt;
+ if (USING_WIDE()) {
+ Zero(&wfmt, 1, CURRENCYFMTW);
+
+ wfmt.NumDigits = GetLocaleNumber(aTHX_ hv, "NumDigits",
+ lcid, LOCALE_IDIGITS);
+ wfmt.LeadingZero = GetLocaleNumber(aTHX_ hv, "LeadingZero",
+ lcid, LOCALE_ILZERO);
+ wfmt.Grouping = GetLocaleNumber(aTHX_ hv, "Grouping",
+ lcid, LOCALE_SMONGROUPING);
+ wfmt.NegativeOrder = GetLocaleNumber(aTHX_ hv, "NegativeOrder",
+ lcid, LOCALE_INEGCURR);
+ wfmt.PositiveOrder = GetLocaleNumber(aTHX_ hv, "PositiveOrder",
+ lcid, LOCALE_ICURRENCY);
+
+ wfmt.lpDecimalSep = GetLocaleStringW(aTHX_ hv, "DecimalSep",
+ lcid, LOCALE_SMONDECIMALSEP);
+ wfmt.lpThousandSep = GetLocaleStringW(aTHX_ hv, "ThousandSep",
+ lcid, LOCALE_SMONTHOUSANDSEP);
+ wfmt.lpCurrencySymbol = GetLocaleStringW(aTHX_ hv, "CurrencySymbol",
+ lcid, LOCALE_SCURRENCY);
+ }
+ else {
+ Zero(&afmt, 1, CURRENCYFMTA);
- fmt.NumDigits = GetLocaleNumber(THIS_ hv, "NumDigits",
- lcid, LOCALE_IDIGITS);
- fmt.LeadingZero = GetLocaleNumber(THIS_ hv, "LeadingZero",
- lcid, LOCALE_ILZERO);
- fmt.Grouping = GetLocaleNumber(THIS_ hv, "Grouping",
- lcid, LOCALE_SMONGROUPING);
- fmt.NegativeOrder = GetLocaleNumber(THIS_ hv, "NegativeOrder",
- lcid, LOCALE_INEGCURR);
- fmt.PositiveOrder = GetLocaleNumber(THIS_ hv, "PositiveOrder",
- lcid, LOCALE_ICURRENCY);
-
- fmt.lpDecimalSep = GetLocaleString(THIS_ hv, "DecimalSep",
- lcid, LOCALE_SMONDECIMALSEP);
- fmt.lpThousandSep = GetLocaleString(THIS_ hv, "ThousandSep",
- lcid, LOCALE_SMONTHOUSANDSEP);
- fmt.lpCurrencySymbol = GetLocaleString(THIS_ hv, "CurrencySymbol",
- lcid, LOCALE_SCURRENCY);
+ afmt.NumDigits = GetLocaleNumber(aTHX_ hv, "NumDigits",
+ lcid, LOCALE_IDIGITS);
+ afmt.LeadingZero = GetLocaleNumber(aTHX_ hv, "LeadingZero",
+ lcid, LOCALE_ILZERO);
+ afmt.Grouping = GetLocaleNumber(aTHX_ hv, "Grouping",
+ lcid, LOCALE_SMONGROUPING);
+ afmt.NegativeOrder = GetLocaleNumber(aTHX_ hv, "NegativeOrder",
+ lcid, LOCALE_INEGCURR);
+ afmt.PositiveOrder = GetLocaleNumber(aTHX_ hv, "PositiveOrder",
+ lcid, LOCALE_ICURRENCY);
+
+ afmt.lpDecimalSep = GetLocaleString(aTHX_ hv, "DecimalSep",
+ lcid, LOCALE_SMONDECIMALSEP);
+ afmt.lpThousandSep = GetLocaleString(aTHX_ hv, "ThousandSep",
+ lcid, LOCALE_SMONTHOUSANDSEP);
+ afmt.lpCurrencySymbol = GetLocaleString(aTHX_ hv, "CurrencySymbol",
+ lcid, LOCALE_SCURRENCY);
+ }
int len = 0;
int sign = 0;
@@ -5368,19 +5509,45 @@
DBG(("amount='%s' number='%s' len=%d sign=%d", amount, SvPVX(number),
len, sign));
- len = GetCurrencyFormatA(lcid, dwFlags, SvPVX(number), &fmt, NULL, 0);
+ WCHAR* wNumber = NULL;
+ char* pNumber = SvPVX(number);
+ if (USING_WIDE()) {
+ len = strlen(pNumber)+1;
+ New(0, wNumber, len, WCHAR);
+ A2WHELPER(pNumber, wNumber, len*sizeof(WCHAR));
+ len = GetCurrencyFormatW(lcid, dwFlags, wNumber, &wfmt, NULL, 0);
+ }
+ else {
+ len = GetCurrencyFormatA(lcid, dwFlags, pNumber, &afmt, NULL, 0);
+ }
if (len > 1) {
- SV *sv = ST(0) = sv_2mortal(newSV(len));
- len = GetCurrencyFormatA(lcid, dwFlags, SvPVX(number), &fmt,
- SvPVX(sv), len);
- if (len > 1) {
- SvCUR_set(sv, len-1);
- SvPOK_on(sv);
+ if (USING_WIDE()) {
+ WCHAR* wInfo;
+ char* pInfo;
+ New(0, wInfo, len+1, WCHAR);
+ New(0, pInfo, (len+1)*2, char);
+ len = GetCurrencyFormatW(lcid, dwFlags, wNumber, &wfmt,
+ wInfo, len);
+ W2AHELPER(wInfo, pInfo, (len+1)*2);
+ ST(0) = sv_2mortal(newSVpv(pInfo, 0));
+ Safefree(pInfo);
+ Safefree(wInfo);
}
+ else {
+ SV *sv = ST(0) = sv_2mortal(newSV(len));
+ len = GetCurrencyFormatA(lcid, dwFlags, pNumber, &afmt,
+ SvPVX(sv), len);
+ if (len > 1) {
+ SvCUR_set(sv, len-1);
+ SvPOK_on(sv);
+ }
+ }
}
else
ST(0) = &PL_sv_undef;
-
+
+ if(wNumber)
+ Safefree(wNumber);
SvREFCNT_dec(number);
VariantClear(&variant);
XSRETURN(1);
@@ -5391,7 +5558,7 @@
SV *self
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
@@ -5401,8 +5568,8 @@
XSRETURN_EMPTY;
}
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
HV *hv = NULL;
DWORD dwFlags = 0;
@@ -5424,46 +5591,97 @@
if (items > 2)
lcid = SvIV(ST(2));
else
- lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
+ lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN, lcidDefault);
HRESULT hr;
VARIANT variant;
VariantInit(&variant);
hr = VariantChangeTypeEx(&variant, &pVarObj->variant, lcid, 0, VT_R8);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
- NUMBERFMT fmt;
- Zero(&fmt, 1, NUMBERFMT);
+ UINT NumDigits;
+ NUMBERFMTA afmt;
+ NUMBERFMTW wfmt;
+ if (USING_WIDE()) {
+ Zero(&wfmt, 1, NUMBERFMT);
+
+ wfmt.NumDigits = GetLocaleNumber(aTHX_ hv, "NumDigits",
+ lcid, LOCALE_IDIGITS);
+ wfmt.LeadingZero = GetLocaleNumber(aTHX_ hv, "LeadingZero",
+ lcid, LOCALE_ILZERO);
+ wfmt.Grouping = GetLocaleNumber(aTHX_ hv, "Grouping",
+ lcid, LOCALE_SGROUPING);
+ wfmt.NegativeOrder = GetLocaleNumber(aTHX_ hv, "NegativeOrder",
+ lcid, LOCALE_INEGNUMBER);
+
+ wfmt.lpDecimalSep = GetLocaleStringW(aTHX_ hv, "DecimalSep",
+ lcid, LOCALE_SDECIMAL);
+ wfmt.lpThousandSep = GetLocaleStringW(aTHX_ hv, "ThousandSep",
+ lcid, LOCALE_STHOUSAND);
+ NumDigits = wfmt.NumDigits;
+ }
+ else {
+ Zero(&afmt, 1, NUMBERFMT);
- fmt.NumDigits = GetLocaleNumber(THIS_ hv, "NumDigits",
- lcid, LOCALE_IDIGITS);
- fmt.LeadingZero = GetLocaleNumber(THIS_ hv, "LeadingZero",
- lcid, LOCALE_ILZERO);
- fmt.Grouping = GetLocaleNumber(THIS_ hv, "Grouping",
- lcid, LOCALE_SGROUPING);
- fmt.NegativeOrder = GetLocaleNumber(THIS_ hv, "NegativeOrder",
- lcid, LOCALE_INEGNUMBER);
-
- fmt.lpDecimalSep = GetLocaleString(THIS_ hv, "DecimalSep",
- lcid, LOCALE_SDECIMAL);
- fmt.lpThousandSep = GetLocaleString(THIS_ hv, "ThousandSep",
- lcid, LOCALE_STHOUSAND);
+ afmt.NumDigits = GetLocaleNumber(aTHX_ hv, "NumDigits",
+ lcid, LOCALE_IDIGITS);
+ afmt.LeadingZero = GetLocaleNumber(aTHX_ hv, "LeadingZero",
+ lcid, LOCALE_ILZERO);
+ afmt.Grouping = GetLocaleNumber(aTHX_ hv, "Grouping",
+ lcid, LOCALE_SGROUPING);
+ afmt.NegativeOrder = GetLocaleNumber(aTHX_ hv, "NegativeOrder",
+ lcid, LOCALE_INEGNUMBER);
+
+ afmt.lpDecimalSep = GetLocaleString(aTHX_ hv, "DecimalSep",
+ lcid, LOCALE_SDECIMAL);
+ afmt.lpThousandSep = GetLocaleString(aTHX_ hv, "ThousandSep",
+ lcid, LOCALE_STHOUSAND);
+ NumDigits = afmt.NumDigits;
+ }
- SV *number = newSVpvf("%.*f", fmt.NumDigits, V_R8(&variant));
- int len = GetNumberFormatA(lcid, dwFlags, SvPVX(number), &fmt, NULL, 0);
+ int len;
+ SV *number = newSVpvf("%.*f", NumDigits, V_R8(&variant));
+ char* pNumber = SvPVX(number);
+ WCHAR* wNumber = NULL;
+ if (USING_WIDE()) {
+ len = strlen(pNumber)+1;
+ New(0, wNumber, len, WCHAR);
+ A2WHELPER(pNumber, wNumber, len*sizeof(WCHAR));
+ len = GetNumberFormatW(lcid, dwFlags, wNumber, &wfmt, NULL, 0);
+ }
+ else {
+ len = GetNumberFormatA(lcid, dwFlags, pNumber, &afmt, NULL, 0);
+ }
if (len > 1) {
- SV *sv = ST(0) = sv_2mortal(newSV(len));
- len = GetNumberFormatA(lcid, dwFlags, SvPVX(number), &fmt,
- SvPVX(sv), len);
- if (len > 1) {
- SvCUR_set(sv, len-1);
- SvPOK_on(sv);
+ if (USING_WIDE()) {
+ WCHAR* wInfo;
+ char* pInfo;
+ New(0, wInfo, len+1, WCHAR);
+ New(0, pInfo, (len+1)*2, char);
+ len = GetNumberFormatW(lcid, dwFlags, wNumber, &wfmt,
+ wInfo, len);
+ W2AHELPER(wInfo, pInfo, (len+1)*2);
+ ST(0) = sv_2mortal(newSVpv(pInfo, 0));
+ Safefree(pInfo);
+ Safefree(wInfo);
+ }
+ else {
+ SV *sv = ST(0) = sv_2mortal(newSV(len));
+ len = GetNumberFormatA(lcid, dwFlags, pNumber, &afmt,
+ SvPVX(sv), len);
+ if (len > 1) {
+ SvCUR_set(sv, len-1);
+ SvPOK_on(sv);
+ }
}
}
else
ST(0) = &PL_sv_undef;
+ if(wNumber)
+ Safefree(wNumber);
+
SvREFCNT_dec(number);
VariantClear(&variant);
XSRETURN(1);
@@ -5474,7 +5692,7 @@
SV *self
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
@@ -5510,8 +5728,8 @@
XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
}
- HV *olestash = GetWin32OleStash(THIS_ self);
- if (CheckOleError(THIS_ olestash, hr))
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
/* return list of array refs on stack */
@@ -5525,11 +5743,11 @@
PPCODE:
{
char *paszMethod[] = {"Get", "Put"};
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
if (!pVarObj)
XSRETURN_EMPTY;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
VARIANT *pVariant = &pVarObj->variant;
while (V_VT(pVariant) == (VT_VARIANT | VT_BYREF))
@@ -5545,16 +5763,16 @@
HRESULT hr;
if (ix == 0) { /* Get */
ST(0) = sv_newmortal();
- hr = SetSVFromVariantEx(THIS_ pVariant, ST(0), olestash);
+ hr = SetSVFromVariantEx(aTHX_ pVariant, ST(0), olestash);
}
else { /* Put */
- UINT cp = QueryPkgVar(THIS_ olestash, CP_NAME, CP_LEN, cpDefault);
- LCID lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN,
+ UINT cp = QueryPkgVar(aTHX_ olestash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN,
lcidDefault);
ST(0) = sv_mortalcopy(self);
- hr = AssignVariantFromSV(THIS_ ST(1), pVariant, cp, lcid);
+ hr = AssignVariantFromSV(aTHX_ ST(1), pVariant, cp, lcid);
}
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
XSRETURN(1);
}
@@ -5571,12 +5789,12 @@
if (ix == 1 && items == 2 && SvROK(ST(1)) &&
SvTYPE(SvRV(ST(1))) == SVt_PVAV)
{
- UINT cp = QueryPkgVar(THIS_ olestash, CP_NAME, CP_LEN, cpDefault);
- LCID lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN,
+ UINT cp = QueryPkgVar(aTHX_ olestash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN,
lcidDefault);
- HRESULT hr = SetSafeArrayFromAV(THIS_ (AV*)SvRV(ST(1)), vt_base, psa,
+ HRESULT hr = SetSafeArrayFromAV(aTHX_ (AV*)SvRV(ST(1)), vt_base, psa,
cDims, cp, lcid);
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
ST(0) = sv_mortalcopy(self);
XSRETURN(1);
}
@@ -5615,14 +5833,14 @@
hr = SafeArrayGetElement(psa, rgIndices, V_BYREF(&variant));
if (SUCCEEDED(hr)) {
ST(0) = sv_newmortal();
- hr = SetSVFromVariantEx(THIS_ &variant, ST(0), olestash);
+ hr = SetSVFromVariantEx(aTHX_ &variant, ST(0), olestash);
}
}
else { /* Put */
- UINT cp = QueryPkgVar(THIS_ olestash, CP_NAME, CP_LEN, cpDefault);
- LCID lcid = QueryPkgVar(THIS_ olestash, LCID_NAME, LCID_LEN,
+ UINT cp = QueryPkgVar(aTHX_ olestash, CP_NAME, CP_LEN, cpDefault);
+ LCID lcid = QueryPkgVar(aTHX_ olestash, LCID_NAME, LCID_LEN,
lcidDefault);
- hr = AssignVariantFromSV(THIS_ ST(items-1), &variant, cp, lcid);
+ hr = AssignVariantFromSV(aTHX_ ST(items-1), &variant, cp, lcid);
if (SUCCEEDED(hr)) {
if (vt_base == VT_BSTR)
hr = SafeArrayPutElement(psa, rgIndices, V_BSTR(&byref));
@@ -5638,7 +5856,7 @@
}
VariantClear(&byref);
Safefree(rgIndices);
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
XSRETURN(1);
}
@@ -5650,7 +5868,7 @@
// Win32::OLE::Variant->LastError() exists only for backward compatibility.
// It is now just a proxy for Win32::OLE->LastError().
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
SV *sv = items == 1 ? NULL : ST(1);
PUSHMARK(sp);
@@ -5673,20 +5891,20 @@
_RefType = 3
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
ST(0) = &PL_sv_undef;
if (pVarObj) {
HRESULT hr;
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
ST(0) = sv_newmortal();
if (ix == 0) /* Type */
sv_setiv(ST(0), V_VT(&pVarObj->variant));
else if (ix == 1) /* Value */
- hr = SetSVFromVariantEx(THIS_ &pVarObj->variant, ST(0), olestash);
+ hr = SetSVFromVariantEx(aTHX_ &pVarObj->variant, ST(0), olestash);
else if (ix == 2) /* _Value, see also: _Clone (alias of Copy) */
- hr = SetSVFromVariantEx(THIS_ &pVarObj->variant, ST(0), olestash,
+ hr = SetSVFromVariantEx(aTHX_ &pVarObj->variant, ST(0), olestash,
TRUE);
else if (ix == 3) { /* _RefType */
VARIANT *pVariant = &pVarObj->variant;
@@ -5694,7 +5912,7 @@
pVariant = V_VARIANTREF(pVariant);
sv_setiv(ST(0), V_VT(pVariant));
}
- CheckOleError(THIS_ olestash, hr);
+ CheckOleError(aTHX_ olestash, hr);
}
XSRETURN(1);
}
@@ -5704,7 +5922,7 @@
SV *self
PPCODE:
{
- WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(THIS_ self);
+ WINOLEVARIANTOBJECT *pVarObj = GetOleVariantObject(aTHX_ self);
ST(0) = &PL_sv_undef;
if (pVarObj) {
@@ -5712,18 +5930,18 @@
VARIANT *pVariant = &pVarObj->variant;
HRESULT hr = S_OK;
- HV *olestash = GetWin32OleStash(THIS_ self);
- SetLastOleError(THIS_ olestash);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ SetLastOleError(aTHX_ olestash);
VariantInit(&Variant);
if ((V_VT(pVariant) & ~VT_BYREF) != VT_BSTR) {
- LCID lcid = QueryPkgVar(THIS_ olestash,
+ LCID lcid = QueryPkgVar(aTHX_ olestash,
LCID_NAME, LCID_LEN, lcidDefault);
hr = VariantChangeTypeEx(&Variant, pVariant, lcid, 0, VT_BSTR);
pVariant = &Variant;
}
- if (!CheckOleError(THIS_ olestash, hr)) {
+ if (!CheckOleError(aTHX_ olestash, hr)) {
BSTR bstr = V_ISBYREF(pVariant) ? *V_BSTRREF(pVariant)
: V_BSTR(pVariant);
STRLEN olecharlen = SysStringLen(bstr);
@@ -5756,8 +5974,19 @@
STRLEN length2;
char *string1 = SvPV(str1, length1);
char *string2 = SvPV(str2, length2);
+ int res;
- int res = CompareStringA(lcid, flags, string1, length1, string2, length2);
+ if (USING_WIDE()) {
+ WCHAR *wstring1, *wstring2;
+ New(0, wstring1, length1+1, WCHAR);
+ New(0, wstring2, length2+1, WCHAR);
+ A2WHELPER(string1, wstring1, (length1+1)*sizeof(WCHAR));
+ A2WHELPER(string2, wstring2, (length2+1)*sizeof(WCHAR));
+ res = CompareStringW(lcid, flags, wstring1, -1, wstring2, -1);
+ }
+ else {
+ res = CompareStringA(lcid, flags, string1, length1, string2, length2);
+ }
XSRETURN_IV(res);
}
@@ -5768,18 +5997,48 @@
SV *str
PPCODE:
{
- SV *sv = sv_newmortal();
+ SV *sv;
+ int len;
STRLEN length;
+ WCHAR* wstring = NULL;
char *string = SvPV(str,length);
- int len = LCMapStringA(lcid, flags, string, length, NULL, 0);
+ if (USING_WIDE()) {
+ len = strlen(string)+1;
+ New(0, wstring, len, WCHAR);
+ A2WHELPER(string, wstring, len*sizeof(WCHAR));
+ len = LCMapStringW(lcid, flags, wstring, -1, NULL, 0);
+ }
+ else {
+ len = LCMapStringA(lcid, flags, string, length, NULL, 0);
+ }
if (len > 0) {
- SvUPGRADE(sv, SVt_PV);
- SvGROW(sv, len+1);
- SvCUR_set(sv, LCMapStringA(lcid, flags, string, length,
- SvPVX(sv), SvLEN(sv)));
- if (SvCUR(sv))
- SvPOK_on(sv);
+ if (USING_WIDE()) {
+ WCHAR* wInfo;
+ char* pInfo;
+ New(0, wInfo, len+1, WCHAR);
+ New(0, pInfo, (len+1)*2, char);
+ len = LCMapStringW(lcid, flags, wstring, -1, wInfo, len);
+ W2AHELPER(wInfo, pInfo, (len+1)*2);
+ sv = sv_2mortal(newSVpv(pInfo, 0));
+ Safefree(pInfo);
+ Safefree(wInfo);
+ }
+ else {
+ sv = sv_newmortal();
+ SvUPGRADE(sv, SVt_PV);
+ SvGROW(sv, len+1);
+ SvCUR_set(sv, LCMapStringA(lcid, flags, string, length,
+ SvPVX(sv), SvLEN(sv)));
+ if (SvCUR(sv))
+ SvPOK_on(sv);
+ }
}
+ else
+ sv = sv_newmortal();
+
+ if(wstring)
+ Safefree(wstring);
+
ST(0) = sv;
XSRETURN(1);
}
@@ -5790,15 +6049,30 @@
IV lctype
PPCODE:
{
- SV *sv = sv_newmortal();
- int len = GetLocaleInfoA(lcid, lctype, NULL, 0);
- if (len > 0) {
- SvUPGRADE(sv, SVt_PV);
- SvGROW(sv, len);
- len = GetLocaleInfoA(lcid, lctype, SvPVX(sv), SvLEN(sv));
- if (len) {
- SvCUR_set(sv, len-1);
- SvPOK_on(sv);
+ SV *sv;
+ if (USING_WIDE()) {
+ WCHAR *info;
+ char *szInfo;
+ int len = GetLocaleInfoW(lcid, lctype, NULL, 0);
+ New(0, info, len, WCHAR);
+ GetLocaleInfoW(lcid, lctype, info, len);
+ New(0, szInfo, len*2, char);
+ W2AHELPER(info, szInfo, len*2);
+ sv = sv_2mortal(newSVpv(szInfo, 0));
+ Safefree(info);
+ Safefree(szInfo);
+ }
+ else {
+ sv = sv_newmortal();
+ int len = GetLocaleInfoA(lcid, lctype, NULL, 0);
+ if (len > 0) {
+ SvUPGRADE(sv, SVt_PV);
+ SvGROW(sv, len);
+ len = GetLocaleInfoA(lcid, lctype, SvPVX(sv), SvLEN(sv));
+ if (len) {
+ SvCUR_set(sv, len-1);
+ SvPOK_on(sv);
+ }
}
}
ST(0) = sv;
@@ -5887,7 +6161,19 @@
char *lcdata
PPCODE:
{
- if (SetLocaleInfoA(lcid, lctype, lcdata))
+ BOOL result;
+ if (USING_WIDE()) {
+ WCHAR* wlcdata;
+ int len = strlen(lcdata)+1;
+ New(0, wlcdata, len, WCHAR);
+ A2WHELPER(lcdata, wlcdata, len*sizeof(WCHAR));
+ result = SetLocaleInfoW(lcid, lctype, wlcdata);
+ Safefree(wlcdata);
+ }
+ else {
+ result = SetLocaleInfoA(lcid, lctype, lcdata);
+ }
+ if(result)
XSRETURN_YES;
XSRETURN_EMPTY;
@@ -5910,48 +6196,48 @@
TLIBATTR *pTLibAttr;
if (sv_isobject(object) && sv_derived_from(object, szWINOLE)) {
- WINOLEOBJECT *pOleObj = GetOleObject(THIS_ object);
+ WINOLEOBJECT *pOleObj = GetOleObject(aTHX_ object);
if (!pOleObj)
XSRETURN_EMPTY;
unsigned int count;
hr = pOleObj->pDispatch->GetTypeInfoCount(&count);
stash = SvSTASH(pOleObj->self);
- if (CheckOleError(THIS_ stash, hr) || count == 0)
+ if (CheckOleError(aTHX_ stash, hr) || count == 0)
XSRETURN_EMPTY;
ITypeInfo *pTypeInfo;
hr = pOleObj->pDispatch->GetTypeInfo(0, lcidDefault, &pTypeInfo);
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
unsigned int index;
hr = pTypeInfo->GetContainingTypeLib(&pTypeLib, &index);
pTypeInfo->Release();
- if (CheckOleError(THIS_ stash, hr))
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
}
else {
- stash = GetWin32OleStash(THIS_ self);
- UINT cp = QueryPkgVar(THIS_ stash, CP_NAME, CP_LEN, cpDefault);
+ stash = GetWin32OleStash(aTHX_ self);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
char *pszBuffer = SvPV_nolen(object);
OLECHAR Buffer[OLE_BUF_SIZ];
- OLECHAR *pBuffer = GetWideChar(THIS_ pszBuffer, Buffer, OLE_BUF_SIZ, cp);
+ OLECHAR *pBuffer = GetWideChar(aTHX_ pszBuffer, Buffer, OLE_BUF_SIZ, cp);
hr = LoadTypeLibEx(pBuffer, REGKIND_NONE, &pTypeLib);
- ReleaseBuffer(THIS_ pBuffer, Buffer);
- if (CheckOleError(THIS_ stash, hr))
+ ReleaseBuffer(aTHX_ pBuffer, Buffer);
+ if (CheckOleError(aTHX_ stash, hr))
XSRETURN_EMPTY;
}
hr = pTypeLib->GetLibAttr(&pTLibAttr);
if (FAILED(hr)) {
pTypeLib->Release();
- ReportOleError(THIS_ stash, hr);
+ ReportOleError(aTHX_ stash, hr);
XSRETURN_EMPTY;
}
- ST(0) = sv_2mortal(CreateTypeLibObject(THIS_ pTypeLib, pTLibAttr));
+ ST(0) = sv_2mortal(CreateTypeLibObject(aTHX_ pTypeLib, pTLibAttr));
XSRETURN(1);
}
@@ -5960,9 +6246,9 @@
SV *self
PPCODE:
{
- WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(THIS_ self);
+ WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(aTHX_ self);
if (pObj) {
- RemoveFromObjectChain(THIS_ (OBJECTHEADER*)pObj);
+ RemoveFromObjectChain(aTHX_ (OBJECTHEADER*)pObj);
if (pObj->pTypeLib) {
pObj->pTypeLib->ReleaseTLibAttr(pObj->pTLibAttr);
pObj->pTypeLib->Release();
@@ -5978,7 +6264,7 @@
IV index
PPCODE:
{
- WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(THIS_ self);
+ WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
@@ -5986,11 +6272,11 @@
BSTR bstrName, bstrDocString, bstrHelpFile;
HRESULT hr = pObj->pTypeLib->GetDocumentation(index, &bstrName,
&bstrDocString, &dwHelpContext, &bstrHelpFile);
- HV *olestash = GetWin32OleStash(THIS_ self);
- if (CheckOleError(THIS_ olestash, hr))
+ HV *olestash = GetWin32OleStash(aTHX_ self);
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
- HV *hv = GetDocumentation(THIS_ bstrName, bstrDocString,
+ HV *hv = GetDocumentation(aTHX_ bstrName, bstrDocString,
dwHelpContext, bstrHelpFile);
ST(0) = sv_2mortal(newRV_noinc((SV*)hv));
XSRETURN(1);
@@ -6001,7 +6287,7 @@
SV *self
PPCODE:
{
- WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(THIS_ self);
+ WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
@@ -6013,7 +6299,7 @@
hv_store(hv, "wLibFlags", 9, newSViv(p->wLibFlags), 0);
hv_store(hv, "wMajorVerNum", 12, newSViv(p->wMajorVerNum), 0);
hv_store(hv, "wMinorVerNum", 12, newSViv(p->wMinorVerNum), 0);
- hv_store(hv, "guid", 4, SetSVFromGUID(THIS_ p->guid), 0);
+ hv_store(hv, "guid", 4, SetSVFromGUID(aTHX_ p->guid), 0);
ST(0) = sv_2mortal(newRV_noinc((SV*)hv));
XSRETURN(1);
@@ -6024,7 +6310,7 @@
SV *self
PPCODE:
{
- WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(THIS_ self);
+ WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
@@ -6037,26 +6323,26 @@
IV index
PPCODE:
{
- WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(THIS_ self);
+ WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
ITypeInfo *pTypeInfo;
TYPEATTR *pTypeAttr;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeLib->GetTypeInfo(index, &pTypeInfo);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
- ST(0) = sv_2mortal(CreateTypeInfoObject(THIS_ pTypeInfo, pTypeAttr));
+ ST(0) = sv_2mortal(CreateTypeInfoObject(aTHX_ pTypeInfo, pTypeAttr));
XSRETURN(1);
}
@@ -6066,46 +6352,46 @@
SV *name
PPCODE:
{
- WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(THIS_ self);
+ WINOLETYPELIBOBJECT *pObj = GetOleTypeLibObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
ITypeInfo *pTypeInfo;
TYPEATTR *pTypeAttr;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
if (SvIOK(name)) {
HRESULT hr = pObj->pTypeLib->GetTypeInfo(SvIV(name), &pTypeInfo);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
- ST(0) = sv_2mortal(CreateTypeInfoObject(THIS_ pTypeInfo, pTypeAttr));
+ ST(0) = sv_2mortal(CreateTypeInfoObject(aTHX_ pTypeInfo, pTypeAttr));
XSRETURN(1);
}
- UINT cp = QueryPkgVar(THIS_ olestash, CP_NAME, CP_LEN, cpDefault);
+ UINT cp = QueryPkgVar(aTHX_ olestash, CP_NAME, CP_LEN, cpDefault);
TYPEKIND tkind = items > 2 ? (TYPEKIND)SvIV(ST(2)) : TKIND_MAX;
char *pszName = SvPV_nolen(name);
int count = pObj->pTypeLib->GetTypeInfoCount();
for (int index = 0; index < count; ++index) {
HRESULT hr = pObj->pTypeLib->GetTypeInfo(index, &pTypeInfo);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
BSTR bstrName;
hr = pTypeInfo->GetDocumentation(-1, &bstrName, NULL, NULL, NULL);
char szStr[OLE_BUF_SIZ];
- char *pszStr = GetMultiByte(THIS_ bstrName, szStr, sizeof(szStr), cp);
+ char *pszStr = GetMultiByte(aTHX_ bstrName, szStr, sizeof(szStr), cp);
int equal = strEQ(pszStr, pszName);
- ReleaseBuffer(THIS_ pszStr, szStr);
+ ReleaseBuffer(aTHX_ pszStr, szStr);
SysFreeString(bstrName);
if (!equal) {
pTypeInfo->Release();
@@ -6115,12 +6401,12 @@
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
if (tkind == TKIND_MAX || tkind == pTypeAttr->typekind) {
- ST(0) = sv_2mortal(CreateTypeInfoObject(THIS_ pTypeInfo, pTypeAttr));
+ ST(0) = sv_2mortal(CreateTypeInfoObject(aTHX_ pTypeInfo, pTypeAttr));
XSRETURN(1);
}
@@ -6143,28 +6429,28 @@
ITypeInfo *pTypeInfo;
TYPEATTR *pTypeAttr;
- WINOLEOBJECT *pOleObj = GetOleObject(THIS_ object);
+ WINOLEOBJECT *pOleObj = GetOleObject(aTHX_ object);
if (!pOleObj)
XSRETURN_EMPTY;
unsigned int count;
HRESULT hr = pOleObj->pDispatch->GetTypeInfoCount(&count);
HV *olestash = SvSTASH(pOleObj->self);
- if (CheckOleError(THIS_ olestash, hr) || count == 0)
+ if (CheckOleError(aTHX_ olestash, hr) || count == 0)
XSRETURN_EMPTY;
hr = pOleObj->pDispatch->GetTypeInfo(0, lcidDefault, &pTypeInfo);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
- ST(0) = sv_2mortal(CreateTypeInfoObject(THIS_ pTypeInfo, pTypeAttr));
+ ST(0) = sv_2mortal(CreateTypeInfoObject(aTHX_ pTypeInfo, pTypeAttr));
XSRETURN(1);
}
@@ -6173,9 +6459,9 @@
SV *self
PPCODE:
{
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (pObj) {
- RemoveFromObjectChain(THIS_ (OBJECTHEADER*)pObj);
+ RemoveFromObjectChain(aTHX_ (OBJECTHEADER*)pObj);
if (pObj->pTypeInfo) {
pObj->pTypeInfo->ReleaseTypeAttr(pObj->pTypeAttr);
pObj->pTypeInfo->Release();
@@ -6193,24 +6479,24 @@
ITypeLib *pTypeLib;
TLIBATTR *pTLibAttr;
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
unsigned int index;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeInfo->GetContainingTypeLib(&pTypeLib, &index);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
hr = pTypeLib->GetLibAttr(&pTLibAttr);
if (FAILED(hr)) {
pTypeLib->Release();
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
- ST(0) = sv_2mortal(CreateTypeLibObject(THIS_ pTypeLib, pTLibAttr));
+ ST(0) = sv_2mortal(CreateTypeLibObject(aTHX_ pTypeLib, pTLibAttr));
XSRETURN(1);
}
@@ -6220,19 +6506,19 @@
IV memid
PPCODE:
{
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
DWORD dwHelpContext;
BSTR bstrName, bstrDocString, bstrHelpFile;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeInfo->GetDocumentation(memid, &bstrName,
&bstrDocString, &dwHelpContext, &bstrHelpFile);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
- HV *hv = GetDocumentation(THIS_ bstrName, bstrDocString,
+ HV *hv = GetDocumentation(aTHX_ bstrName, bstrDocString,
dwHelpContext, bstrHelpFile);
ST(0) = sv_2mortal(newRV_noinc((SV*)hv));
XSRETURN(1);
@@ -6244,14 +6530,14 @@
IV index
PPCODE:
{
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
FUNCDESC *p;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeInfo->GetFuncDesc(index, &p);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
HV *hv = newHV();
@@ -6266,14 +6552,14 @@
hv_store(hv, "cScodes", 7, newSViv(p->cScodes), 0);
hv_store(hv, "wFuncFlags", 10, newSViv(p->wFuncFlags), 0);
- HV *elemdesc = TranslateElemDesc(THIS_ &p->elemdescFunc, pObj, olestash);
+ HV *elemdesc = TranslateElemDesc(aTHX_ &p->elemdescFunc, pObj, olestash);
hv_store(hv, "elemdescFunc", 12, newRV_noinc((SV*)elemdesc), 0);
if (p->cParams > 0) {
AV *av = newAV();
for (int i = 0; i < p->cParams; ++i) {
- elemdesc = TranslateElemDesc(THIS_ &p->lprgelemdescParam[i],
+ elemdesc = TranslateElemDesc(aTHX_ &p->lprgelemdescParam[i],
pObj, olestash);
av_push(av, newRV_noinc((SV*)elemdesc));
}
@@ -6291,14 +6577,14 @@
IV index
PPCODE:
{
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
int flags;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeInfo->GetImplTypeFlags(index, &flags);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
XSRETURN_IV(flags);
@@ -6314,23 +6600,23 @@
ITypeInfo *pTypeInfo;
TYPEATTR *pTypeAttr;
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeInfo->GetRefTypeOfImplType(index, &hRefType);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
hr = pObj->pTypeInfo->GetRefTypeInfo(hRefType, &pTypeInfo);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
if (FAILED(hr)) {
pTypeInfo->Release();
- ReportOleError(THIS_ olestash, hr);
+ ReportOleError(aTHX_ olestash, hr);
XSRETURN_EMPTY;
}
@@ -6338,10 +6624,10 @@
pObj->pTypeInfo = pTypeInfo;
pObj->pTypeAttr = pTypeAttr;
- AddToObjectChain(THIS_ (OBJECTHEADER*)pObj, WINOLETYPEINFO_MAGIC);
+ AddToObjectChain(aTHX_ (OBJECTHEADER*)pObj, WINOLETYPEINFO_MAGIC);
SV *sv = newSViv((IV)pObj);
- ST(0) = sv_2mortal(sv_bless(newRV_noinc(sv), GetStash(THIS_ self)));
+ ST(0) = sv_2mortal(sv_bless(newRV_noinc(sv), GetStash(aTHX_ self)));
XSRETURN(1);
}
@@ -6352,27 +6638,27 @@
IV count
PPCODE:
{
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
BSTR *rgbstr;
New(0, rgbstr, count, BSTR);
unsigned int cNames;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeInfo->GetNames(memid, rgbstr, count, &cNames);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
AV *av = newAV();
for (int i = 0; i < cNames; ++i) {
char szName[32];
// XXX use correct codepage ???
- char *pszName = GetMultiByte(THIS_ rgbstr[i],
+ char *pszName = GetMultiByte(aTHX_ rgbstr[i],
szName, sizeof(szName), CP_ACP);
SysFreeString(rgbstr[i]);
av_push(av, newSVpv(pszName, 0));
- ReleaseBuffer(THIS_ pszName, szName);
+ ReleaseBuffer(aTHX_ pszName, szName);
}
Safefree(rgbstr);
@@ -6385,14 +6671,14 @@
SV *self
PPCODE:
{
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
TYPEATTR *p = pObj->pTypeAttr;
HV *hv = newHV();
- hv_store(hv, "guid", 4, SetSVFromGUID(THIS_ p->guid), 0);
+ hv_store(hv, "guid", 4, SetSVFromGUID(aTHX_ p->guid), 0);
hv_store(hv, "lcid", 4, newSViv(p->lcid), 0);
hv_store(hv, "memidConstructor", 16, newSViv(p->memidConstructor), 0);
hv_store(hv, "memidDestructor", 15, newSViv(p->memidDestructor), 0);
@@ -6421,14 +6707,14 @@
IV index
PPCODE:
{
- WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(THIS_ self);
+ WINOLETYPEINFOOBJECT *pObj = GetOleTypeInfoObject(aTHX_ self);
if (!pObj)
XSRETURN_EMPTY;
VARDESC *p;
- HV *olestash = GetWin32OleStash(THIS_ self);
+ HV *olestash = GetWin32OleStash(aTHX_ self);
HRESULT hr = pObj->pTypeInfo->GetVarDesc(index, &p);
- if (CheckOleError(THIS_ olestash, hr))
+ if (CheckOleError(aTHX_ olestash, hr))
XSRETURN_EMPTY;
HV *hv = newHV();
@@ -6437,7 +6723,7 @@
hv_store(hv, "wVarFlags", 9, newSViv(p->wVarFlags), 0);
hv_store(hv, "varkind", 7, newSViv(p->varkind), 0);
- HV *elemdesc = TranslateElemDesc(THIS_ &p->elemdescVar,
+ HV *elemdesc = TranslateElemDesc(aTHX_ &p->elemdescVar,
pObj, olestash);
hv_store(hv, "elemdescVar", 11, newRV_noinc((SV*)elemdesc), 0);
@@ -6447,7 +6733,7 @@
if (p->varkind == VAR_CONST) {
// XXX should be stored as a Win32::OLE::Variant object ?
SV *sv = newSV(0);
- SetSVFromVariantEx(THIS_ p->lpvarValue, sv, olestash);
+ SetSVFromVariantEx(aTHX_ p->lpvarValue, sv, olestash);
hv_store(hv, "varValue", 8, sv, 0);
}
diff -ur libwin32-0.16/OLE/lib/Win32/OLE.pm libwin32-0.171/OLE/lib/Win32/OLE.pm
--- libwin32-0.16/OLE/lib/Win32/OLE.pm Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/OLE/lib/Win32/OLE.pm Tue Sep 19 16:39:23 2000
@@ -6,7 +6,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL $AUTOLOAD
$CP $LCID $Warn $LastError $_NewEnum $_Unique);
-$VERSION = '0.13';
+$VERSION = '0.1401';
use Carp;
use Exporter;
@@ -949,6 +949,6 @@
=head1 VERSION
-Version 0.13 9 May 2000
+Version 0.1401 11 September 2000
=cut
diff -ur libwin32-0.16/OLE/t/3_ole.t libwin32-0.171/OLE/t/3_ole.t
--- libwin32-0.16/OLE/t/3_ole.t Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/OLE/t/3_ole.t Tue Sep 19 16:39:24 2000
@@ -218,18 +218,24 @@
print "not " unless $ValOf == 25 && $RefOf->Value == 27;
printf "ok %d\n", ++$Test;
-# 16. Test 'SetProperty' function
+# 16. Assign and retrieve a very long string
+$Cell->{Value} = 'a' x 300;
+printf "# Value is %s\n", $Cell->Value;
+print "not " unless $Cell->Value eq ('a' x 300);
+printf "ok %d\n", ++$Test;
+
+# 17. Test 'SetProperty' function
$Cell->SetProperty('Value', 4711);
printf "# Value is %s\n", $Cell->Value;
print "not " unless $Cell->Value == 4711;
printf "ok %d\n", ++$Test;
-# 17. The following tests rely on the fact that the font is not yet bold
+# 18. The following tests rely on the fact that the font is not yet bold
printf "# Bold: %s\n", $Cell->Style->Font->Bold;
print "not " if $Cell->Style->Font->Bold;
printf "ok %d\n", ++$Test;
-# 18. Assignment by DISPATCH_PROPERTYPUTREF shouldn't work
+# 19. Assignment by DISPATCH_PROPERTYPUTREF shouldn't work
my $Style = $Book->Styles->Add("MyStyle");
$Style->Font->{Bold} = 1;
{ local $Excel::Warn = 0; $Cell->{Style} = $Style }
@@ -239,63 +245,63 @@
print "not " if $LastError != HRESULT(0x80020003) || $Cell->Style->Font->Bold;
printf "ok %d\n", ++$Test;
-# 19. But DISPATCH_PROPERTYPUT should be ok
+# 20. But DISPATCH_PROPERTYPUT should be ok
$Cell->LetProperty('Style', $Style);
printf "# Bold: %s\n", $Cell->Style->Font->Bold;
print "not " unless $Cell->Style->Font->Bold;
printf "ok %d\n", ++$Test;
-# 20. Set a cell range from an array ref containing an IV, PV and NV
+# 21. Set a cell range from an array ref containing an IV, PV and NV
$Sheet->Range("A8:C9")->{Value} = [[undef, 'Camel'],[42, 'Perl', 3.1415]];
$Value = $Sheet->Cells(9,2)->Value . $Sheet->Cells(8,2)->Value;
print "# Value is \"$Value\"\n";
print "not " unless $Value eq 'PerlCamel';
printf "ok %d\n", ++$Test;
-# 21. Retrieve float value (esp. interesting in foreign locales)
+# 22. Retrieve float value (esp. interesting in foreign locales)
$Value = $Sheet->Cells(9,3)->{Value};
print "# Value is \"$Value\"\n";
print "not " unless $Value == 3.1415;
printf "ok %d\n", ++$Test;
-# 22. Retrieve a 0 dimensional range; check array data structure
+# 23. Retrieve a 0 dimensional range; check array data structure
$Value = $Sheet->Range("B8")->{Value};
printf "# Values are: \"%s\"\n", stringify($Value);
print "not " if ref $Value;
printf "ok %d\n", ++$Test;
-# 23. Retrieve a 1 dimensional row range; check array data structure
+# 24. Retrieve a 1 dimensional row range; check array data structure
$Value = $Sheet->Range("B8:C8")->{Value};
printf "# Values are: \"%s\"\n", stringify($Value);
print "not " unless @$Value == 1 && ref $$Value[0];
printf "ok %d\n", ++$Test;
-# 24. Retrieve a 1 dimensional column range; check array data structure
+# 25. Retrieve a 1 dimensional column range; check array data structure
$Value = $Sheet->Range("B8:B9")->{Value};
printf "# Values are: \"%s\"\n", stringify($Value);
print "not " unless @$Value == 2 && ref $$Value[0] && ref $$Value[1];
printf "ok %d\n", ++$Test;
-# 25. Retrieve a 2 dimensional range; check array data structure
+# 26. Retrieve a 2 dimensional range; check array data structure
$Value = $Sheet->Range("B8:C9")->{Value};
printf "# Values are: \"%s\"\n", stringify($Value);
print "not " unless @$Value == 2 && ref $$Value[0] && ref $$Value[1];
printf "ok %d\n", ++$Test;
-# 26. Check contents of 2 dimensional array
+# 27. Check contents of 2 dimensional array
$Value = $$Value[0][0] . $$Value[1][0] . $$Value[1][1];
print "# Value is \"$Value\"\n";
print "not " unless $Value eq 'CamelPerl3.1415';
printf "ok %d\n", ++$Test;
-# 27. Set a cell formula and retrieve calculated value
+# 28. Set a cell formula and retrieve calculated value
$Sheet->Cells(3,1)->{Formula} = '=PI()';
$Value = $Sheet->Cells(3,1)->{Value};
print "# Value is \"$Value\"\n";
print "not " unless abs($Value-3.141592) < 0.00001;
printf "ok %d\n", ++$Test;
-# 28. Add single worksheet and check that worksheet count is incremented
+# 29. Add single worksheet and check that worksheet count is incremented
my $Count = $Sheets->{Count};
$Book->Worksheets->Add;
$Value = $Sheets->{Count};
@@ -303,7 +309,7 @@
print "not " unless $Value == $Count+1;
printf "ok %d\n", ++$Test;
-# 29. Add 2 more sheets, optional arguments are omitted
+# 30. Add 2 more sheets, optional arguments are omitted
$Count = $Sheets->{Count};
$Book->Worksheets->Add(undef,undef,2);
$Value = $Sheets->{Count};
@@ -311,7 +317,7 @@
print "not " unless $Value == $Count+2;
printf "ok %d\n", ++$Test;
-# 30. Add 3 more sheets before sheet 2 using a named argument
+# 31. Add 3 more sheets before sheet 2 using a named argument
$Count = $Sheets->{Count};
$Book->Worksheets(2)->{Name} = 'XYZZY';
$Sheets->Add($Book->Worksheets(2), {Count => 3});
@@ -320,13 +326,13 @@
print "not " unless $Value == $Count+3;
printf "ok %d\n", ++$Test;
-# 31. Previous sheet 2 should now be sheet 5
+# 32. Previous sheet 2 should now be sheet 5
$Value = $Book->Worksheets(5)->{Name};
print "# Value is \"$Value\"\n";
print "not " unless $Value eq 'XYZZY';
printf "ok %d\n", ++$Test;
-# 32. Add 2 more sheets at the end using 2 named arguments
+# 33. Add 2 more sheets at the end using 2 named arguments
$Count = $Sheets->{Count};
# Following line doesn't work with Excel 7 (Seems like an Excel bug?)
# $Sheets->Add({Count => 2, After => $Book->Worksheets($Sheets->{Count})});
@@ -334,7 +340,7 @@
print "not " unless $Sheets->{Count} == $Count+2;
printf "ok %d\n", ++$Test;
-# 33. Number of objects in an enumeration must match its "Count" property
+# 34. Number of objects in an enumeration must match its "Count" property
my @Sheets = in $Sheets;
printf "# \$Sheets->{Count} is %d\n", $Sheets->{Count};
printf "# scalar(\@Sheets) is %d\n", scalar(@Sheets);
@@ -345,7 +351,7 @@
printf "ok %d\n", ++$Test;
undef @Sheets;
-# 34. Enumerate all application properties using the C<keys> function
+# 35. Enumerate all application properties using the C<keys> function
my @Properties = keys %$Excel;
printf "# Number of Excel application properties: %d\n", scalar(@Properties);
$Value = grep /^(Parent|Xyzzy|Name)$/, @Properties;
@@ -354,7 +360,7 @@
printf "ok %d\n", ++$Test;
undef @Properties;
-# 35. Translate character from ANSI -> OEM
+# 36. Translate character from ANSI -> OEM
my ($Version) = $Excel->{Version} =~ /([0-9.]+)/;
print "# Excel version is $Version\n";
@@ -373,15 +379,15 @@
print "not " unless ord($ANSI) == 163 && ord($OEM) == 156;
printf "ok %d\n", ++$Test;
-# 36. Save workbook to file
+# 37. Save workbook to file
print "not " unless $Book->SaveAs($File);
printf "ok %d\n", ++$Test;
-# 37. Check if output file exists.
+# 38. Check if output file exists.
print "not " unless -f $File;
printf "ok %d\n", ++$Test;
-# 38. Access the same file object through a moniker.
+# 39. Access the same file object through a moniker.
$Obj = Win32::OLE->GetObject($File);
for ($Count=0 ; $Count < 5 ; ++$Count) {
my $Type = Win32::OLE->QueryObjectType($Obj);
@@ -396,7 +402,7 @@
printf "ok %d\n", ++$Test;
-# 39. Get return value as Win32::OLE::Variant object
+# 40. Get return value as Win32::OLE::Variant object
$Cell = $Obj->Worksheets('My Sheet #1')->Range('B9');
my $Variant = Win32::OLE::Variant->new(VT_EMPTY);
$Cell->Dispatch('Value', $Variant);
@@ -404,7 +410,7 @@
print "not " unless $Variant->Type == VT_BSTR && $Variant->Value eq 'Perl';
printf "ok %d\n", ++$Test;
-# 40. Use clsid string to start OLE server
+# 41. Use clsid string to start OLE server
undef $Value;
eval {
require Win32::Registry;
@@ -428,7 +434,7 @@
printf "ok %d\n", $Test;
}
-# 41. Use DCOM syntax to start server (on local machine though)
+# 42. Use DCOM syntax to start server (on local machine though)
# This might fail (on Win95/NT3.5 if DCOM support is not installed.
$Obj = Win32::OLE->new([hostname, 'Excel.Application'], 'Quit');
$Value = (Win32::OLE->QueryObjectType($Obj))[0];
@@ -436,7 +442,7 @@
print "not " unless $Value eq 'Excel';
printf "ok %d\n", ++$Test;
-# 42. Find $Excel object via EnumAllObjects()
+# 43. Find $Excel object via EnumAllObjects()
my $Found = 0;
$Count = Win32::OLE->EnumAllObjects(sub {
my $Object = shift;
@@ -448,38 +454,38 @@
print "not " unless $Found;
printf "ok %d\n", ++$Test;
-# 43. _NewEnum should normally be non-browseable
+# 44. _NewEnum should normally be non-browseable
my $Exists = grep /^_NewEnum$/, keys %{$Excel->Worksheets};
print "# Exists=$Exists\n";
print "not " if $Exists;
printf "ok %d\n", ++$Test;
-# 44. make _NewEnum visible
+# 45. make _NewEnum visible
Excel->Option(_NewEnum => 1);
$Exists = grep /^_NewEnum$/, keys %{$Excel->Worksheets};
print "# Exists=$Exists\n";
print "not " unless $Exists;
printf "ok %d\n", ++$Test;
-# 45. _NewEnum available as a method
+# 46. _NewEnum available as a method
@Sheets = @{$Excel->Worksheets->_NewEnum};
print "# $_->{Name}\n" foreach @Sheets;
print "not " unless @Sheets == 11 && grep $_->Name eq "My Sheet #1", @Sheets;
printf "ok %d\n", ++$Test;
-# 46. _NewEnum available as a property
+# 47. _NewEnum available as a property
@Sheets = @{$Excel->Worksheets->{_NewEnum}};
print "not " unless @Sheets == 11 && grep $_->Name eq "My Sheet #1", @Sheets;
printf "ok %d\n", ++$Test;
-# 47. Win32::OLE proxies are non-unique by default
+# 48. Win32::OLE proxies are non-unique by default
my $Application = $Excel->Application;
my $Parent = $Excel->Parent;
printf "# Application=%d Parent=%d\n", $Application, $Parent;
print "not " if $Application == $Parent;
printf "ok %d\n", ++$Test;
-# 48. Parent and Application property should now return the same object
+# 49. Parent and Application property should now return the same object
Excel->Option(_Unique => 1);
$Application = $Excel->Application;
$Parent = $Excel->Parent;
@@ -487,5 +493,5 @@
print "not " unless $Application == $Parent;
printf "ok %d\n", ++$Test;
-# 49. Terminate server instance ("ok $Test\n" printed by Excel destructor)
+# 50. Terminate server instance ("ok $Test\n" printed by Excel destructor)
exit;
diff -ur libwin32-0.16/PerfLib/PerfLib.xs libwin32-0.171/PerfLib/PerfLib.xs
--- libwin32-0.16/PerfLib/PerfLib.xs Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/PerfLib/PerfLib.xs Tue Sep 19 16:39:24 2000
@@ -965,7 +965,7 @@
RETVAL = RegQueryInfoKeyA(remote_perfkey, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, &value_len, NULL, NULL);
}
- if (!RETVAL && GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
+ if (RETVAL && RETVAL != ERROR_MORE_DATA) {
RegCloseKey(remote_lmkey);
RegCloseKey(remote_perfkey);
XSRETURN_NO;
diff -ur libwin32-0.16/Process/Process.pm libwin32-0.171/Process/Process.pm
--- libwin32-0.16/Process/Process.pm Tue Sep 19 16:37:49 2000
+++ libwin32-0.171/Process/Process.pm Tue Sep 19 16:39:24 2000
@@ -79,7 +79,8 @@
=head1 DESCRIPTION
-This module allows for control of processes in Perl.
+This module provides access to the process control functions in the
+Win32 API.
=head1 METHODS
@@ -100,8 +101,8 @@
=item Win32::Process::KillProcess($pid, $exitcode)
-Terminates any process identified by $pid. The process will exit
-with $exitcode.
+Terminates any process identified by $pid. $exitcode will be set to
+the exit code of the process.
=item $ProcessObj->Suspend()
@@ -111,9 +112,9 @@
Resume a suspended process.
-=item $ProcessObj->Kill( $ExitCode )
+=item $ProcessObj->Kill( $exitcode )
-Kill the associated process, have it die with exit code $ExitCode.
+Kill the associated process, have it terminate with exit code $ExitCode.
=item $ProcessObj->GetPriorityClass($class)
@@ -133,19 +134,48 @@
Set the process affinity mask. Only available on Windows NT.
-=item $ProcessObj->GetExitCode( $ExitCode )
+=item $ProcessObj->GetExitCode( $exitcode )
Retrieve the exitcode of the process.
-=item $ProcessObj->Wait($Timeout)
+=item $ProcessObj->Wait($timeout)
-Wait for the process to die. forever = INFINITE
+Wait for the process to die. $timeout should be specified in milliseconds.
+To wait forever, specify the constant C<INFINITE>.
=item $ProcessObj->GetProcessID()
Returns the Process ID.
=back
+
+=head1 EXPORTS
+
+The following constants are exported by default.
+
+ CREATE_DEFAULT_ERROR_MODE
+ CREATE_NEW_CONSOLE
+ CREATE_NEW_PROCESS_GROUP
+ CREATE_NO_WINDOW
+ CREATE_SEPARATE_WOW_VDM
+ CREATE_SUSPENDED
+ CREATE_UNICODE_ENVIRONMENT
+ DEBUG_ONLY_THIS_PROCESS
+ DEBUG_PROCESS
+ DETACHED_PROCESS
+ HIGH_PRIORITY_CLASS
+ IDLE_PRIORITY_CLASS
+ INFINITE
+ NORMAL_PRIORITY_CLASS
+ REALTIME_PRIORITY_CLASS
+ THREAD_PRIORITY_ABOVE_NORMAL
+ THREAD_PRIORITY_BELOW_NORMAL
+ THREAD_PRIORITY_ERROR_RETURN
+ THREAD_PRIORITY_HIGHEST
+ THREAD_PRIORITY_IDLE
+ THREAD_PRIORITY_LOWEST
+ THREAD_PRIORITY_NORMAL
+ THREAD_PRIORITY_TIME_CRITICAL
=cut
diff -ur libwin32-0.16/Win32.pm libwin32-0.171/Win32.pm
--- libwin32-0.16/Win32.pm Tue Sep 19 16:37:50 2000
+++ libwin32-0.171/Win32.pm Tue Sep 19 16:39:25 2000
@@ -6,7 +6,7 @@
# included with the latest builds of the ActivePerl distribution.)
#
-$VERSION = $VERSION = '0.16';
+$VERSION = $VERSION = '0.171';
require Exporter;
require DynaLoader;
End of Patch.
