From: Vincent Pit <vince@profvince.com>
Date: Sat, 29 Aug 2009 16:15:47 +0000 (+0200)
Subject: Introduce ->callbacks to specify the 'exec' callback individually
X-Git-Tag: v0.08~7
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=bc365867d2883a69972ef82adf4b19d0680e43aa;p=perl%2Fmodules%2Fre-engine-Plugin.git

Introduce ->callbacks to specify the 'exec' callback individually
---

diff --git a/MANIFEST b/MANIFEST
index 1380013..51e2b21 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -10,6 +10,7 @@ Plugin.xs
 README
 ptable.h
 t/00-compile.t
+t/callbacks/exec.t
 t/eval-comp.t
 t/eval-exec.t
 t/import.t
diff --git a/Plugin.pm b/Plugin.pm
index ef2dbae..2177dfd 100644
--- a/Plugin.pm
+++ b/Plugin.pm
@@ -51,6 +51,19 @@ sub unimport
     return;
 }
 
+sub callbacks
+{
+    my ($re, %callback) = @_;
+
+    my %map = map { $_ => "_$_" } qw/exec/;
+
+    for my $key (keys %callback) {
+        my $name = $map{$key};
+        next unless defined $name;
+        $re->$name($callback{$key});
+    }
+}
+
 sub num_captures
 {
     my ($re, %callback) = @_;
diff --git a/Plugin.pod b/Plugin.pod
index 137199c..7fda6f7 100644
--- a/Plugin.pod
+++ b/Plugin.pod
@@ -122,6 +122,9 @@ available as the second argument (C<$str>) and through the L<str|/str>
 method. The routine should return a true value if the match was
 successful, and a false one if it wasn't.
 
+This callback can also be specified on an individual basis with the
+L</callbacks> method.
+
 =head1 METHODS
 
 =head2 str
@@ -182,6 +185,29 @@ called at all.
 The length specified will be used as a a byte length (using
 L<SvPV|perlapi/SvPV>), not a character length.
 
+=head2 callbacks
+
+    # A dumb regexp engine that just tests string equality
+    use re::engine::Plugin comp => sub {
+        my ($re) = @_;
+
+        my $pat = $re->pattern;
+
+        $re->callbacks(
+            exec => sub {
+                my ($re, $str) = @_;
+                return $pat eq $str;
+            },
+        );
+    };
+
+Takes a list of key-value pairs of names and subroutines, and replace the
+callback currently attached to the regular expression for the type given as
+the key by the code reference passed as the corresponding value.
+
+The only valid key is currently C<exec>. See L</exec> for more details about
+this callback.
+
 =head2 num_captures
 
     $re->num_captures(
diff --git a/Plugin.xs b/Plugin.xs
index fab9308..3abd900 100644
--- a/Plugin.xs
+++ b/Plugin.xs
@@ -768,6 +768,15 @@ PPCODE:
         }
     }
 
+void
+_exec(re::engine::Plugin self, ...)
+PPCODE:
+    if (items > 1) {
+        SvREFCNT_dec(self->cb_exec);
+        self->cb_exec = ST(1);
+        SvREFCNT_inc(self->cb_exec);
+    }
+
 void
 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
 PPCODE:
diff --git a/t/callbacks/exec.t b/t/callbacks/exec.t
new file mode 100644
index 0000000..d340ffe
--- /dev/null
+++ b/t/callbacks/exec.t
@@ -0,0 +1,38 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4 * 2;
+
+my $count;
+
+use re::engine::Plugin comp => sub {
+ my ($re) = @_;
+
+ my $pat = $re->pattern;
+
+ $re->callbacks(
+  exec => sub {
+   my ($re, $str) = @_;
+
+   ++$count;
+
+   return $str eq $pat;
+  },
+ );
+};
+
+$count = 0;
+
+ok "foo"  =~ /foo/;
+is $count, 1;
+ok "fool" !~ /foo/;
+is $count, 2;
+
+my $rx = qr/bar/;
+
+ok "bar"  =~ $rx;
+is $count, 3;
+ok "foo"  !~ $rx;
+is $count, 4;