Changeset 1631825

Timestamp:

Dec 17, 2008, 3:24:26 PM (15 years ago)

Author:

Nelson Elhage <nelhage@mit.edu>

Branches:

master, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9

Children:

f36cd97

Parents:

c675b39

Message:

Implement a perl timer class and minimal interface.

I will document this and add a better API (perhaps through an AnyEvent
impl) in later commits.

Files:

• perlconfig.c (modified) (1 diff)
• perlglue.xs (modified) (1 diff)
• perlwrap.pm (modified) (1 diff)

perlconfig.c

@@ -517 +517 @@
   LEAVE;
 }
+
+void owl_perlconfig_perl_timer(owl_timer *t, void *data)
+{
+  SV *obj = data;
+
+  if(!SvROK(obj)) {
+    return;
+  }
+
+  dSP;
+  ENTER;
+  SAVETMPS;
+
+  PUSHMARK(SP);
+  XPUSHs(obj);
+  PUTBACK;
+
+  call_method("do_callback", G_DISCARD|G_KEEPERR|G_EVAL);
+
+  SPAGAIN;
+
+  if (SvTRUE(ERRSV)) {
+    owl_function_error("Error in calback: '%s'", SvPV_nolen(ERRSV));
+    sv_setsv (ERRSV, &PL_sv_undef);
+  }
+
+  PUTBACK;
+  FREETMPS;
+  LEAVE;
+}
+
+void owl_perlconfig_perl_timer_destroy(owl_timer *t)
+{
+  if(SvOK((SV*)t->data)) {
+    SvREFCNT_dec((SV*)t->data);
+  }
+}

perlglue.xs

@@ -399 +399 @@
                                       desc,
                                       ival);
+
+IV
+add_timer(after, interval, cb)
+        int after
+        int interval
+        SV *cb
+        PREINIT:
+                SV *ref;
+                owl_timer *t;
+        CODE:
+                ref = sv_rvweaken(newSVsv(cb));
+                t = owl_select_add_timer(after,
+                                         interval,
+                                         owl_perlconfig_perl_timer,
+                                         owl_perlconfig_perl_timer_destroy,
+                                         ref);
+        owl_function_debugmsg("Created timer %p", t);
+        RETVAL = (IV)t;
+        OUTPUT:
+                RETVAL
+
+void
+remove_timer(timer)
+        IV timer
+        PREINIT:
+                owl_timer *t;
+        CODE:
+                t = (owl_timer*)timer;
+                owl_function_debugmsg("Freeing timer %p", t);
+                                owl_select_remove_timer(t);

perlwrap.pm

@@ -1228 +1228 @@
 }
 
+package BarnOwl::Timer;
+
+sub new {
+    my $class = shift;
+    my $args = shift;
+
+    my $cb = $args->{cb};
+    die("Invalid callback pased to BarnOwl::Timer\n") unless ref($cb) eq 'CODE';
+
+    my $self = {cb => $cb};
+
+    bless($self, $class);
+
+    $self->{timer} = BarnOwl::Internal::add_timer($args->{after} || 0,
+                                                  $args->{interval} || 0,
+                                                  $self);
+    return $self;
+}
+
+sub do_callback {
+    my $self = shift;
+    $self->{cb}->($self);
+}
+
+sub DESTROY {
+    my $self = shift;
+    if(defined($self->{timer})) {
+        BarnOwl::Internal::remove_timer($self->{timer});
+    }
+}
+
 
 # switch to package main when we're done