perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@locus.apache.org
Subject cvs commit: modperl/t/net/perl dirty-script.cgi dirty-test.cgi
Date Fri, 12 May 2000 07:11:05 GMT
dougm       00/05/12 00:11:05

  Modified:    .        Changes ToDo
               lib/Apache PerlRun.pm
               t/docs   startup.pl
               t/modules perlrun.t
               t/net/perl dirty-script.cgi dirty-test.cgi
  Log:
  Apache::PerlRun::flush_namespace fixes, so aliased (imported)
  code/hash/array/scalar are undefined without undef-ing the pointed-to
  data and without using B.pm
  
  and: modules/perlrun was never properly run in the first place
  
  Revision  Changes    Path
  1.479     +4 -0      modperl/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl/Changes,v
  retrieving revision 1.478
  retrieving revision 1.479
  diff -u -r1.478 -r1.479
  --- Changes	2000/05/05 08:10:33	1.478
  +++ Changes	2000/05/12 07:10:56	1.479
  @@ -10,6 +10,10 @@
   
   =item 1.23_01-dev
   
  +Apache::PerlRun::flush_namespace fixes, so aliased (imported)
  +code/hash/array/scalar are undefined without undef-ing the pointed-to
  +data and without using B.pm, thanks to Richard Chen for the suggestion
  +
   document Apache::print's special behavior wrt references
   [Jeffrey W. Baker <jwbaker@acm.org>]
   
  
  
  
  1.242     +1 -4      modperl/ToDo
  
  Index: ToDo
  ===================================================================
  RCS file: /home/cvs/modperl/ToDo,v
  retrieving revision 1.241
  retrieving revision 1.242
  diff -u -r1.241 -r1.242
  --- ToDo	2000/04/21 17:04:56	1.241
  +++ ToDo	2000/05/12 07:10:56	1.242
  @@ -52,10 +52,7 @@
   - coderef to $r->custom_response
   [Randal L. Schwartz <merlyn@stonehenge.com>]
   
  -- PerlRun::flush_namespace needs to check if_owner for all types, not
  -just cvs.  NOTE: i dont think this is possible, only CVs have a GV
  -pointer attached -dougm
  -[John M Vinopal <jvinopal@abattoir.com>]
  +- Apache::PerlRun::flush_namespace should be re-written in c
   
   - should $r->content unset $r->headers_in('content-length') ?
   NOTE: im worried this could break apps who need to know content-length 
  
  
  
  1.28      +34 -20    modperl/lib/Apache/PerlRun.pm
  
  Index: PerlRun.pm
  ===================================================================
  RCS file: /home/cvs/modperl/lib/Apache/PerlRun.pm,v
  retrieving revision 1.27
  retrieving revision 1.28
  diff -u -r1.27 -r1.28
  --- PerlRun.pm	2000/04/05 06:19:34	1.27
  +++ PerlRun.pm	2000/05/12 07:10:57	1.28
  @@ -312,36 +312,50 @@
       return $rc;
   }
   
  +BEGIN {
  +    if ($] < 5.006) {
  +        $INC{'warnings.pm'} = __FILE__;
  +        *warnings::unimport = sub {};
  +    }
  +}
  +
   sub flush_namespace {
       my($self, $package) = @_;
       $package ||= $self->namespace;
   
  -    no strict;
  +    no strict 'refs';
       my $tab = \%{$package.'::'};
   
       for (keys %$tab) {
  -	if(*{ $tab->{$_} }{CODE}) {
  -	    undef_cv_if_owner($package, \&{ $tab->{$_} });
  -	} 
  -        if(*{ $tab->{$_} }{HASH}) {
  -            undef %{ $tab->{$_} };
  +        my $fullname = join '::', $package, $_;
  +        #code/hash/array/scalar might be imported
  +        #make sure the gv does not point elsewhere
  +        #before undefing each
  +        if (%$fullname) {
  +            *{$fullname} = {};
  +            undef %$fullname;
           }
  -        if(*{ $tab->{$_} }{ARRAY}) {
  -            undef @{ $tab->{$_} };
  +        if (@$fullname) {
  +            *{$fullname} = [];
  +            undef @$fullname;
           }
  -        if(*{ $tab->{$_} }{SCALAR}) {
  -	    undef ${ $tab->{$_} };
  +        if ($$fullname) {
  +            my $tmp; #argh, no such thing as an anonymous scalar
  +            *{$fullname} = \$tmp;
  +            undef $$fullname;
           }
  -     }
  -}
  -
  -sub undef_cv_if_owner {
  -    return unless $INC{'B.pm'};
  -    my($package, $cv) = @_;
  -    my $obj    = B::svref_2object($cv);
  -    my $stash  = $obj->GV->STASH->NAME;
  -    return unless $package eq $stash;
  -    undef &$cv;
  +        if (defined &$fullname) {
  +            no warnings;
  +            local $^W = 0;
  +            *{$fullname} = sub {};
  +	    undef &$fullname;
  +	}
  +        if (*{$fullname}{IO}) {
  +            if (fileno $fullname) {
  +                close $fullname;
  +            }
  +        }
  +    }
   }
   
   1;
  
  
  
  1.37      +5 -2      modperl/t/docs/startup.pl
  
  Index: startup.pl
  ===================================================================
  RCS file: /home/cvs/modperl/t/docs/startup.pl,v
  retrieving revision 1.36
  retrieving revision 1.37
  diff -u -r1.36 -r1.37
  --- startup.pl	1999/04/07 03:34:35	1.36
  +++ startup.pl	2000/05/12 07:10:58	1.37
  @@ -1,4 +1,4 @@
  -#! /usr/local/bin/perl
  +#!perl
   
   unless (defined $ENV{MOD_PERL}) {
       die "\$ENV{MOD_PERL} not set!";
  @@ -103,7 +103,10 @@
   
   $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl/ or die "GATEWAY_INTERFACE not set!";
   
  -sub Outside::imported {4}
  +sub Outside::code {4}
  +%Outside::hash = (one => 1);
  +@Outside::array = qw(one);
  +$Outside::scalar = 'one';
   
   #will be redef'd during tests
   sub PerlTransHandler::handler {-1}
  
  
  
  1.2       +2 -0      modperl/t/modules/perlrun.t
  
  Index: perlrun.t
  ===================================================================
  RCS file: /home/cvs/modperl/t/modules/perlrun.t,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- perlrun.t	1998/04/26 00:16:40	1.1
  +++ perlrun.t	2000/05/12 07:10:58	1.2
  @@ -1,4 +1,6 @@
   use Apache::test;
   
  +fetch "/dirty-perl/dirty-script.cgi";
  +
   print fetch "/dirty-perl/dirty-test.cgi";
   
  
  
  
  1.5       +4 -1      modperl/t/net/perl/dirty-script.cgi
  
  Index: dirty-script.cgi
  ===================================================================
  RCS file: /home/cvs/modperl/t/net/perl/dirty-script.cgi,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- dirty-script.cgi	1999/01/21 00:38:24	1.4
  +++ dirty-script.cgi	2000/05/12 07:10:59	1.5
  @@ -10,7 +10,10 @@
   open FH, $0 or die $!;
   
   sub subroutine {}
  -*imported = \&Outside::imported;
  +*code_alias = \&Outside::code;
  +*hash_alias = \%Outside::hash;
  +*array_alias = \@Outside::array;
  +*scalar_alias = \$Outside::scalar;
   
   push @array, 1;
   
  
  
  
  1.5       +9 -7      modperl/t/net/perl/dirty-test.cgi
  
  Index: dirty-test.cgi
  ===================================================================
  RCS file: /home/cvs/modperl/t/net/perl/dirty-test.cgi,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- dirty-test.cgi	1999/08/04 01:56:14	1.4
  +++ dirty-test.cgi	2000/05/12 07:10:59	1.5
  @@ -4,21 +4,23 @@
       die "%INC save/restore broken";
   }
   
  -package Apache::ROOT::dirty_2dperl::dirty_2dscript_2epl;
  +package Apache::ROOT::dirty_2dperl::dirty_2dscript_2ecgi;
   
  -use Apache::test;
  +use Apache::test qw(test);
   
   print "Content-type: text/plain\n\n";
   
  -print "1..6\n";
  +print "1..9\n";
   
   my $i = 0;
   
   test ++$i, not defined &subroutine;
  -test ++$i, not *{"array"}{ARRAY};
  -test ++$i, not *{"hash"}{HASH};
  +test ++$i, not @array;
  +test ++$i, not %hash;
   test ++$i, not defined $scalar;
   test ++$i, not defined fileno(FH);
  -test ++$i, Outside::imported() == 4;
  -
  +test ++$i, Outside::code() == 4;
  +test ++$i, keys %Outside::hash == 1;
  +test ++$i, @Outside::array == 1;
  +test ++$i, $Outside::scalar eq 'one';
   
  
  
  

Mime
View raw message