Update of /cvsroot/perl-win32-gui/Win32-GUI
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10102
Modified Files:
GUI.pm GUI.xs GUI_Helpers.cpp GUI_Options.cpp MonthCal.xs
Log Message:
Add ClassData() method and fix memory leaks
Index: GUI_Options.cpp
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Options.cpp,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** GUI_Options.cpp 13 Apr 2006 22:17:07 -0000 1.14
--- GUI_Options.cpp 23 Jun 2006 18:35:33 -0000 1.15
***************
*** 1014,1017 ****
// Free if not use.
if (hvEvents != NULL)
! hv_undef(hvEvents);
}
--- 1014,1017 ----
// Free if not use.
if (hvEvents != NULL)
! SvREFCNT_dec(hvEvents);
}
Index: GUI.xs
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.xs,v
retrieving revision 1.59
retrieving revision 1.60
diff -C2 -d -r1.59 -r1.60
*** GUI.xs 11 Jun 2006 21:00:15 -0000 1.59
--- GUI.xs 23 Jun 2006 18:35:33 -0000 1.60
***************
*** 1779,1820 ****
###########################################################################
! # (@)METHOD:UserData([value])
! # Sets or reads user data associated with the window or control.
! #
! # my $data=$win->UserData();#retrieve any data associated with the window
! # $win->UserData('some string');#associate user data to the window
! #
! # User data can be any perl scalar or reference.
! void
! UserData(handle,...)
HWND handle
PREINIT:
LPPERLWIN32GUI_USERDATA perlud;
! PPCODE:
! if(items > 2) {
! CROAK("Usage: UserData(handle, [value]);\n");
! }
perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong(handle, GWL_USERDATA);
if( ! ValidUserData(perlud) ) {
XSRETURN_UNDEF;
- } else {
- if(items==1){//reading the user data
- if (perlud->userData!=NULL) {
- //Just return the SV
- XPUSHs(perlud->userData);
- } else {
- XSRETURN_UNDEF;
- }
- }
- else {//setting user data
- //need to free previous!
- if (perlud->userData!=NULL) {
- SvREFCNT_dec(perlud->userData);
- }
- perlud->userData=ST(1);
- SvREFCNT_inc(perlud->userData);
- }
}
###########################################################################
# (@)METHOD:FindWindow(CLASSNAME, WINDOWNAME)
--- 1779,1803 ----
###########################################################################
! # (@)INTERNAL:_UserData()
! # Return a reference to an HV, stored in the perlud.UserData member
! # of the PERLWIN32GUI_USERDATA struct
! HV *
! _UserData(handle)
HWND handle
PREINIT:
LPPERLWIN32GUI_USERDATA perlud;
! CODE:
perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong(handle, GWL_USERDATA);
if( ! ValidUserData(perlud) ) {
XSRETURN_UNDEF;
}
+ if(perlud->userData == NULL)
+ perlud->userData = (SV*)newHV();
+
+ RETVAL = (HV*)perlud->userData;
+ OUTPUT:
+ RETVAL
+
###########################################################################
# (@)METHOD:FindWindow(CLASSNAME, WINDOWNAME)
***************
*** 3596,3603 ****
newarray = newAV();
av_push(newarray, coderef);
! SvREFCNT_inc(coderef); // needed so that av_undef results in
unchanged ref count.
if(av_store(perlud->avHooks, WM_TRACKPOPUP_MSGHOOK,
newRV_noinc((SV*) newarray)) == NULL) {
// Failed to store new array
! av_undef(newarray);
W32G_WARN("TrackPopupMenu failed to store 'coderef' - callback
not applied");
coderef = NULL; // don't set up the hook
--- 3579,3586 ----
newarray = newAV();
av_push(newarray, coderef);
! SvREFCNT_inc(coderef); // needed so that the ref count remains the
same after we free
if(av_store(perlud->avHooks, WM_TRACKPOPUP_MSGHOOK,
newRV_noinc((SV*) newarray)) == NULL) {
// Failed to store new array
! SvREFCNT_dec((SV*) newarray);
W32G_WARN("TrackPopupMenu failed to store 'coderef' - callback
not applied");
coderef = NULL; // don't set up the hook
***************
*** 3631,3636 ****
}
// remove the temporary value stored in the hooks array
! av_undef(newarray);
! av_delete(perlud->avHooks, WM_TRACKPOPUP_MSGHOOK, 0);
}
OUTPUT:
--- 3614,3618 ----
}
// remove the temporary value stored in the hooks array
! av_delete(perlud->avHooks, WM_TRACKPOPUP_MSGHOOK, G_DISCARD);
}
OUTPUT:
Index: MonthCal.xs
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/MonthCal.xs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** MonthCal.xs 8 May 2004 17:31:21 -0000 1.1
--- MonthCal.xs 23 Jun 2006 18:35:33 -0000 1.2
***************
*** 136,140 ****
lpnmDS->prgDayState[i] = SvIV(*sv);
}
! av_undef(av);
}
break;
--- 136,140 ----
lpnmDS->prgDayState[i] = SvIV(*sv);
}
! SvREFCNT_dec(av);
}
break;
Index: GUI_Helpers.cpp
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Helpers.cpp,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** GUI_Helpers.cpp 16 May 2006 18:36:11 -0000 1.19
--- GUI_Helpers.cpp 23 Jun 2006 18:35:33 -0000 1.20
***************
*** 67,80 ****
if (perlud != NULL) {
- // printf ("Free Perlud = %s\n", perlud->szWindowName);
// Free event hash
if (perlud->hvEvents != NULL) {
! hv_undef(perlud->hvEvents);
perlud->hvEvents = NULL;
}
// Free hook hash
if (perlud->avHooks != NULL) {
! av_undef (perlud->avHooks);
! perlud->avHooks = NULL;
}
// Free self
--- 67,87 ----
if (perlud != NULL) {
// Free event hash
if (perlud->hvEvents != NULL) {
! // Test ref-count - warn if not one
! if(SvREFCNT(perlud->hvEvents) != 1)
! W32G_WARN("hvEvents ref count not 1 during destruction -
please report this");
!
! SvREFCNT_dec(perlud->hvEvents);
perlud->hvEvents = NULL;
}
// Free hook hash
if (perlud->avHooks != NULL) {
! // Test ref-count - warn if not one
! if(SvREFCNT(perlud->avHooks) != 1)
! W32G_WARN("avHooks ref count not 1 during destruction -
please report this");
!
! SvREFCNT_dec(perlud->avHooks);
! perlud->avHooks = NULL;
}
// Free self
***************
*** 93,100 ****
perlud->svSelf = NULL;
}
! // Drop the ref counter on user data
! if (perlud->userData != NULL && SvREFCNT(perlud->userData) > 0) {
! SvREFCNT_dec(perlud->userData);
! }
// Free perlpud
safefree (perlud);
--- 100,115 ----
perlud->svSelf = NULL;
}
!
! // If we stored a hash in userData, drop it's
! // ref count to free it (and it's members)
! if (perlud->userData != NULL) {
! // Test ref-count - warn if not one
! if(SvREFCNT(perlud->userData) != 1)
! W32G_WARN("userData ref count not 1 during destruction -
please report this");
!
! SvREFCNT_dec(perlud->userData);
! perlud->userData = NULL;
! }
!
// Free perlpud
safefree (perlud);
Index: GUI.pm
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v
retrieving revision 1.49
retrieving revision 1.50
diff -C2 -d -r1.49 -r1.50
*** GUI.pm 15 Jun 2006 23:38:48 -0000 1.49
--- GUI.pm 23 Jun 2006 18:35:33 -0000 1.50
***************
*** 305,308 ****
--- 305,382 ----
}
+
###########################################################################
+ # (@)METHOD:UserData([value])
+ # Sets or reads user data associated with the window or control.
+ #
+ # my $data=$win->UserData();#retrieve any data associated with the window
+ # $win->UserData('some string');#associate user data to the window
+ #
+ # User data can be any perl scalar or reference.
+ #
+ # When reading returns the stored user data, or undef if nothing is
stored.
+ # When setting returns a true value if the user data is stored correctly,
or
+ # a false value on error
+ #
+ # If you are writing a class that you expect others to use, then this
+ # method should B<NOT> be used to store class instance data. See
+ # L<ClassData()|ClassData> instead.
+ sub UserData {
+ my $win = shift;
+ my $data = shift;
+
+ if(@_) { # more items than expected passed: someone probably tried
+ # passsing and array or hash
+ warn("UserData: too many arguments");
+ return 0;
+ }
+
+ if(defined $data) { # Setting user data
+ $win->_UserData()->{UserData} = $data;
+ return 1;
+ }
+ else { # reading user data
+ return $win->_UserData()->{UserData};
+ }
+ }
+
+
###########################################################################
+ # (@)METHOD:ClassData([value])
+ # Sets or reads class instance data associated with the window or control.
+ #
+ # my $data=$win->ClassData();#retrieve any data associated with the
window
+ # $win->ClassData('some string');#associate data to the window
+ #
+ # Class instance data can be any perl scalar or reference.
+ #
+ # When reading returns the stored instance data, or undef if nothing is
+ # stored.
+ # When setting returns a true value if the instance data is stored
+ # correctly, or a false value on error
+ #
+ # Class instance data is private to the package that sets the data. I.e.
it
+ # is only accessable as a method call from within the package that sets
the
+ # data, not from a sub-class. So, if you wish to make data stored this
way
+ # accessible to sub-classes you must proved assessor methods in your
package.
+ sub ClassData {
+ my $win = shift;
+ my $data = shift;
+
+ if(@_) { # more items than expected passed: someone probably tried
+ # passsing and array or hash
+ warn("ClassData: too many arguments");
+ return 0;
+ }
+
+ my $callpkg = (caller())[0];
+
+ if(defined $data) { # Setting user data
+ $win->_UserData()->{$callpkg} = $data;
+ return 1;
+ }
+ else { # reading user data
+ return $win->_UserData()->{$callpkg};
+ }
+ }
+
###############################################################################
# SUB-PACKAGES
