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([EMAIL PROTECTED], [ $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()