do non blocking connects

[spider.git] / perl / Timer.pm

diff --git a/perl/Timer.pm b/perl/Timer.pm
new file mode 100644 (file)
index 0000000..8969756
--- /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;