stas 2004/05/27 18:35:15
Modified: lib/ModPerl MapUtil.pm StructureMap.pm WrapXS.pm
Log:
Extended WrapXS code to support a new type of accessor: char * which
accepts undef to set the C pointer to NULL and as such unset the
member of the struct.
Revision Changes Path
1.6 +1 -0 modperl-2.0/lib/ModPerl/MapUtil.pm
Index: MapUtil.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/MapUtil.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -u -r1.5 -r1.6
--- MapUtil.pm 17 May 2004 22:53:33 -0000 1.5
+++ MapUtil.pm 28 May 2004 01:35:15 -0000 1.6
@@ -26,6 +26,7 @@
our @ISA = qw(Exporter);
# '<' => 'auto-generated but gives only a read-only access'
+# '&' => 'RDWR accessor to a char* field, supporting undef arg'
my %disabled_map = (
'!' => 'disabled or not yet implemented',
'~' => 'implemented but not auto-generated',
1.6 +7 -2 modperl-2.0/lib/ModPerl/StructureMap.pm
Index: StructureMap.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/StructureMap.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -u -r1.5 -r1.6
--- StructureMap.pm 17 May 2004 22:53:33 -0000 1.5
+++ StructureMap.pm 28 May 2004 01:35:15 -0000 1.6
@@ -118,8 +118,13 @@
if (s/^(\W)\s*// or $disabled) {
# < denotes a read-only accessor
- if ($1 && $1 eq '<') {
- $map->{$class}->{$_} = 'ro';
+ if ($1) {
+ if ($1 eq '<') {
+ $map->{$class}->{$_} = 'ro';
+ }
+ elsif ($1 eq '&') {
+ $map->{$class}->{$_} = 'rw_char_undef';
+ }
}
else {
$map->{$class}->{$_} = undef;
1.74 +34 -0 modperl-2.0/lib/ModPerl/WrapXS.pm
Index: WrapXS.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -u -r1.73 -r1.74
--- WrapXS.pm 17 May 2004 22:53:33 -0000 1.73
+++ WrapXS.pm 28 May 2004 01:35:15 -0000 1.74
@@ -250,6 +250,40 @@
EOF
}
+ elsif ($access_mode eq 'rw_char_undef') {
+ my $pool = $e->{pool}
+ or die "rw_char_undef accessors need pool";
+ $pool .= '(obj)';
+# XXX: not sure where val=$default is coming from, but for now use
+# hardcoded Nullsv
+ $code = <<EOF;
+$type
+$name(obj, val_sv=Nullsv)
+ $class obj
+ SV *val_sv
+
+ PREINIT:
+$attrs
+
+ CODE:
+ RETVAL = ($cast) obj->$name;
+
+ if (val_sv) {
+ if (SvOK(val_sv)) {
+ STRLEN val_len;
+ char *val = (char *)SvPV(val_sv, val_len);
+ obj->$name = apr_pstrndup($pool, val, val_len);
+ }
+ else {
+ obj->$name = NULL;
+ }
+ }
+
+ OUTPUT:
+ RETVAL
+
+EOF
+ }
push @{ $self->{XS}->{ $struct->{module} } }, {
code => $code,
