SVN: toys/rsget.pl/RSGet/MortalObject.pm

[sparky]

Author: sparky
Date: Fri Oct  9 23:22:33 2009
New Revision: 10745

Added:
   toys/rsget.pl/RSGet/MortalObject.pm
Log:
- new, object killer, used to prevent memory leaks


Added: toys/rsget.pl/RSGet/MortalObject.pm
==============================================================================
--- (empty file)
+++ toys/rsget.pl/RSGet/MortalObject.pm	Fri Oct  9 23:22:33 2009
@@ -0,0 +1,110 @@
+package RSGet::MortalObject;
+
+use strict;
+use warnings;
+use RSGet::Tools;
+set_rev qq$Id: Wait.pm 10652 2009-10-02 15:28:26Z sparky $;
+
+# This is object holder, which will destroy the object if it doesn't
+# receive heartbeat for some amount of time. It is used to prevent leaking
+# memory, expecially in http interface.
+
+my %holders;
+my $last_id = 0;
+
+sub new
+{
+	my $class = shift;
+	my $obj = shift;
+	my %opts = @_;
+
+	my $time = time;
+
+	my $id = sprintf "%d_%.6x", ++$last_id, int rand 1 << 24;
+
+	my $holder = {
+		obj => $obj,
+		start => $time,
+		last => $time,
+		die_after => $opts{die_after} || 10,
+	};
+	$holder->{kill_after} = $time + $opts{kill_after} if $opts{kill_after};
+	$holders{ $id } = $holder;
+
+	my $self = \$id;
+	bless $self, $class;
+
+	return $self;
+}
+
+sub from_id
+{
+	my $class = shift;
+	my $id = shift;
+
+	return undef unless exists $holders{ $id };
+	my $self = \$id;
+	bless $self, $class;
+	return $self;
+}
+
+sub obj
+{
+	my $self = shift;
+	my $id = $$self;
+
+	my $h = $holders{ $id } or return undef;
+	$h->{last} = time;
+	return $h->{obj};
+}
+
+sub id
+{
+	my $self = shift;
+	my $id = $$self;
+
+	return undef unless $holders{ $id };
+	return $id;
+}
+
+sub time_to_kill
+{
+	my $self = shift;
+	my $id = $$self;
+
+	my $h = $holders{ $id } or return undef;
+	return undef unless $h->{kill_after};
+	return $h->{kill_after} - time;
+}
+
+sub heartbeat
+{
+	my $self = shift;
+	my $id = $$self;
+
+	my $h = $holders{ $id } or return undef;
+	$h->{last} = time;
+
+	return 1;
+}
+
+sub update
+{
+	my $time = time;
+
+	foreach my $id ( keys %holders ) {
+		my $h = $holders{ $id };
+		if ( $h->{last} + $h->{die_after} < $time ) {
+			p "Mortal $id died\n" if verbose( 4 );
+			delete $h->{obj};
+			delete $holders{ $id };
+		} elsif ( $h->{kill_after} and $h->{kill_after} < $time ) {
+			p "Mortal $id killed\n" if verbose( 4 );
+			delete $h->{obj};
+			delete $holders{ $id };
+		}
+	}
+	RSGet::Line::status( 'mortals' => scalar keys %holders );
+}
+
+1;