cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestRequest.pm

[dougm]

dougm       01/12/10 19:44:26

  Modified:    perl-framework/Apache-Test/lib/Apache TestRequest.pm
  Log:
  dont do Net::NNTP fixup unless news scheme is actually being used
  
  Revision  Changes    Path
  1.59      +23 -9     
httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
  
  Index: TestRequest.pm
  ===================================================================
  RCS file: 
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm,v
  retrieving revision 1.58
  retrieving revision 1.59
  diff -u -r1.58 -r1.59
  --- TestRequest.pm    2001/12/06 23:00:26     1.58
  +++ TestRequest.pm    2001/12/11 03:44:26     1.59
  @@ -116,6 +116,8 @@
       local $vars->{scheme} =
         $Apache::TestRequest::Scheme || $vars->{scheme} || 'http';
   
  +    scheme_fixup($vars->{scheme});
  +
       my $hostport = hostport();
   
       return "$vars->{scheme}://$hostport$url";
  @@ -571,14 +573,26 @@
       };
   }
   
  -eval {
  -    install_net_socket_new('Net::NNTP' => sub {
  -        my $args = shift;
  -        my($host, $port) = split ':',
  -          Apache::TestRequest::hostport();
  -        $args->{PeerPort} = $port;
  -        $args->{PeerAddr} = $host;
  -    });
  -};
  +my %scheme_fixups = (
  +    'news' => sub {
  +        return if $INC{'Net/NNTP.pm'};
  +        eval {
  +            install_net_socket_new('Net::NNTP' => sub {
  +                my $args = shift;
  +                my($host, $port) = split ':',
  +                  Apache::TestRequest::hostport();
  +                $args->{PeerPort} = $port;
  +                $args->{PeerAddr} = $host;
  +            });
  +        };
  +    },
  +);
  +
  +sub scheme_fixup {
  +    my $scheme = shift;
  +    my $fixup = $scheme_fixups{$scheme};
  +    return unless defined &$fixup;
  +    $fixup->();
  +}
   
   1;