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 TypeMap.pm WrapXS.pm
Date Mon, 17 May 2004 22:53:33 GMT
stas        2004/05/17 15:53:33

  Modified:    lib/ModPerl MapUtil.pm StructureMap.pm TypeMap.pm WrapXS.pm
  Log:
  add provision for making struct accessors readonly (with < marker in the
  map file)
  
  Revision  Changes    Path
  1.5       +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.4
  retrieving revision 1.5
  diff -u -u -r1.4 -r1.5
  --- MapUtil.pm	4 Mar 2004 06:01:06 -0000	1.4
  +++ MapUtil.pm	17 May 2004 22:53:33 -0000	1.5
  @@ -25,6 +25,7 @@
   
   our @ISA = qw(Exporter);
   
  +#    '<' => 'auto-generated but gives only a read-only access'
   my %disabled_map = (
       '!' => 'disabled or not yet implemented',
       '~' => 'implemented but not auto-generated',
  
  
  
  1.5       +10 -3     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.4
  retrieving revision 1.5
  diff -u -u -r1.4 -r1.5
  --- StructureMap.pm	4 Mar 2004 06:01:06 -0000	1.4
  +++ StructureMap.pm	17 May 2004 22:53:33 -0000	1.5
  @@ -117,11 +117,18 @@
           }
   
           if (s/^(\W)\s*// or $disabled) {
  -            $map->{$class}->{$_} = undef;
  -            push @{ $self->{disabled}->{ $1 || '!' } }, "$class.$_";
  +            # < denotes a read-only accessor
  +            if ($1 && $1 eq '<') {
  +                $map->{$class}->{$_} = 'ro';
  +            }
  +            else {
  +                $map->{$class}->{$_} = undef;
  +                push @{ $self->{disabled}->{ $1 || '!' } }, "$class.$_";
  +            }
  +
           }
           else {
  -            $map->{$class}->{$_} = 1;
  +            $map->{$class}->{$_} = 'rw';
           }
       }
   
  
  
  
  1.20      +11 -6     modperl-2.0/lib/ModPerl/TypeMap.pm
  
  Index: TypeMap.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/TypeMap.pm,v
  retrieving revision 1.19
  retrieving revision 1.20
  diff -u -u -r1.19 -r1.20
  --- TypeMap.pm	4 Mar 2004 06:01:06 -0000	1.19
  +++ TypeMap.pm	17 May 2004 22:53:33 -0000	1.20
  @@ -289,19 +289,24 @@
   
       return unless $class = $self->map_type($stype);
   
  +    use Apache::TestTrace;
  +
       for my $e (@{ $struct->{elts} }) {
           my($name, $type) = ($e->{name}, $e->{type});
           my $rtype;
   
  -        next unless $self->structure_map->{$stype}->{$name};
  +        # ro/rw/undef(disabled)
  +        my $access_mode = $self->structure_map->{$stype}->{$name};
  +        next unless $access_mode;
           next unless $rtype = $self->map_type($type);
   
           push @elts, {
  -           name    => $name,
  -           type    => $rtype,
  -           default => $self->null_type($type),
  -           pool    => $self->class_pool($class),
  -           class   => $self->{map}->{$type} || "",
  +           name        => $name,
  +           type        => $rtype,
  +           default     => $self->null_type($type),
  +           pool        => $self->class_pool($class),
  +           class       => $self->{map}->{$type} || "",
  +           access_mode => $access_mode,
           };
       }
   
  
  
  
  1.73      +23 -3     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.72
  retrieving revision 1.73
  diff -u -u -r1.72 -r1.73
  --- WrapXS.pm	14 May 2004 20:57:40 -0000	1.72
  +++ WrapXS.pm	17 May 2004 22:53:33 -0000	1.73
  @@ -195,8 +195,8 @@
           my $class = $struct->{class};
   
           for my $e (@{ $struct->{elts} }) {
  -            my($name, $default, $type) =
  -              @{$e}{qw(name default type)};
  +            my($name, $default, $type, $access_mode) =
  +              @{$e}{qw(name default type access_mode)};
   
               (my $cast = $type) =~ s/:/_/g;
               my $val = get_value($e);
  @@ -210,7 +210,25 @@
   
               my $attrs = $self->attrs($name);
   
  -            my $code = <<EOF;
  +            my $code;
  +            if ($access_mode eq 'ro') {
  +                $code = <<EOF;
  +$type
  +$name(obj)
  +    $class obj
  +
  +$attrs
  +
  +    CODE:
  +    RETVAL = ($cast) obj->$name;
  +
  +    OUTPUT:
  +    RETVAL
  +
  +EOF
  +            }
  +            elsif ($access_mode eq 'rw') {
  +                $code = <<EOF;
   $type
   $name(obj, val=$default)
       $class obj
  @@ -231,6 +249,8 @@
       RETVAL
   
   EOF
  +            }
  +
               push @{ $self->{XS}->{ $struct->{module} } }, {
                  code  => $code,
                  class => $class,
  
  
  

Mime
View raw message