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;
_______________________________________________
pld-cvs-commit mailing list
[email protected]
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
