-2007-12-27 Ævar Arnfjörð Bjarmason <avar@cpan.org>
+2007-12-27 Ævar Arnfjörð Bjarmason <avar@cpan.org> (0.04)
* Plugin.(xs|h): Fix up prototypes to match the callbacks in the actual 5.10 release
+ * Plugin.xs: Dumped CODE: in favor of PPCODE:, the former is teh sux
+ * Plugin.xs: Minor cleanups here and there
+ * Plugin.pod: New todo and a developer release notice
+ * Plugin.[h|pm]: Named buffer callbacks
+ * t/methods/stash.t: Test return value of $rx->stash({});
+ * t/methods/str/modify.t: New test for modification of ->str when
+ a reference is used
+ * t/methods/str/types.t: This was testing pattern types, fixed
+ * t/Example.[t|pm]: Moved to t/usage
+
2007-05-17 Ævar Arnfjörð Bjarmason <avar@cpan.org> (0.03)
-
#define GET_SELF_FROM_PPRIVATE(pprivate) \
re__engine__Plugin self; \
SELF_FROM_PPRIVATE(self,pprivate);
my ($pkg, %sub) = @_;\r
\r
# Valid callbacks\r
- my @callback = qw(comp exec intuit checkstr free dupe);\r
+ my @callback = qw(comp exec);\r
\r
for (@callback) {\r
next unless exists $sub{$_};\r
rx->extflags = flags; /* Flags for perl to use */
rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */
- /* Store a precompiled regexp for pp_regcomp to use */
+ /* Precompiled pattern for pp_regcomp to use */
rx->prelen = plen;
rx->precomp = savepvn(exp, rx->prelen);
dSP;
I32 items;
SV * callback;
- re__engine__Plugin self;
-
- SELF_FROM_PPRIVATE(self,rx->pprivate);
+ GET_SELF_FROM_PPRIVATE(rx->pprivate);
callback = self->cb_num_capture_buff_LENGTH;
}
MODULE = re::engine::Plugin PACKAGE = re::engine::Plugin
-PROTOTYPES: ENABLE
+PROTOTYPES: DISABLE
-SV *
+void
pattern(re::engine::Plugin self, ...)
-CODE:
- SvREFCNT_inc(self->pattern);
- RETVAL = self->pattern;
-OUTPUT:
- RETVAL
+PPCODE:
+ XPUSHs(self->pattern);
-SV *
+void
str(re::engine::Plugin self, ...)
-CODE:
- SvREFCNT_inc(self->str);
- RETVAL = self->str;
-OUTPUT:
- RETVAL
+PPCODE:
+ XPUSHs(self->str);
char*
mod(re::engine::Plugin self, ...)
XPUSHs(&PL_sv_yes);
}
-SV *
+void
stash(re::engine::Plugin self, ...)
-PREINIT:
- SV * stash;
-CODE:
+PPCODE:
if (items > 1) {
- self->stash = sv_mortalcopy(ST(1));
+ self->stash = ST(1);
SvREFCNT_inc(self->stash);
+ XSRETURN_EMPTY;
+ } else {
+ XPUSHs(self->stash);
}
- SvREFCNT_inc(self->stash);
- RETVAL = self->stash;
-OUTPUT:
- RETVAL
-SV *
+void
minlen(re::engine::Plugin self, ...)
-CODE:
+PPCODE:
if (items > 1) {
self->rx->minlen = (I32)SvIV(ST(1));
+ XSRETURN_EMPTY;
+ } else {
+ if (self->rx->minlen) {
+ XPUSHs(sv_2mortal(newSViv(self->rx->minlen)));
+ } else {
+ XPUSHs(sv_2mortal(&PL_sv_undef));
+ }
}
- RETVAL = self->rx->minlen ? newSViv(self->rx->minlen) : &PL_sv_undef;
-OUTPUT:
- RETVAL
-
-SV *
+void
gofs(re::engine::Plugin self, ...)
-CODE:
+PPCODE:
if (items > 1) {
self->rx->gofs = (U32)SvIV(ST(1));
+ XSRETURN_EMPTY;
+ } else {
+ if (self->rx->gofs) {
+ XPUSHs(sv_2mortal(newSVuv(self->rx->gofs)));
+ } else {
+ XPUSHs(sv_2mortal(&PL_sv_undef));
+ }
}
- RETVAL = self->rx->gofs ? newSVuv(self->rx->gofs) : &PL_sv_undef;
-OUTPUT:
- RETVAL
-SV *
+void
nparens(re::engine::Plugin self, ...)
-CODE:
+PPCODE:
if (items > 1) {
self->rx->nparens = (U32)SvIV(ST(1));
+ XSRETURN_EMPTY;
+ } else {
+ if (self->rx->nparens) {
+ XPUSHs(sv_2mortal(newSVuv(self->rx->nparens)));
+ } else {
+ XPUSHs(sv_2mortal(&PL_sv_undef));
+ }
}
- RETVAL = self->rx->nparens ? newSVuv(self->rx->nparens) : &PL_sv_undef;
-OUTPUT:
- RETVAL
void
_num_capture_buff_FETCH(re::engine::Plugin self, ...)
=cut
use strict;
-use Test::More tests => 4;
+use Test::More tests => 5;
use re::engine::Plugin (
comp => sub {
my ($re, $str) = @_;
my $stash = $re->stash;
+ my $ret = $re->stash( $stash );
+ ok(!$ret, "stash returns no value on assignment");
my %h = qw( 0 a 1 o 2 e 3 u );
for (keys %h) {
is($h{$_}, $stash->[$_]);
--- /dev/null
+use strict;
+use Test::More tests => 1;
+use re::engine::Plugin (
+ exec => sub {
+ my ($re, $str) = @_;
+
+ $$str = "eek";
+
+ return 1;
+ },
+);
+
+my $sv = "ook";
+if (\$sv =~ /pattern/) {
+ is($sv, "eek");
+}
exec => sub {
my ($re, $str) = @_;
- is_deeply($str, $re->str);
+ isa_ok($str, $re->pattern);
return 1;
},
);
my $sv;
-"SCALAR" =~ \$sv;
-"REF" =~ \\$sv;
-"ARRAY" =~ [];
-"HASH" =~ {};
-"GLOB" =~ \*STDIN;
-"CODE" =~ sub {};
-"main" =~ bless {} => "main";
-
+\$sv =~ "SCALAR";
+\\$sv =~ "REF";
+[] =~ "ARRAY";
+{} =~ "HASH";
+\*STDIN =~ "GLOB";
+sub {} =~ "CODE";
+bless({} => "main") =~ "main"
-package Example;
+package basic;
use strict;
# Note the (), doesn't call ->import
use strict;
-use lib 't';
+use lib 't/usage';
use Test::More tests => 1;
-use Example;
+use basic;
"str" =~ /pattern/;
--- /dev/null
+use strict;
+use lib 't/usage';
+use Test::More skip_all => "Needs lameness in user code";
+
+# my $caller = caller;
+#
+# This won't work unless the subs are predeclared before the C<use> statement
+# # Handle import tags
+# if (@_ == 1) {
+# if ($_[0] ne ":import") {
+# require Carp;
+# Carp::croak("Unknown tag '$_[0]'");
+# }
+#
+# # We have :import, generate import and unimport methods in the
+# # calling package
+# my %pkg;
+# for (qw(comp exec)) {
+# no strict 'refs';
+# $pkg{$_} = *{"$caller\::$_"}{CODE} if *{"$caller\::$_"}{CODE};
+# }
+#
+# use Data::Dumper;
+# warn Dumper \%pkg;
+#
+# no strict 'refs';
+# *{"$caller\::import"} = sub {
+# __PACKAGE__->import(%pkg);
+# };
+# *{"$caller\::unimport"} = \&unimport;
+#
+# return;
+# }
+#
+
+use import;
+
+"ook" =~ /pattern/;
+
+is($1, "ook_1");
--- /dev/null
+package import;
+use strict;
+
+sub exec;
+use re::engine::Plugin ':import';
+
+sub exec
+{
+ my ($re, $str) = @_;
+
+ $re->num_captures(
+ FETCH => sub {
+ my ($re, $paren) = @_;
+
+ $str . "_" . $paren;
+ }
+ );
+
+ 1;
+}
+
+1;
projects / perl / modules / re-engine-Plugin.git / commitdiff