Here is still another unofficial patch to go from libwin32 v0.172 to v0.173.
It corresponds to the libwin32 that ships with ActivePerl build 629. Apply
using GNU patch as follows:
# get libwin32-0.16.zip, libwin32-0.17{1,2,3}.patch
unzip libwin32-0.16.zip
rename libwin32-0.16 libwin32-0.173
cd libwin32-0.173
patch -p1 -N < ../libwin32-0.171.patch
patch -p1 -N < ../libwin32-0.172.patch
patch -p1 -N < ../libwin32-0.173.patch
Note that the patch for v0.171 and v0.172 must be applied first. You
can get my port of GNU patch for windows from:
http://downloads.ActiveState.com/pub/staff/gsar/patch-2.4.4-w32.zip
Enjoy.
Gurusamy Sarathy
gsar@ActiveState.com
------------------------------------8<------------------------------------
diff -ruN libwin32-0.173/Console/Console.xs libwin32/Console/Console.xs
--- libwin32-0.173/Console/Console.xs Fri Aug 17 16:52:17 2001
+++ libwin32/Console/Console.xs Fri Aug 17 16:55:20 2001
@@ -484,7 +484,7 @@
void
-_ReadConsoleOutputAttribute(handle,charbuf,len,x,y)
+_ReadConsoleOutputAttribute(handle,len,x,y)
HANDLE handle
DWORD len
SHORT x
diff -ruN libwin32-0.173/EventLog/Changes libwin32/EventLog/Changes
--- libwin32-0.173/EventLog/Changes Fri Aug 17 16:54:09 2001
+++ libwin32/EventLog/Changes Fri Aug 17 16:55:20 2001
@@ -1,18 +1,24 @@
Revision history for Perl extension Win32::EventLog.
-0.071 Fri Aug 25 12:34:56 2000
+0.072 Tue Aug 14 2001 (Jan Dubois)
+ - GetEventLogText fixes:
+ - EventMessageFile can actually be a *list* of files
+ - provide additional bogus inserts to cope with broken
+ message files / eventlog entries
+
+0.071 Fri Aug 25 12:34:56 2000 (Jan Dubois)
- 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 <jand@activestate.com>)
+ to Jan Dubois <JanD@ActiveState.com>)
- various other cleanups for the code and the documentation
- (Jan Dubois <jand@activestate.com>)
+ (Jan Dubois <JanD@ActiveState.com>)
0.062 Mon May 22 21:02:26 2000
- fix for memory leak in EventLog due to lack of DESTROY()
- (suggested by Jan Dubois <jand@activestate.com>)
+ (suggested by Jan Dubois <JanD@ActiveState.com>)
- Report() method uses 'Source' and 'Computer' fields in passed
hashref if they exist, and uses the same fields from the EventLog
object if they don't. NOTE: THIS IS A POTENTIAL COMPATIBILITY
diff -ruN libwin32-0.173/EventLog/EventLog.pm libwin32/EventLog/EventLog.pm
--- libwin32-0.173/EventLog/EventLog.pm Fri Aug 17 16:54:09 2001
+++ libwin32/EventLog/EventLog.pm Fri Aug 17 16:55:20 2001
@@ -9,7 +9,7 @@
use strict;
use vars qw($VERSION $AUTOLOAD @ISA @EXPORT $GetMessageText);
-$VERSION = '0.071';
+$VERSION = '0.072';
require Exporter;
require DynaLoader;
diff -ruN libwin32-0.173/EventLog/EventLog.xs libwin32/EventLog/EventLog.xs
--- libwin32-0.173/EventLog/EventLog.xs Fri Aug 17 16:54:09 2001
+++ libwin32/EventLog/EventLog.xs Fri Aug 17 16:55:20 2001
@@ -414,26 +414,27 @@
HKEY hk;
int length = SvCUR(ST(2))+1;
+ /* XXX TODO:
+ * XXX ParameterMessageFile can also be a semicolon separated list of files
+ * XXX What about expanding the category id to a string?
+ * XXX Determining the log category is kind of bogus!
+ * XXX This should have been a parameter.
+ */
+
if (USING_WIDE()) {
static const WCHAR *wEVFILE[] = {L"System", L"Security", L"Application"};
WCHAR *ptr, *tmpx;
WCHAR wmsgfile[MAX_PATH], wregPath[MAX_PATH], **wstrings;
WCHAR wsource[MAX_PATH+1], *wMsgBuf, *wlongstring;
+ WCHAR *wmessage = NULL;
char *MsgBuf;
- DWORD i, id2;
+ DWORD i, id2, maxinsert;
BOOL result;
LONG lResult;
unsigned short j;
WCHAR *percent;
int percentLen, msgLen;
- New(0, wstrings, numstrings+1, WCHAR*);
-
- /* Which EventLog are we reading? */
- New(0, wlongstring, length, WCHAR);
-
- wlongstring[0] = 0;
- A2WHELPER_LEN(longstring, length, wlongstring, length*sizeof(WCHAR));
A2WHELPER(source, wsource, sizeof(wsource));
for (j=0; j < (sizeof(wEVFILE)/sizeof(wEVFILE[0])); j++) {
@@ -450,8 +451,71 @@
if (j >= (sizeof(wEVFILE)/sizeof(wEVFILE[0])))
XSRETURN_NO;
+ /* Get the (list of) message file(s) for this entry */
+ i = sizeof(wregPath);
+ lResult = RegQueryValueExW(hk, L"EventMessageFile", 0, 0,
+ (unsigned char *)wregPath, &i);
+ if (lResult != ERROR_SUCCESS) {
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ if (ExpandEnvironmentStringsW(wregPath, wmsgfile, sizeof(wmsgfile)) == 0) {
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ /* Try to retrieve message *without* expanding the inserts yet */
+ ptr = wmsgfile;
+ while (ptr && !wmessage) {
+ WCHAR *semi = wcschr(ptr, L';');
+ if (semi)
+ *semi++ = '\0';
+ dll = LoadLibraryExW(ptr, 0, LOAD_LIBRARY_AS_DATAFILE);
+ if (dll) {
+ FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ FORMAT_MESSAGE_FROM_HMODULE |
+ FORMAT_MESSAGE_IGNORE_INSERTS,
+ dll, id, 0, (LPWSTR)&wmessage, 0, NULL);
+ FreeLibrary(dll);
+ }
+ ptr = semi;
+ }
+ if (!wmessage) {
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ /* Determine higest %n insert number */
+ maxinsert = numstrings;
+ ptr = wmessage;
+ while ((percent=wcschr(ptr, L'%'))
+ && swscanf(percent, L"%%%d", &id2) == 1)
+ {
+ if (id2 > maxinsert)
+ maxinsert = id2;
+ ptr = percent + 1;
+ }
+
+ New(0, wstrings, maxinsert, WCHAR*);
+
+ /* Allocate dummy strings for inserts not provided by caller */
+ for (j=numstrings; j<maxinsert; ++j) {
+ New(0, tmpx, 10, WCHAR);
+ swprintf(tmpx, L"%%%d", j+1);
+ wstrings[j] = tmpx;
+ }
+
+ i = sizeof(wregPath); /* Fixed */
+
+ /* Which EventLog are we reading? */
+ New(0, wlongstring, length, WCHAR);
+
+ wlongstring[0] = 0;
+ A2WHELPER_LEN(longstring, length, wlongstring, length*sizeof(WCHAR));
+
ptr = wlongstring;
- for (j=0; j<=numstrings; j++) {
+ for (j=0; j<numstrings; j++) {
wstrings[j] = ptr;
ptr += wcslen(ptr)+1;
@@ -511,37 +575,25 @@
}
}
- if (dll)
+ RegCloseKey(hk);
+ if (dll)
FreeLibrary(dll); /* in case it was used above */
- i = sizeof(wregPath);
- lResult = RegQueryValueExW(hk, L"EventMessageFile", 0, 0,
- (unsigned char *)wregPath, &i);
-
- RegCloseKey(hk);
-
- if (lResult != ERROR_SUCCESS)
- XSRETURN_NO;
-
- if (ExpandEnvironmentStringsW(wregPath, wmsgfile, sizeof(wmsgfile)) == 0)
- XSRETURN_NO;
-
- dll = LoadLibraryExW(wmsgfile, 0, LOAD_LIBRARY_AS_DATAFILE);
- if (!dll)
- XSRETURN_NO;
-
/* XXX 'strings' argument may be broken on 64-bit
* platforms since the documentation says 32-bit
* values are required */
- result = (FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER
- | FORMAT_MESSAGE_FROM_HMODULE
- | FORMAT_MESSAGE_ARGUMENT_ARRAY,
- dll, id, 0, (LPWSTR)&wMsgBuf, 0,
+ result = (FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ FORMAT_MESSAGE_FROM_STRING |
+ FORMAT_MESSAGE_ARGUMENT_ARRAY,
+ wmessage, 0, 0, (LPWSTR)&wMsgBuf, 0,
(va_list*)wstrings) > 0);
- for (j=0; j<=numstrings; j++)
+ LocalFree(wmessage);
+
+ for (j=0; j<maxinsert; j++)
if (wstrings[j] < wlongstring || wstrings[j] >= wlongstring+length)
Safefree(wstrings[j]);
+
Safefree(wlongstring);
Safefree(wstrings);
@@ -556,22 +608,20 @@
Safefree(MsgBuf);
LocalFree(wMsgBuf);
- FreeLibrary(dll);
XSRETURN_YES;
}
else {
static const char *EVFILE[] = {"System", "Security", "Application"};
char *MsgBuf, **strings, *ptr, *tmpx;
char msgfile[MAX_PATH], regPath[MAX_PATH];
- DWORD i, id2;
+ char *message = NULL;
+ DWORD i, id2, maxinsert;
BOOL result;
LONG lResult;
unsigned short j;
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,
@@ -587,15 +637,70 @@
if (j >= (sizeof(EVFILE)/sizeof(EVFILE[0])))
XSRETURN_NO;
+ /* Get the (list of) message file(s) for this entry */
+ i = sizeof(regPath);
+ lResult = RegQueryValueExA(hk, "EventMessageFile", 0, 0,
+ (unsigned char *)regPath, &i);
+ if (lResult != ERROR_SUCCESS) {
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ if (ExpandEnvironmentStringsA(regPath, msgfile, sizeof(msgfile)) == 0) {
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ /* Try to retrieve message *without* expanding the inserts yet */
+ ptr = msgfile;
+ while (ptr && !message) {
+ char *semi = strchr(ptr, ';');
+ if (semi)
+ *semi++ = '\0';
+ dll = LoadLibraryExA(ptr, 0, LOAD_LIBRARY_AS_DATAFILE);
+ if (dll) {
+ FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ FORMAT_MESSAGE_FROM_HMODULE |
+ FORMAT_MESSAGE_IGNORE_INSERTS,
+ dll, id, 0, (LPSTR)&message, 0, NULL);
+ FreeLibrary(dll);
+ }
+ ptr = semi;
+ }
+ if (!message) {
+ RegCloseKey(hk);
+ XSRETURN_NO;
+ }
+
+ /* Determine higest %n insert number */
+ maxinsert = numstrings;
+ ptr = message;
+ while ((percent=strchr(ptr, '%'))
+ && sscanf(percent, "%%%d", &id2) == 1)
+ {
+ if (id2 > maxinsert)
+ maxinsert = id2;
+ ptr = percent + 1;
+ }
+
+ New(0, strings, maxinsert, char*);
+
+ /* Allocate dummy strings for inserts not provided by caller */
+ for (j=numstrings; j<maxinsert; ++j) {
+ New(0, tmpx, 10, char);
+ sprintf(tmpx, "%%%d", j+1);
+ strings[j] = tmpx;
+ }
+
i = sizeof(regPath); /* Fixed */
ptr = longstring;
- for (j=0; j<=numstrings; j++) {
+ for (j=0; j<numstrings; j++) {
strings[j] = ptr;
ptr += strlen(ptr)+1;
gotPercent = -1;
while ((percent=strchr(strings[j], '%'))
- && sscanf(percent, "%%%%%d", &id2) ==1)
+ && sscanf(percent, "%%%%%d", &id2) == 1)
{
gotPercent++;
if (!dll) { /* first time round - load dll */
@@ -653,48 +758,34 @@
}
}
+ RegCloseKey(hk);
if (dll)
FreeLibrary(dll); /* in case it was used above */
- i = sizeof(regPath);
- lResult = RegQueryValueExA(hk, "EventMessageFile", 0, 0,
- (unsigned char *)regPath, &i);
-
- RegCloseKey(hk);
- if (lResult != ERROR_SUCCESS)
- XSRETURN_NO;
-
- if (ExpandEnvironmentStringsA(regPath, msgfile, sizeof(msgfile)) == 0)
- XSRETURN_NO;
-
- dll = LoadLibraryExA(msgfile, 0, LOAD_LIBRARY_AS_DATAFILE);
- if (!dll)
- XSRETURN_NO;
-
/* XXX 'strings' argument may be broken on 64-bit
* platforms since the documentation says 32-bit
* values are required */
- result = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
- | FORMAT_MESSAGE_FROM_HMODULE
- | FORMAT_MESSAGE_ARGUMENT_ARRAY,
- dll, id, 0, (LPSTR)&MsgBuf, 0,
+ result = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ FORMAT_MESSAGE_FROM_STRING |
+ FORMAT_MESSAGE_ARGUMENT_ARRAY,
+ message, 0, 0, (LPSTR)&MsgBuf, 0,
(va_list*)strings) > 0;
- for (j=0; j<=numstrings; j++)
+ LocalFree(message);
+
+ for (j=0; j<maxinsert; j++)
if (strings[j] < longstring || strings[j] >= longstring+length)
Safefree(strings[j]);
Safefree(strings);
if (!result || !MsgBuf) {
- FreeLibrary(dll);
XSRETURN_NO;
}
SETPV(4, MsgBuf);
LocalFree(MsgBuf);
- FreeLibrary(dll);
XSRETURN_YES;
}
}
diff -ruN libwin32-0.173/OLE/OLE.xs libwin32/OLE/OLE.xs
--- libwin32-0.173/OLE/OLE.xs Fri Aug 17 16:54:15 2001
+++ libwin32/OLE/OLE.xs Fri Aug 17 16:55:21 2001
@@ -3532,7 +3532,11 @@
method = *av_fetch((AV*)sv, 1, FALSE);
}
- if (SvPOK(method)) {
+ if (SvIOK(method)) {
+ /* XXX this will NOT work with named parameters */
+ dispID = SvIV(method);
+ }
+ else if (SvPOK(method)) {
buffer = SvPV(method, length);
if (length > 0) {
int newenum = QueryPkgVar(aTHX_ stash, _NEWENUM_NAME, _NEWENUM_LEN);
@@ -3748,6 +3752,34 @@
CheckOleError(aTHX_ stash, hr, &excepinfo, err);
XSRETURN(1);
+}
+
+void
+GetIDsOfNames(self, method)
+ SV *self
+ SV *method
+PPCODE:
+{
+ char *buffer;
+ STRLEN length;
+ DISPID dispID;
+
+ WINOLEOBJECT *pObj = GetOleObject(aTHX_ self);
+ if (!pObj)
+ XSRETURN_EMPTY;
+
+ HV *stash = SvSTASH(pObj->self);
+ SetLastOleError(aTHX_ stash);
+
+ LCID lcid = QueryPkgVar(aTHX_ stash, LCID_NAME, LCID_LEN, lcidDefault);
+ UINT cp = QueryPkgVar(aTHX_ stash, CP_NAME, CP_LEN, cpDefault);
+
+ buffer = SvPV(method, length);
+ HRESULT hr = GetHashedDispID(aTHX_ pObj, buffer, length, dispID, lcid, cp);
+ if (FAILED(hr))
+ XSRETURN_EMPTY;
+
+ XSRETURN_IV(dispID);
}
void
diff -ruN libwin32-0.173/OLE/t/3_ole.t libwin32/OLE/t/3_ole.t
--- libwin32-0.173/OLE/t/3_ole.t Fri Aug 17 16:54:15 2001
+++ libwin32/OLE/t/3_ole.t Fri Aug 17 16:55:21 2001
@@ -114,6 +114,7 @@
$Obj->Quit if defined $Obj;
# 3. Add a workbook (with default number of sheets)
+$Excel->{SheetsInNewWorkbook} = 3;
my $Book = $Excel->Workbooks->Add;
$Type = Win32::OLE->QueryObjectType($Book);
print "# Book object type is $Type\n";
@@ -511,5 +512,17 @@
print "not " unless $Application == $Parent;
printf "ok %d\n", ++$Test;
-# 51. Terminate server instance ("ok $Test\n" printed by Excel destructor)
+# 51. Determine Dispatch ID of "Parent"
+my $dispid = $Excel->GetIDsOfNames("Parent");
+print "# DispID=$dispid\n";
+print "not " unless $dispid == 150;
+printf "ok %d\n", ++$Test;
+
+# 52. Dispatch using numeric ID instead of method/property name
+$Parent = $Excel->Invoke($dispid);
+printf "# Application=%d Parent=%d\n", $Application, $Parent;
+print "not " unless $Application == $Parent;
+printf "ok %d\n", ++$Test;
+
+# 53. Terminate server instance ("ok $Test\n" printed by Excel destructor)
exit;
diff -ruN libwin32-0.173/Process/Changes libwin32/Process/Changes
--- libwin32-0.173/Process/Changes Fri Aug 17 16:54:15 2001
+++ libwin32/Process/Changes Fri Aug 17 16:55:21 2001
@@ -1,5 +1,9 @@
Revision history for Perl extension Win32::Process.
+0.09 Fri Aug 17 16:11:58 2001
+ - allow opening an existing pid, like OpenProcess() (thanks to
+ Blair Zajac <blair@orcaware.com>)
+
0.08 Tue Dec 26 2000
- make sure the environment is correctly inherited by the new
process. Only implemented in non-Unicode branch!
diff -ruN libwin32-0.173/Process/Process.hpp libwin32/Process/Process.hpp
--- libwin32-0.173/Process/Process.hpp Fri Aug 17 16:54:15 2001
+++ libwin32/Process/Process.hpp Fri Aug 17 16:55:21 2001
@@ -82,6 +82,31 @@
if (hLib != NULL)
pSetProcessAffinityMask = (LPSetProcessAffinityMask)GetProcAddress(hLib, "SetProcessAffinityMask");
}
+
+ cProcess(DWORD pid_, BOOL Inherit)
+ {
+ ph = NULL;
+ th = NULL;
+ pid = 0;
+ bRetVal = 0;
+
+ pSetProcessAffinityMask = NULL;
+ hLib = LoadLibrary("kernel32.dll");
+ if (hLib != NULL)
+ pSetProcessAffinityMask = (LPSetProcessAffinityMask)GetProcAddress(hLib, "SetProcessAffinityMask");
+
+ HANDLE ph_ = OpenProcess(PROCESS_DUP_HANDLE |
+ PROCESS_QUERY_INFORMATION |
+ PROCESS_SET_INFORMATION |
+ PROCESS_TERMINATE,
+ Inherit, pid_);
+ if (NULL == ph_) {
+ return;
+ }
+ ph = ph_;
+ bRetVal = 1;
+ }
+
~cProcess()
{
CloseHandle( th );
@@ -91,9 +116,9 @@
BOOL Kill(UINT uExitCode)
{ return TerminateProcess( ph, uExitCode ); }
BOOL Suspend()
- { return SuspendThread( th ); }
+ { return th ? SuspendThread( th ) : 0; }
BOOL Resume()
- { return ResumeThread( th ); }
+ { return th ? ResumeThread( th ) : 0; }
BOOL GetPriorityClass( DWORD* pdwPriorityClass )
{
(*pdwPriorityClass) = ::GetPriorityClass(ph);
diff -ruN libwin32-0.173/Process/Process.pm libwin32/Process/Process.pm
--- libwin32-0.173/Process/Process.pm Fri Aug 17 16:54:15 2001
+++ libwin32/Process/Process.pm Fri Aug 17 16:55:21 2001
@@ -4,7 +4,7 @@
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
-$VERSION = '0.08';
+$VERSION = '0.09';
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
@@ -98,6 +98,17 @@
$iflags flag: inherit calling processes handles or not
$cflags flags for creation (see exported vars below)
$curdir working dir of new process
+
+Returns non-zero on success, 0 on failure.
+
+=item Win32::Process::Open($obj,$pid,$iflags)
+
+Creates a handle Perl can use to an existing process as identified by $pid.
+The $iflags is the inherit flag that is passed to OpenProcess. Currently
+Win32::Process objects created using Win32::Process::Open cannot Suspend
+or Resume the process. All other calls should work.
+
+Win32::Process::Open returns non-zero on success, 0 on failure.
=item Win32::Process::KillProcess($pid, $exitcode)
diff -ruN libwin32-0.173/Process/Process.xs libwin32/Process/Process.xs
--- libwin32-0.173/Process/Process.xs Fri Aug 17 16:54:15 2001
+++ libwin32/Process/Process.xs Fri Aug 17 16:55:21 2001
@@ -55,6 +55,19 @@
return(cP->bRetVal);
}
+static BOOL
+Open_(cProcess * &cP, DWORD pid, DWORD Inherit)
+{
+ cP = NULL;
+ try {
+ cP = (cProcess *) new cProcess(pid, Inherit);
+ }
+ catch (...) {
+ return(FALSE);
+ }
+ return(cP->bRetVal);
+}
+
static double
@@ -292,6 +305,18 @@
else {
RETVAL = Create(cP, appname, cmdline, inherit, flags, curdir);
}
+OUTPUT:
+ cP
+ RETVAL
+
+
+BOOL
+Open(cP,pid,inherit)
+ cProcess *cP = NULL;
+ DWORD pid
+ BOOL inherit
+CODE:
+ RETVAL = Open_(cP, pid, inherit);
OUTPUT:
cP
RETVAL
diff -ruN libwin32-0.173/Process/test.pl libwin32/Process/test.pl
--- libwin32-0.173/Process/test.pl Fri Aug 17 16:52:17 2001
+++ libwin32/Process/test.pl Fri Aug 17 16:55:21 2001
@@ -6,11 +6,22 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-BEGIN { $| = 1; print "1..1\n"; }
+use strict;
+use vars qw($loaded);
+
+BEGIN { $| = 1; print "1..4\n"; }
END {print "not ok 1\n" unless $loaded;}
+
+my $ok_count = 1;
+sub ok {
+ shift or print "not ";
+ print "ok $ok_count\n";
+ ++$ok_count;
+}
+
use Win32::Process;
$loaded = 1;
-print "ok 1\n";
+ok(1);
######################### End of black magic.
@@ -18,3 +29,13 @@
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
+my $p;
+if (Win32::Process::Open($p, $$, 0)) {
+ ok(1);
+ ok($p->SetPriorityClass(HIGH_PRIORITY_CLASS))
+} else {
+ ok(0);
+ ok(0);
+}
+
+ok(!Win32::Process::Open($p, -1, 0));
diff -ruN libwin32-0.173/TieRegistry/Changes libwin32/TieRegistry/Changes
--- libwin32-0.173/TieRegistry/Changes Fri Aug 17 16:52:18 2001
+++ libwin32/TieRegistry/Changes Fri Aug 17 16:55:22 2001
@@ -1,6 +1,11 @@
Revision history for Perl extension Win32::TieRegistry.
-0.23 Sat Jul 3 00:06:20 1999
+0.24 2001-02-06 19:00
+ - Silenced error that could appear "at random" during "cleanup":
+ (Can't call method "FETCH" on an undefined value)
+ - Added a nearly trivial test suite.
+
+0.23 1999-07-03 00:06
- Fixed two embarrassing typographical errors.
- Using invalid REG_* or KEY_* constant as string now detected.
- With ArrayValues(1), $key->{NonExistantValueName} used to return
@@ -11,7 +16,7 @@
- All implicit C<return>s made explicit [C<$val;> to C<return $val;>].
- Simplified C<return wantarray ? () : undef> to C<return ()>.
-0.22 Fri Apr 9 22:13:52 1999
+0.22 1999-04-09 22:13
- C<new Win32::TieRegistry> and "Win32::TieRegistry->new" now work.
- CreateKey()'s "disposition" argument now can get its string value
set to "REG_CREATED_NEW_KEY" or "REG_OPENED_EXISTING_KEY".
@@ -21,10 +26,10 @@
- New documentation section on probable future directions.
- Minor documentation fixes.
-0.21 Thu Sep 17 14:49:26 1998
+0.21 1998-09-17 14:49
- Remove a few "harmless" warnings reported by C<-w>.
-0.20 Tue Jul 14 14:14:54 1998
+0.20 1998-07-14 14:14
- Renamed to Win32::TieRegistry.
- Added options: SplitMultis, FixSzNulls,
DWordToHex, DualBinVals, and DualTypes.
@@ -45,20 +50,20 @@
to load into _local_ LMachine.
- Finished POD.
-0.15 Tue Jul 14 14:14:54 1998
+0.15 1998-07-14 14:14
- "Stub" version of Tie::Registry for backward compatibility only.
0.14 Never released
- Added Install.bat for people without a version of "make".
- Report key path when STORE fails.
-0.13 Tue Mar 31 20:50:28 1998
+0.13 1998-03-31 20:50
- "Delimiter" now spelled correctly throughout (sigh).
- SetValue now translates "REG_*" strings to numeric constants.
- Removed dependance on $^E being tied to Win32::GetLastError().
-0.12 Mon Dec 29 10:11:30 1997
+0.12 1997-12-29 10:11
- misc.
-0.10 Fri Nov 21 15:08:55 1997
+0.10 1997-11-21 15:08
- original, limited install, named Tie::Registry.
diff -ruN libwin32-0.173/TieRegistry/TieRegistry.pm libwin32/TieRegistry/TieRegistry.pm
--- libwin32-0.173/TieRegistry/TieRegistry.pm Fri Aug 17 16:52:18 2001
+++ libwin32/TieRegistry/TieRegistry.pm Fri Aug 17 16:55:22 2001
@@ -14,7 +14,7 @@
use vars qw( $PACK $VERSION @ISA @EXPORT @EXPORT_OK );
$PACK= "Win32::TieRegistry"; # Used in error messages.
-$VERSION= '0.23'; # Released on July 03 1999
+$VERSION= '0.24'; # Released 2001-02-06
use Carp;
@@ -1483,7 +1483,9 @@
{
my $self= shift(@_);
return if tied(%$self);
- my $unload= $self->{UNLOADME};
+ my $unload;
+ eval { $unload= $self->{UNLOADME}; 1 }
+ or return;
my $debug= $ENV{DEBUG_TIE_REGISTRY};
if( defined($debug) ) {
if( 1 < $debug ) {
diff -ruN libwin32-0.173/TieRegistry/test.pl libwin32/TieRegistry/test.pl
--- libwin32-0.173/TieRegistry/test.pl Fri Aug 17 16:52:18 2001
+++ libwin32/TieRegistry/test.pl Fri Aug 17 16:55:22 2001
@@ -1,3 +1,4 @@
+#!/usr/bin/perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
@@ -6,14 +7,30 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-BEGIN { $| = 1; print "1..1\n"; }
+BEGIN { $| = 1; print "1..4\n"; }
END {print "not ok 1\n" unless $loaded;}
-use Win32::TieRegistry;
+my $reg;
+use Win32::TieRegistry (
+ Delimiter=>"/", ArrayValues=>1, TiedRef=>\$reg, ":REG_" );
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
+$|= 1 if $Debug= ( -t STDIN ) != ( -t STDOUT );
+
+my $val= $reg->{ "CUser/Software/Microsoft/Windows/CurrentVersion/"
+ . "Policies/Explorer//NoDriveTypeAutoRun" };
+print "# Can't open CU/SW/MS/Win/CV/Pol/Exp//NoDriveTypeAutoRun: ",$^E,$/
+ if ! $val && $Debug;
+print $val ? "" : "not ", "ok 2\n";
+
+print '# REG_DWORD is ',REG_DWORD,', type is ',$val->[1],$/ if $Debug;
+print REG_DWORD == $val->[1] ? "" : "not ", "ok 3\n";
+
+print '# $val->[0] is "',$val->[0],'".',$/ if $Debug;
+print $val->[0] =~ /^0x[\da-f]{8}$/i ? "" : "not ", "ok 4\n";
+
+# This doesn't work unless you have the SetDualVar
+# module installed so just don't test it for now:
+# print 0+$val->[0] == hex($val->[0]) ? "" : "not ", "ok 5\n";
diff -ruN libwin32-0.173/Win32.pm libwin32/Win32.pm
--- libwin32-0.173/Win32.pm Fri Aug 17 16:54:15 2001
+++ libwin32/Win32.pm Fri Aug 17 17:01:05 2001
@@ -6,7 +6,7 @@
# included with the latest builds of the ActivePerl distribution.)
#
-$VERSION = $VERSION = '0.172';
+$VERSION = $VERSION = '0.173';
require Exporter;
require DynaLoader;
diff -ruN libwin32-0.173/WinError/WinError.xs libwin32/WinError/WinError.xs
--- libwin32-0.173/WinError/WinError.xs Fri Aug 17 16:52:18 2001
+++ libwin32/WinError/WinError.xs Fri Aug 17 16:55:22 2001
@@ -1,4 +1,4 @@
-#ifndef __MINGW32__
+#if !defined(__MINGW32__) || !(defined(__BORLANDC__) && __BORLANDC__ >= 0x0550)
#include <wtypes.h>
#endif
#include <WinError.h>
End of Patch.