perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/lib/ModPerl MapUtil.pm StructureMap.pm WrapXS.pm
Date Fri, 28 May 2004 01:35:15 GMT
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,
  
  
  

Mime
View raw message