From 0a0ee3e6dfb5299e67e782600eeb39c873514395 Mon Sep 17 00:00:00 2001
From: Paul Driver <paul@plainblack.com>
Date: Wed, 19 Aug 2009 20:32:05 +0000
Subject: [PATCH] Fixed semi-rare memory leak in getLineage

---
 docs/changelog/7.x.x.txt   |  1 +
 lib/WebGUI/Asset.pm        | 11 ++++----
 lib/WebGUI/AssetLineage.pm | 53 +++++++++++++++++++++++++++++++++-----
 3 files changed, 54 insertions(+), 11 deletions(-)

diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt
index 1a40df4c2..d8c5c4212 100644
--- a/docs/changelog/7.x.x.txt
+++ b/docs/changelog/7.x.x.txt
@@ -2,6 +2,7 @@
  - fixed #10788: Thread rating calculate during post delete/restore
  - will now respect X-Forwarded-Proto header
  - no longer need special Apache configuration to handle SSLPROXY header
+ - fixed semi-rare memory leak in getLineage
  - fixed #10674: CDN URLs are cached across HTTP/HTTPS accesses
  - fixed: Copied assets don't always get URL extensions added
  - fixed #10789: Inbox message states not deleted when a user is deleted
diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm
index 9b6e9ee49..d218cb1b2 100644
--- a/lib/WebGUI/Asset.pm
+++ b/lib/WebGUI/Asset.pm
@@ -567,11 +567,12 @@ Completely remove an asset from existence.
 
 sub DESTROY {
 	my $self = shift;
-	# something bad happens when the following is enabled, not sure why
-	# must check this out later
-	#$self->{_parent}->DESTROY if (exists $self->{_parent});
-	$self->{_firstChild}->DESTROY if (exists $self->{_firstChild});
-	$self->{_lastChild}->DESTROY if (exists $self->{_lastChild});
+
+	# Let the parent be garbage collected if no one else is referencing
+	# him.  firstChild and lastChild are weak references, so no need to
+	# worry about them here.
+	delete $self->{_parent};
+
 	$self = undef;
 }
 
diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm
index 93b00985d..ff69f9fe5 100644
--- a/lib/WebGUI/AssetLineage.pm
+++ b/lib/WebGUI/AssetLineage.pm
@@ -16,6 +16,7 @@ package WebGUI::Asset;
 
 use strict;
 use Carp qw( croak );
+use Scalar::Util qw( weaken );
 
 =head1 NAME
 
@@ -91,6 +92,35 @@ sub addChild {
 	return $newAsset;
 }
 
+#-------------------------------------------------------------------
+
+=head2 cacheChild ( [first|last], asset? )
+
+A cache is kept of the first and last child assets in several cases.  In order
+to avoid memory leaks, these references must be weak, and the child assets
+must have a _parent reference to avoid early collection.  cacheChild maintains
+this delicate state, and so should be called instead of setting this cache
+directly.
+
+If called without an asset argument, the cached child is simply returned.
+
+=cut
+
+sub cacheChild {
+	my ($self, $which, $child) = @_;
+	my $slot = "_${which}Child";
+
+	if ($child) {
+		$self->{$slot} = $child;
+		$child->{_parent} = $self;
+		weaken($self->{$slot});
+	}
+	else {
+		$child = $self->{$slot};
+	}
+
+	return $child;
+}
 
 #-------------------------------------------------------------------
 
@@ -229,6 +259,7 @@ Returns the highest rank, top of the highest rank Asset under current Asset.
 
 sub getFirstChild {
 	my $self = shift;
+	# TODO: Use accessor here instead
 	unless (exists $self->{_firstChild}) {
 		my $assetLineage = $self->session->stow->get("assetLineage");
 		my $lineage = $assetLineage->{firstChild}{$self->getId};
@@ -239,8 +270,10 @@ sub getFirstChild {
 				$self->session->stow->set("assetLineage", $assetLineage);
 			}
 		}
-		$self->{_firstChild} = WebGUI::Asset->newByLineage($self->session,$lineage);
+		my $child = WebGUI::Asset->newByLineage($self->session,$lineage);
+		$self->cacheChild(first => $child);
 	}
+	# TODO: Use accessor here instead
 	return $self->{_firstChild};
 }
 
@@ -255,6 +288,7 @@ Returns the lowest rank, bottom of the lowest rank Asset under current Asset.
 
 sub getLastChild {
 	my $self = shift;
+	# TODO: Use accessor here instead
 	unless (exists $self->{_lastChild}) {
 		my $assetLineage = $self->session->stow->get("assetLineage");
 		my $lineage = $assetLineage->{lastChild}{$self->getId};
@@ -263,8 +297,10 @@ sub getLastChild {
 			$assetLineage->{lastChild}{$self->getId} = $lineage;
 			$self->session->stow->set("assetLineage", $assetLineage);
 		}
-		$self->{_lastChild} = WebGUI::Asset->newByLineage($self->session,$lineage);
+		my $child = WebGUI::Asset->newByLineage($self->session,$lineage);
+		$self->cacheChild(last => $child);
 	}
+	# TODO: Use accessor here instead
 	return $self->{_lastChild};
 }
 
@@ -383,11 +419,14 @@ sub getLineage {
 		}
 		# since we have the relatives info now, why not cache it
 		if ($rules->{returnObjects}) {
-			my $parent = $relativeCache{$parentId};
 			$relativeCache{$id} = $asset;
-			$asset->{_parent} = $parent if exists $relativeCache{$parentId};
-			$parent->{_firstChild} = $asset unless(exists $parent->{_firstChild});
-			$parent->{_lastChild} = $asset;
+			if (my $parent = $relativeCache{$parentId}) {
+				$asset->{_parent} = $parent; 
+				unless ($parent->cacheChild('first')) {
+					$parent->cacheChild(first => $asset);
+				}
+				$parent->cacheChild(last => $asset);
+			}
 		}
 		push(@lineage,$asset);
 	}
@@ -748,8 +787,10 @@ Returns 1 or the count of Assets with the same parentId as current Asset's asset
 sub hasChildren {
 	my $self = shift;
 	unless (exists $self->{_hasChildren}) {
+		# TODO: Use accessor here instead
 		if (exists $self->{_firstChild}) {
 			$self->{_hasChildren} = 1;
+		# TODO: Use accessor here instead
 		} elsif (exists $self->{_lastChild}) {
 			$self->{_hasChildren} = 1;
 		} else {