cvs commit: modperl-2.0/t/response/TestCompat request.pm

[st...@apache.org]

stas        2003/12/17 10:55:25

  Modified:    lib/Apache compat.pm
               t/response/TestCompat request.pm
  Log:
  - for compat APIs that collide with mp2 API, instrument Apache::compat with
  methods to enable and disable those APIs when needed
  - $r->finfo and $r->notes which collide with mp2 API can now override the
  mp2 API on demand
  - adjust the notes test
  
  Revision  Changes    Path
  1.91      +80 -15    modperl-2.0/lib/Apache/compat.pm
  
  Index: compat.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
  retrieving revision 1.90
  retrieving revision 1.91
  diff -u -u -r1.90 -r1.91
  --- compat.pm	19 Nov 2003 19:30:11 -0000	1.90
  +++ compat.pm	17 Dec 2003 18:55:25 -0000	1.91
  @@ -50,6 +50,86 @@
       $INC{'Apache/Table.pm'} = __FILE__;
   }
   
  +# api => "overriding code"
  +# the overriding code, needs to "return" the original CODE reference
  +# when eval'ed , so that it can be restored later
  +my %overridable_mp2_api = (
  +    'Apache::RequestRec::notes' => <<'EOI',
  +{
  +    require Apache::RequestRec;
  +    my $notes_sub = *Apache::RequestRec::notes{CODE};
  +    *Apache::RequestRec::notes = sub {
  +        my $r = shift;
  +        return wantarray()
  +            ?       ($r->table_get_set(scalar($r->$notes_sub), @_))
  +            : scalar($r->table_get_set(scalar($r->$notes_sub), @_));
  +    };
  +    $notes_sub;
  +}
  +EOI
  +
  +    'Apache::RequestRec::finfo' => <<'EOI',
  +{
  +    require APR::Finfo;
  +    my $finfo_sub = *APR::Finfo::finfo{CODE};
  +    sub Apache::RequestRec::finfo {
  +        my $r = shift;
  +        stat $r->filename;
  +        \*_;
  +    }
  +    $finfo_sub;
  +}
  +EOI
  +);
  +
  +my %overridden_mp2_api = ();
  +
  +# this function enables back-compatible APIs which can't coexist with
  +# mod_perl 2.0 APIs with the same name and therefore it should be
  +# avoided if possible.
  +#
  +# it expects a list of fully qualified functions, like
  +# "Apache::RequestRec::finfo"
  +sub override_mp2_api {
  +    my (@subs) = @_;
  +
  +    for my $sub (@subs) {
  +        unless (exists $overridable_mp2_api{$sub}) {
  +            die __PACKAGE__ . ": $sub is not overridable";
  +        }
  +        if (exists $overridden_mp2_api{$sub}) {
  +            warn __PACKAGE__ . ": $sub has been already overridden";
  +            next;
  +        }
  +        $overridden_mp2_api{$sub} = eval $overridable_mp2_api{$sub};
  +        unless (exists $overridden_mp2_api{$sub} &&
  +                ref($overridden_mp2_api{$sub}) eq 'CODE') {
  +            die "overriding $sub didn't return a CODE ref";
  +        }
  +    }
  +}
  +
  +# restore_mp2_api does the opposite of override_mp2_api(), it removes
  +# the overriden API and restores the original mod_perl 2.0 API
  +sub restore_mp2_api {
  +    my (@subs) = @_;
  +
  +    for my $sub (@subs) {
  +        unless (exists $overridable_mp2_api{$sub}) {
  +            die __PACKAGE__ . ": $sub is not overridable";
  +        }
  +        unless (exists $overridden_mp2_api{$sub}) {
  +            warn __PACKAGE__ . ": can't restore $sub, " .
  +                "as it has not been overridden";
  +            next;
  +        }
  +        my $original_sub = delete $overridden_mp2_api{$sub};
  +        no warnings 'redefine';
  +        no strict 'refs';
  +        *$sub = $original_sub;
  +    }
  +}
  +
   sub request {
       my $what = shift;
   
  @@ -249,15 +329,6 @@
           : scalar($r->table_get_set(scalar($r->err_headers_out), @_));
   }
   
  -{
  -    my $notes_sub = *Apache::RequestRec::notes{CODE};
  -    *Apache::RequestRec::notes = sub {
  -        my $r = shift;
  -        return wantarray()
  -            ?       ($r->table_get_set(scalar($r->$notes_sub), @_))
  -            : scalar($r->table_get_set(scalar($r->$notes_sub), @_));
  -    }
  -}
   
   sub register_cleanup {
       shift->pool->cleanup_register(@_);
  @@ -345,12 +416,6 @@
   
   sub chdir_file {
       #XXX resolve '.' in @INC to basename $r->filename
  -}
  -
  -sub finfo {
  -    my $r = shift;
  -    stat $r->filename;
  -    \*_;
   }
   
   *log_reason = \&log_error;
  
  
  
  1.4       +6 -0      modperl-2.0/t/response/TestCompat/request.pm
  
  Index: request.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestCompat/request.pm,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -u -r1.3 -r1.4
  --- request.pm	11 Apr 2003 07:34:03 -0000	1.3
  +++ request.pm	17 Dec 2003 18:55:25 -0000	1.4
  @@ -75,6 +75,8 @@
   
       # $r->notes
       {
  +        Apache::compat::override_mp2_api('Apache::RequestRec::notes');
  +
           my $key = 'notes-test';
           # get/set scalar context
           {
  @@ -98,6 +100,10 @@
               $r->notes->add($key => $_) for @exp;
               ok t_cmp(\@exp, [ $r->notes($key) ], "\$r->notes in list context");
           }
  +
  +        # restore the real 2.0 notes() method, now that we are done
  +        # with the compat one
  +        Apache::compat::restore_mp2_api('Apache::RequestRec::notes');
       }
   
       # get_remote_host()