X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FTimer.pm;fp=perl%2FTimer.pm;h=8969756f550706bb942e7bc3e7c6f2bb93054841;hb=586cbb347e7639f5575b48572e75140501a109c0;hp=0000000000000000000000000000000000000000;hpb=e674587476599456cce169e02b0e441d985f9dd8;p=spider.git

diff --git a/perl/Timer.pm b/perl/Timer.pm
new file mode 100644
index 00000000..8969756f
--- /dev/null
+++ b/perl/Timer.pm
@@ -0,0 +1,49 @@
+#
+# Polled Timer handling
+#
+# This uses callbacks. BE CAREFUL!!!!
+#
+# $Id$
+#
+# Copyright (c) 2001 Dirk Koopman G1TLH
+#
+
+package Timer;
+
+use vars qw(@timerchain);
+
+@timerchain = ();
+
+sub new
+{
+    my ($pkg, $time, $proc, $recur) = @_;
+	my $obj = ref($pkg);
+	my $class = $obj || $pkg;
+	my $self = bless { t=>$time + time, proc=>$proc }, $class;
+	$self->{interval} = $time if $recur;
+	push @timerchain, $self;
+	return $self;
+}
+
+sub del
+{
+	my $self = shift;
+	my $old = delete $self->{proc};
+	@timerchain = grep {$_ != $self} @timerchain;
+	return $old;
+}
+
+sub handler
+{
+	my $now = time;
+	
+	# handle things on the timer chain
+	for (@timerchain) {
+		if ($now >= $_->{t}) {
+			&{$_->{proc}}();
+			$_->{t} = $now + $_->{interval} if exists $_->{interval};
+		}
+	}
+}
+
+1;